summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:56:54 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 17:56:54 +0000
commit779e71f16ca01a6244b632b95bdb461fec163b34 (patch)
tree610b33e5531d7d432de62a216345c9daf1230d42 /Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm
parent539135f1864a2356d0eb3666e0f5b335680872a4 (diff)
New tlperl part XIII
git-svn-id: svn://tug.org/texlive/trunk@21435 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm232
1 files changed, 232 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Module/Author.pm
new file mode 100644
index 00000000000..92940fa51ff
--- /dev/null
+++ b/Master/tlpkg/tlperl/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: