diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/CPANPLUS/Module/Author.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/CPANPLUS/Module/Author.pm | 232 |
1 files changed, 232 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/CPANPLUS/Module/Author.pm b/Master/tlpkg/tlperl0/lib/CPANPLUS/Module/Author.pm new file mode 100755 index 00000000000..92940fa51ff --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/CPANPLUS/Module/Author.pm @@ -0,0 +1,232 @@ +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 + +=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', + ### XXX, depending on backend, this is either an object + ### or the cpanid string. Dont 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: |