lib/CPANPLUS/Module/Author.pm

   1 package CPANPLUS::Module::Author;
   2
   3 use strict;
   4
   5 use CPANPLUS::Error;
   6 use Params::Check               qw[check];
   7 use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
   8
   9 local $Params::Check::VERBOSE = 1;
  10
  11 =pod
  12
  13 =head1 NAME
  14
  15 CPANPLUS::Module::Author
  16
  17 =head1 SYNOPSIS
  18
  19     my $author = CPANPLUS::Module::Author->new(
  20                     author  => 'Jack Ashton',
  21                     cpanid  => 'JACKASH',
  22                     _id     => INTERNALS_OBJECT_ID,
  23                 );
  24
  25     $author->cpanid;
  26     $author->author;
  27     $author->email;
  28
  29     @dists  = $author->distributions;
  30     @mods   = $author->modules;
  31
  32     @accessors = CPANPLUS::Module::Author->accessors;
  33
  34 =head1 DESCRIPTION
  35
  36 C<CPANPLUS::Module::Author> creates objects from the information in the
  37 source files. These can then be used to query on.
  38
  39 These objects should only be created internally. For C<fake> objects,
  40 there's the C<CPANPLUS::Module::Author::Fake> class.
  41
  42 =head1 ACCESSORS
  43
  44 An objects of this class has the following accessors:
  45
  46 =over 4
  47
  48 =item author
  49
  50 Name of the author.
  51
  52 =item cpanid
  53
  54 The CPAN id of the author.
  55
  56 =item email
  57
  58 The email address of the author, which defaults to '' if not provided.
  59
  60 =item parent
  61
  62 The C<CPANPLUS::Internals::Object> that spawned this module object.
  63
  64 =back
  65
  66 =cut
  67
  68 my $tmpl = {
  69     author      => { required => 1 },   # full name of the author
  70     cpanid      => { required => 1 },   # cpan id
  71     email       => { default => '' },   # email address of the author
  72     _id         => { required => 1 },   # id of the Internals object that spawned us
  73 };
  74
  75 ### autogenerate accessors ###
  76 for my $key ( keys %$tmpl ) {
  77     no strict 'refs';
  78     *{__PACKAGE__."::$key"} = sub {
  79         my $self = shift;
  80         $self->{$key} = $_[0] if @_;
  81         return $self->{$key};
  82     }
  83 }
  84
  85 sub parent {
  86     my $self = shift;
  87     my $obj  = CPANPLUS::Internals->_retrieve_id( $self->_id );
  88
  89     return $obj;
  90 }
  91
  92 =pod
  93
  94 =head1 METHODS
  95
  96 =head2 $auth = CPANPLUS::Module::Author->new( author => AUTHOR_NAME, cpanid => CPAN_ID, _id => INTERNALS_ID [, email => AUTHOR_EMAIL] )
  97
  98 This method returns a C<CPANPLUS::Module::Author> object, based on the given
  99 parameters.
 100
 101 Returns false on failure.
 102
 103 =cut
 104
 105 sub new {
 106     my $class   = shift;
 107     my %hash    = @_;
 108
 109     ### don't check the template for sanity
 110     ### -- we know it's good and saves a lot of performance
 111     local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
 112
 113     my $object = check( $tmpl, \%hash ) or return;
 114
 115     return bless $object, $class;
 116 }
 117
 118 =pod
 119
 120 =head2 @mod_objs = $auth->modules()
 121
 122 Return a list of module objects this author has released.
 123
 124 =cut
 125
 126 sub modules {
 127     my $self    = shift;
 128     my $cb      = $self->parent;
 129
 130     my $aref = $cb->_search_module_tree(
 131                     type    => 'author',
 132                     allow   => [$self],
 133                 );
 134     return @$aref if $aref;
 135     return;
 136 }
 137
 138 =pod
 139
 140 =head2 @dists = $auth->distributions()
 141
 142 Returns a list of module objects representing all the distributions
 143 this author has released.
 144
 145 =cut
 146
 147 sub distributions {
 148     my $self = shift;
 149     my %hash = @_;
 150
 151     local $Params::Check::ALLOW_UNKNOWN = 1;
 152     local $Params::Check::NO_DUPLICATES = 1;
 153
 154     my $mod;
 155     my $tmpl = {
 156         module  => { default => '', store => \$mod },
 157     };
 158
 159     my $args = check( $tmpl, \%hash ) or return;
 160
 161     ### if we didn't get a module object passed, we'll find one ourselves ###
 162     unless( $mod ) {
 163         my @list = $self->modules;
 164         if( @list ) {
 165             $mod = $list[0];
 166         } else {
 167             error( loc( "This author has released no modules" ) );
 168             return;
 169         }
 170     }
 171
 172     my $file = $mod->checksums( %hash );
 173     my $href = $mod->_parse_checksums_file( file => $file ) or return;
 174
 175     my @rv;
 176     for my $dist ( keys %$href ) {
 177         my $clone = $mod->clone;
 178
 179         $clone->package( $dist );
 180         $clone->module(  $clone->package_name );
 181         $clone->version( $clone->package_version );
 182         $clone->mtime(   $href->{$dist}->{'mtime'} );   # release date
 183
 184         ### .meta files are now also in the checksums file,
 185         ### which means we have to filter out things that dont
 186         ### match our regex
 187         push @rv, $clone if $clone->package_extension;
 188     }
 189
 190     return @rv;
 191 }
 192
 193
 194 =pod
 195
 196 =head1 CLASS METHODS
 197
 198 =head2 accessors ()
 199
 200 Returns a list of all accessor methods to the object
 201
 202 =cut
 203
 204 sub accessors { return keys %$tmpl };
 205
 206 1;
 207
 208 # Local variables:
 209 # c-indentation-style: bsd
 210 # c-basic-offset: 4
 211 # indent-tabs-mode: nil
 212 # End:
 213 # vim: expandtab shiftwidth=4: