author.pm

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

package CPANPLUS::Module::Author;

use strict;

use CPANPLUS::Error;
use Params::Check               qw[check];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

local $Params::Check::VERBOSE = 1;

=pod

=head1 NAME

CPANPLUS::Module::Author

=head1 SYNOPSIS

    my $author = CPANPLUS::Module::Author->new(
                    author  => 'Jack Ashton',
                    cpanid  => 'JACKASH',
                    _id     => INTERNALS_OBJECT_ID,
                );

    $author->cpanid;
    $author->author;
    $author->email;

    @dists  = $author->distributions;
    @mods   = $author->modules;

    @accessors = CPANPLUS::Module::Author->accessors;

=head1 DESCRIPTION

C<CPANPLUS::Module::Author> creates objects from the information in the
source files. These can then be used to query on.

These objects should only be created internally. For C<fake> objects,
there's the C<CPANPLUS::Module::Author::Fake> class.

=head1 ACCESSORS

An objects of this class has the following accessors:

=over 4

=item author

Name of the author.

=item cpanid

The CPAN id of the author.

=item email

The email address of the author, which defaults to '' if not provided.

=item parent

The C<CPANPLUS::Internals::Object> that spawned this module object.

=back

=cut

my $tmpl = {
    author      => { required => 1 },   # full name of the author
    cpanid      => { required => 1 },   # cpan id
    email       => { default => '' },   # email address of the author
    _id         => { required => 1 },   # id of the Internals object that spawned us
};

### autogenerate accessors ###
for my $key ( keys %$tmpl ) {
    no strict 'refs';
    *{__PACKAGE__."::$key"} = sub {
        my $self = shift;
        $self->{$key} = $_[0] if @_;
        return $self->{$key};
    }
}

sub parent {
    my $self = shift;
    my $obj  = CPANPLUS::Internals->_retrieve_id( $self->_id );

    return $obj;
}

=pod

=head1 METHODS

=head2 $auth = CPANPLUS::Module::Author->new( author => AUTHOR_NAME, cpanid => CPAN_ID, _id => INTERNALS_ID [, email => AUTHOR_EMAIL] )

This method returns a C<CPANPLUS::Module::Author> object, based on the given
parameters.

Returns false on failure.

=cut

sub new {
    my $class   = shift;
    my %hash    = @_;

    ### don't check the template for sanity
    ### -- we know it's good and saves a lot of performance
    local $Params::Check::SANITY_CHECK_TEMPLATE = 0;

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

    return bless $object, $class;
}

=pod

=head2 @mod_objs = $auth->modules()

Return a list of module objects this author has released.

=cut

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

    my $aref = $cb->_search_module_tree(
                    type    => 'author',
                    allow   => [$self],
                );
    return @$aref if $aref;
    return;
}

=pod

=head2 @dists = $auth->distributions()

Returns a list of module objects representing all the distributions
this author has released.

=cut

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

    local $Params::Check::ALLOW_UNKNOWN = 1;
    local $Params::Check::NO_DUPLICATES = 1;

    my $mod;
    my $tmpl = {
        module  => { default => '', store => \$mod },
    };

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

    ### if we didn't get a module object passed, we'll find one ourselves ###
    unless( $mod ) {
        my @list = $self->modules;
        if( @list ) {
            $mod = $list[0];
        } else {
            error( loc( "This author has released no modules" ) );
            return;
        }
    }

    my $file = $mod->checksums( %hash );
    my $href = $mod->_parse_checksums_file( file => $file ) or return;

    my @rv;
    for my $dist ( keys %$href ) {
        my $clone = $mod->clone;

        $clone->package( $dist );
        $clone->module(  $clone->package_name );
        $clone->version( $clone->package_version );
        $clone->mtime(   $href->{$dist}->{'mtime'} );   # release date

        ### .meta files are now also in the checksums file,
        ### which means we have to filter out things that dont
        ### match our regex
        push @rv, $clone if $clone->package_extension;
    }

    return @rv;
}


=pod

=head1 CLASS METHODS

=head2 accessors ()

Returns a list of all accessor methods to the object

=cut

sub accessors { return keys %$tmpl };

1;

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