cpan/CPANPLUS/lib/CPANPLUS/Module/Author.pm

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