module.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

}

=pod

=head2 @list_of_hrefs = $self->fetch_report()

This function queries the CPAN testers database at
I<http://testers.cpan.org/> for test results of specified module
objects, module names or distributions.

Look at L<CPANPLUS::Internals::Report::_query_report()> for details on
the options you can pass and the return value to expect.

=cut

sub fetch_report {
    my $self    = shift;
    my $cb      = $self->parent;

    return $cb->_query_report( @_, module => $self );
}

=pod

=head2 $bool = $self->uninstall([type => [all|man|prog])

This function uninstalls the specified module object.

You can install 2 types of files, either C<man> pages or C<prog>ram
files. Alternately you can specify C<all> to uninstall both (which
is the default).

Returns true on success and false on failure.

Do note that this does an uninstall via the so-called C<.packlist>,
so if you used a module installer like say, C<ports> or C<apt>, you
should not use this, but use your package manager instead.

=cut

sub uninstall {
    my $self = shift;
    my $conf = $self->parent->configure_object();
    my %hash = @_;

    my ($type,$verbose);
    my $tmpl = {
        type    => { default => 'all', allow => [qw|man prog all|],
                        store => \$type },
        verbose => { default => $conf->get_conf('verbose'),
                        store => \$verbose },
        force   => { default => $conf->get_conf('force') },
    };

    ### XXX add a warning here if your default install dist isn't
    ### makefile or build -- that means you are using a package manager
    ### and this will not do what you think!

    my $args = check( $tmpl, \%hash ) or return;

    if( $conf->get_conf('dist_type') and (
        ($conf->get_conf('dist_type') ne INSTALLER_BUILD) or
        ($conf->get_conf('dist_type') ne INSTALLER_MM))
    ) {
        msg(loc("You have a default installer type set (%1) ".
                "-- you should probably use that package manager to " .
                "uninstall modules", $conf->get_conf('dist_type')), $verbose);
    }

    ### check if we even have the module installed -- no point in continuing
    ### otherwise
    unless( $self->installed_version ) {
        error( loc( "Module '%1' is not installed, so cannot uninstall",
                    $self->module ) );
        return;
    }

                                                ### nothing to uninstall ###
    my $files   = $self->files( type => $type )             or return;
    my $dirs    = $self->directory_tree( type => $type )    or return;
    my $sudo    = $conf->get_program('sudo');

    ### just in case there's no file; M::B doensn't provide .packlists yet ###
    my $pack    = $self->packlist;
    $pack       = $pack->[0]->packlist_file() if $pack;

    ### first remove the files, then the dirs if they are empty ###
    my $flag = 0;
    for my $file( @$files, $pack ) {
        next unless defined $file && -f $file;

        msg(loc("Unlinking '%1'", $file), $verbose);

        my @cmd = ($^X, "-eunlink+q[$file]");
        unshift @cmd, $sudo if $sudo;

        my $buffer;
        unless ( run(   command => \@cmd,
                        verbose => $verbose,
                        buffer  => \$buffer )
        ) {
            error(loc("Failed to unlink '%1': '%2'",$file, $buffer));
            $flag++;
        }
    }

    for my $dir ( sort @$dirs ) {
        local *DIR;
        open DIR, $dir or next;
        my @count = readdir(DIR);
        close DIR;

        next unless @count == 2;    # . and ..

        msg(loc("Removing '%1'", $dir), $verbose);

        ### this fails on my win2k machines.. it indeed leaves the
        ### dir, but it's not a critical error, since the files have
        ### been removed. --kane
        #unless( rmdir $dir ) {
        #    error( loc( "Could not remove '%1': %2", $dir, $! ) )
        #        unless $^O eq 'MSWin32';
        #}
        
        my @cmd = ($^X, "-ermdir+q[$dir]");
        unshift @cmd, $sudo if $sudo;
        
        my $buffer;
        unless ( run(   command => \@cmd,
                        verbose => $verbose,
                        buffer  => \$buffer )
        ) {
            error(loc("Failed to rmdir '%1': %2",$dir,$buffer));
            $flag++;
        }
    }

    $self->status->uninstall(!$flag);
    $self->status->installed( $flag ? 1 : undef);

    return !$flag;
}

=pod

=head2 @modobj = $self->distributions()

Returns a list of module objects representing all releases for this
module on success, false on failure.

=cut

sub distributions {
    my $self = shift;
    my %hash = @_;

    my @list = $self->author->distributions( %hash, module => $self ) or return;

    ### it's another release then by the same author ###
    return grep { $_->package_name eq $self->package_name } @list;
}

=pod

=head2 @list = $self->files ()

Returns a list of files used by this module, if it is installed.

=cut

sub files {
    return shift->_extutils_installed( @_, method => 'files' );
}

=pod

=head2 @list = $self->directory_tree ()

Returns a list of directories used by this module.

=cut

sub directory_tree {
    return shift->_extutils_installed( @_, method => 'directory_tree' );
}

=pod

=head2 @list = $self->packlist ()

Returns the C<ExtUtils::Packlist> object for this module.

=cut

sub packlist {
    return shift->_extutils_installed( @_, method => 'packlist' );
}

=pod

=head2 @list = $self->validate ()

Returns a list of files that are missing for this modules, but
are present in the .packlist file.

=cut

sub validate {
    return shift->_extutils_installed( method => 'validate' );
}

### generic method to call an ExtUtils::Installed method ###
sub _extutils_installed {
    my $self = shift;
    my $conf = $self->parent->configure_object();
    my %hash = @_;

    my ($verbose,$type,$method);
    my $tmpl = {
        verbose => {    default     => $conf->get_conf('verbose'),
                        store       => \$verbose, },
        type    => {    default     => 'all',
                        allow       => [qw|prog man all|],
                        store       => \$type, },
        method  => {    required    => 1,
                        store       => \$method,
                        allow       => [qw|files directory_tree packlist
                                        validate|],
                    },
    };

    my $args = check( $tmpl, \%hash ) or return;

    ### old versions of cygwin + perl < 5.8 are buggy here. bail out if we
    ### find we're being used by them
    {   my $err = ON_OLD_CYGWIN;
        if($err) { error($err); return };
    }

    return unless can_load(
                        modules     => { 'ExtUtils::Installed' => '0.0' },
                        verbose     => $verbose,
                    );

    my $inst;
    unless( $inst = ExtUtils::Installed->new() ) {
        error( loc("Could not create an '%1' object", 'ExtUtils::Installed' ) );

        ### in case it's being used directly... ###
        return;
    }


    {   ### EU::Installed can die =/
        my @files;
        eval { @files = $inst->$method( $self->module, $type ) };

        if( $@ ) {
            chomp $@;
            error( loc("Could not get '%1' for '%2': %3",
                        $method, $self->module, $@ ) );
            return;
        }

        return wantarray ? @files : \@files;
    }
}

=head2 $bool = $self->add_to_includepath;

Adds the current modules path to C<@INC> and C<$PERL5LIB>. This allows
you to add the module from it's build dir to your path.

You can reset C<@INC> and C<$PERL5LIB> to it's original state when you
started the program, by calling:

    $self->parent->flush('lib');
    
=cut

sub add_to_includepath {
    my $self = shift;
    my $cb   = $self->parent;
    
    if( my $dir = $self->status->extract ) {
        
            $cb->_add_to_includepath(
                    directories => [
                        File::Spec->catdir(BLIB->($dir), LIB),
                        File::Spec->catdir(BLIB->($dir), ARCH),
                        BLIB->($dir),
                    ]
            ) or return;
        
    } else {
        error(loc(  "No extract dir registered for '%1' -- can not add ".
                    "add builddir to search path!", $self->module ));
        return;
    }

    return 1;

}

=pod

=head2 $path = $self->best_path_to_module_build();

B<OBSOLETE>

If a newer version of Module::Build is found in your path, it will
return this C<special> path. If the newest version of C<Module::Build>
is found in your regular C<@INC>, the method will return false. This
indicates you do not need to add a special directory to your C<@INC>.

Note that this is only relevant if you're building your own
C<CPANPLUS::Dist::*> plugin -- the built-in dist types already have
this taken care of.

=cut

### make sure we're always running 'perl Build.PL' and friends
### against the highest version of module::build available
sub best_path_to_module_build {
    my $self = shift;

    ### Since M::B will actually shell out and run the Build.PL, we must
    ### make sure it refinds the proper version of M::B in the path.
    ### that may be either in our cp::inc or in site_perl, or even a
    ### new M::B being installed.
    ### don't add anything else here, as that might screw up prereq checks

    ### XXX this might be needed for Dist::MM too, if a makefile.pl is
    ###	masquerading as a Build.PL

    ### did we find the most recent module::build in our installer path?

    ### XXX can't do changes to @INC, they're being ignored by
    ### new_from_context when writing a Build script. see ticket:
    ### #8826 Module::Build ignores changes to @INC when writing Build
    ### from new_from_context
    ### XXX applied schwern's patches (as seen on CPANPLUS::Devel 10/12/04)
    ### and upped the version to 0.26061 of the bundled version, and things
    ### work again

    ### this functionality is now obsolete -- prereqs should be installed
    ### and we no longer use the CPANPLUS::inc magic.. so comment this out.
#     require Module::Build;
#     if( CPANPLUS::inc->path_to('Module::Build') and (
#         CPANPLUS::inc->path_to('Module::Build') eq
#         CPANPLUS::inc->installer_path )
#     ) {
# 
#         ### if the module being installed is *not* Module::Build
#         ### itself -- as that would undoubtedly be newer -- add
#         ### the path to the installers to @INC
#         ### if it IS module::build itself, add 'lib' to its path,
#         ### as the Build.PL would do as well, but the API doesn't.
#         ### this makes self updates possible
#         return $self->module eq 'Module::Build'
#                         ? 'lib'
#                         : CPANPLUS::inc->installer_path;
#     }

    ### otherwise, the path was found through a 'normal' way of
    ### scanning @INC.
    return;
}

=pod

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>[e-mail]<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>[e-mail]<gt>.

=head1 COPYRIGHT

The CPAN++ interface (of which this module is a part of) is copyright (c) 
2001 - 2007, Jos Boumans E<lt>[e-mail]<gt>. All rights reserved.

This library is free software; you may redistribute and/or modify it 
under the same terms as Perl itself.

=cut

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:

1;

__END__

todo:
reports();