package CPANPLUS::Module::Author; use strict; use CPANPLUS::Error; use CPANPLUS::Internals::Constants; use Params::Check qw[check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; local $Params::Check::VERBOSE = 1; =pod =head1 NAME CPANPLUS::Module::Author - CPAN author object for CPANPLUS =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', ### XXX, depending on backend, this is either an object ### or the cpanid string. Don't know an elegant way to ### solve this right now, so passing both allow => [$self, $self->cpanid], ); 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 $name ( keys %$href ) { ### shortcut asap, so we avoid extra ops. On big checksums files ### the call to clone() takes up a lot of time. ### .meta files are now also in the checksums file, ### which means we have to filter out things that dont ### match our regex next if $mod->package_extension( $name ) eq META_EXT; ### used to do this wiht ->clone. However, that calls ->dslip, ### (which is wrong anyway, as we're doing a different module), ### which in turn calls ->contains, which scans the entire ### module tree using _search_module_tree, which uses P::C ### and is therefor VERY VERY slow. ### so let's do this the direct way for speed ups. my $dist = CPANPLUS::Module::Fake->new( module => do { my $m = $mod->package_name( $name ); $m =~ s/-/::/g; $m; }, version => $mod->package_version( $name ), package => $name, path => $mod->path, # same author after all author => $mod->author, # same author after all mtime => $href->{$name}->{'mtime'}, # release date ); push @rv, $dist; } 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: