backend.pm

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

Creates a local mirror of CPAN, of only the most recent sources in a
location you specify. If you set this location equal to a custom host
in your C<CPANPLUS::Config> you can use your local mirror to install
from.

It takes the following arguments:

=over 4

=item path

The location where to create the local mirror.

=item index_files

Enable/disable fetching of index files. You can disable fetching of the
index files if you don't plan to use the local mirror as your primary 
site, or if you'd like up-to-date index files be fetched from elsewhere.

Defaults to true.

=item force

Forces refetching of packages, even if they are there already.

Defaults to whatever setting you have in your C<CPANPLUS::Config>.

=item verbose

Prints more messages about what its doing.

Defaults to whatever setting you have in your C<CPANPLUS::Config>.

=back

Returns true on success and false on error.

=cut

sub local_mirror {
    my $self = shift;
    my $conf = $self->configure_object;
    my %hash = @_;

    my($path, $index, $force, $verbose);
    my $tmpl = {
        path        => { default => $conf->get_conf('base'),
                            store => \$path },
        index_files => { default => 1, store => \$index },
        force       => { default => $conf->get_conf('force'),
                            store => \$force },
        verbose     => { default => $conf->get_conf('verbose'),
                            store => \$verbose },
    };

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

    unless( -d $path ) {
        $self->_mkdir( dir => $path )
                or( error( loc( "Could not create '%1', giving up", $path ) ),
                    return
                );
    } elsif ( ! -w _ ) {
        error( loc( "Could not write to '%1', giving up", $path ) );
        return;
    }

    my $flag;
    AUTHOR: {
    for my $auth (  sort { $a->cpanid cmp $b->cpanid }
                    values %{$self->author_tree}
    ) {

        MODULE: {
        my $i;
        for my $mod ( $auth->modules ) {
            my $fetchdir = File::Spec->catdir( $path, $mod->path );

            my %opts = (
                verbose     => $verbose,
                force       => $force,
                fetchdir    => $fetchdir,
            );

            ### only do this the for the first module ###
            unless( $i++ ) {
                $mod->_get_checksums_file(
                            %opts
                        ) or (
                            error( loc( "Could not fetch %1 file, " .
                                        "skipping author '%2'",
                                        CHECKSUMS, $auth->cpanid ) ),
                            $flag++, next AUTHOR
                        );
            }

            $mod->fetch( %opts )
                    or( error( loc( "Could not fetch '%1'", $mod->module ) ),
                        $flag++, next MODULE
                    );
        } }
    } }

    if( $index ) {
        for my $name (qw[auth dslip mod]) {
            $self->_update_source(
                        name    => $name,
                        verbose => $verbose,
                        path    => $path,
                    ) or ( $flag++, next );
        }
    }

    return !$flag;
}

=pod

=head2 $file = $cb->autobundle([path => OUTPUT_PATH, force => BOOL, verbose => BOOL])

Writes out a snapshot of your current installation in C<CPAN> bundle
style. This can then be used to install the same modules for a
different or on a different machine.

It will, by default, write to an 'autobundle' directory under your
cpanplus homedirectory, but you can override that by supplying a
C<path> argument.

It will return the location of the output file on success and false on
failure.

=cut

sub autobundle {
    my $self = shift;
    my $conf = $self->configure_object;
    my %hash = @_;

    my($path,$force,$verbose);
    my $tmpl = {
        force   => { default => $conf->get_conf('force'), store => \$force },
        verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
        path    => { default => File::Spec->catdir(
                                        $conf->get_conf('base'),
                                        $self->_perl_version( perl => $^X ),
                                        $conf->_get_build('distdir'),
                                        $conf->_get_build('autobundle') ),
                    store => \$path },
    };

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

    unless( -d $path ) {
        $self->_mkdir( dir => $path )
                or( error(loc("Could not create directory '%1'", $path ) ),
                    return
                );
    }

    my $name; my $file;
    {   ### default filename for the bundle ###
        my($year,$month,$day) = (localtime)[5,4,3];
        $year += 1900; $month++;

        my $ext = 0;

        my $prefix  = $conf->_get_build('autobundle_prefix');
        my $format  = "${prefix}_%04d_%02d_%02d_%02d";

        BLOCK: {
            $name = sprintf( $format, $year, $month, $day, $ext);

            $file = File::Spec->catfile( $path, $name . '.pm' );

            -f $file ? ++$ext && redo BLOCK : last BLOCK;
        }
    }
    my $fh;
    unless( $fh = FileHandle->new( ">$file" ) ) {
        error( loc( "Could not open '%1' for writing: %2", $file, $! ) );
        return;
    }
    
    ### make sure we load the module tree *before* doing this, as it
    ### starts to chdir all over the place
    $self->module_tree;

    my $string = join "\n\n",
                    map {
                        join ' ',
                            $_->module,
                            ($_->installed_version(verbose => 0) || 'undef')
                    } sort {
                        $a->module cmp $b->module
                    }  $self->installed;

    my $now     = scalar localtime;
    my $head    = '=head1';
    my $pkg     = __PACKAGE__;
    my $version = $self->VERSION;
    my $perl_v  = join '', `$^X -V`;

    print $fh <<EOF;
package $name

\$VERSION = '0.01';

1;

__END__

$head NAME

$name - Snapshot of your installation at $now

$head SYNOPSIS

perl -MCPANPLUS -e "install $name"

$head CONTENTS

$string

$head CONFIGURATION

$perl_v

$head AUTHOR

This bundle has been generated autotomatically by
    $pkg $version

EOF

    close $fh;

    return $file;
}

### XXX these wrappers are not individually tested! only the underlying
### code through source.t and indirectly trought he CustomSource plugin.
=pod

=head1 CUSTOM MODULE SOURCES

Besides the sources as provided by the general C<CPAN> mirrors, it's 
possible to add your own sources list to your C<CPANPLUS> index.

The methodology behind this works much like C<Debian's apt-sources>.

The methods below show you how to make use of this functionality. Also
note that most of these methods are available through the default shell
plugin command C</cs>, making them available as shortcuts through the
shell and via the commandline.

=head2 %files = $cb->list_custom_sources

Returns a mapping of registered custom sources and their local indices
as follows:

    /full/path/to/local/index => http://remote/source

Note that any file starting with an C<#> is being ignored.

=cut

sub list_custom_sources {
    return shift->__list_custom_module_sources( @_ );
}

=head2 $local_index = $cb->add_custom_source( uri => URI, [verbose => BOOL] );

Adds an C<URI> to your own sources list and mirrors its index. See the 
documentation on C<< $cb->update_custom_source >> on how this is done.

Returns the full path to the local index on success, or false on failure.

Note that when adding a new C<URI>, the change to the in-memory tree is
not saved until you rebuild or save the tree to disk again. You can do 
this using the C<< $cb->reload_indices >> method.

=cut

sub add_custom_source {
    return shift->_add_custom_module_source( @_ );
}

=head2 $local_index = $cb->remove_custom_source( uri => URI, [verbose => BOOL] );

Removes an C<URI> from your own sources list and removes its index.

To find out what C<URI>s you have as part of your own sources list, use
the C<< $cb->list_custom_sources >> method.

Returns the full path to the deleted local index file on success, or false
on failure.

=cut

### XXX do clever dispatching based on arg number?
sub remove_custom_source {
    return shift->_remove_custom_module_source( @_ );
}

=head2 $bool = $cb->update_custom_source( [remote => URI] );

Updates the indexes for all your custom sources. It does this by fetching
a file called C<packages.txt> in the root of the custom sources's C<URI>.
If you provide the C<remote> argument, it will only update the index for
that specific C<URI>.

Here's an example of how custom sources would resolve into index files:

  file:///path/to/sources       =>  file:///path/to/sources/packages.txt
  http://example.com/sources    =>  http://example.com/sources/packages.txt
  ftp://example.com/sources     =>  ftp://example.com/sources/packages.txt
  
The file C<packages.txt> simply holds a list of packages that can be found
under the root of the C<URI>. This file can be automatically generated for
you when the remote source is a C<file:// URI>. For C<http://>, C<ftp://>,
and similar, the administrator of that repository should run the method
C<< $cb->write_custom_source_index >> on the repository to allow remote
users to index it.

For details, see the C<< $cb->write_custom_source_index >> method below.

All packages that are added via this mechanism will be attributed to the
author with C<CPANID> C<LOCAL>. You can use this id to search for all 
added packages.

=cut

sub update_custom_source {
    my $self = shift;
    
    ### if it mentions /remote/, the request is to update a single uri,
    ### not all the ones we have, so dispatch appropriately
    my $rv = grep( /remote/i, @_)
        ? $self->__update_custom_module_source( @_ )
        : $self->__update_custom_module_sources( @_ );

    return $rv;
}    

=head2 $file = $cb->write_custom_source_index( path => /path/to/package/root, [to => /path/to/index/file, verbose => BOOL] );

Writes the index for a custom repository root. Most users will not have to 
worry about this, but administrators of a repository will need to make sure
their indexes are up to date.

The index will be written to a file called C<packages.txt> in your repository
root, which you can specify with the C<path> argument. You can override this
location by specifying the C<to> argument, but in normal operation, that should
not be required.

Once the index file is written, users can then add the C<URI> pointing to 
the repository to their custom list of sources and start using it right away. See the C<< $cb->add_custom_source >> method for user details.

=cut

sub write_custom_source_index {
    return shift->__write_custom_module_index( @_ );
}

1;

=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.

=head1 SEE ALSO

L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>, 
L<CPANPLUS::Selfupdate>

=cut

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

__END__

todo:
sub dist {          # not sure about this one -- probably already done
                      enough in Module.pm
sub reports {       # in Module.pm, wrapper here