[Summary view] [Print] [Text view]

   1  package CPANPLUS::Module::Fake;
   2  
   3  
   4  use CPANPLUS::Error;
   5  use CPANPLUS::Module;
   6  use CPANPLUS::Module::Author::Fake;
   7  use CPANPLUS::Internals;
   8  
   9  use strict;
  10  use vars            qw[@ISA];
  11  use Params::Check   qw[check];
  12  
  13  @ISA = qw[CPANPLUS::Module];
  14  $Params::Check::VERBOSE = 1;
  15  
  16  =pod
  17  
  18  =head1 NAME
  19  
  20  CPANPLUS::Module::Fake
  21  
  22  =head1 SYNOPSIS
  23  
  24      my $obj = CPANPLUS::Module::Fake->new(
  25                  module  => 'Foo',
  26                  path    => 'ftp/path/to/foo',
  27                  author  => CPANPLUS::Module::Author::Fake->new,
  28                  package => 'fake-1.1.tgz',
  29                  _id     => $cpan->_id,
  30              );
  31  
  32  =head1 DESCRIPTION
  33  
  34  A class for creating fake module objects, for shortcut use internally
  35  by CPANPLUS.
  36  
  37  Inherits from C<CPANPLUS::Module>.
  38  
  39  =head1 METHODS
  40  
  41  =head2 new( module => $mod, path => $path, package => $pkg, [_id => DIGIT] )
  42  
  43  Creates a dummy module object from the above parameters. It can
  44  take more options (same as C<< CPANPLUS::Module->new >> but the above
  45  are required.
  46  
  47  =cut
  48  
  49  sub new {
  50      my $class = shift;
  51      my %hash  = @_;
  52      
  53      local $Params::Check::ALLOW_UNKNOWN = 1;
  54      
  55      my $tmpl = {
  56          module  => { required => 1 },
  57          path    => { required => 1 },
  58          package => { required => 1 },
  59          _id     => { default => CPANPLUS::Internals->_last_id },
  60          author  => { default => '' },
  61      };
  62      
  63      my $args = check( $tmpl, \%hash ) or return;
  64      
  65      $args->{author} ||= CPANPLUS::Module::Author::Fake->new( 
  66                                                          _id => $args->{_id} );
  67      
  68      my $obj = CPANPLUS::Module->new( %$args ) or return;
  69      
  70      unless( $obj->_id ) {
  71          error(loc("No '%1' specified -- No CPANPLUS object associated!",'_id'));
  72          return;
  73      }        
  74      
  75      ### rebless object ###
  76      return bless $obj, $class;                                   
  77  }    
  78  
  79  1;
  80  
  81  # Local variables:
  82  # c-indentation-style: bsd
  83  # c-basic-offset: 4
  84  # indent-tabs-mode: nil
  85  # End:
  86  # vim: expandtab shiftwidth=4: