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 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 objects, there's the C 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 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 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: