[Summary view] [Print] [Text view]

   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: