home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / CPANPLUS / Dist.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  16.1 KB  |  509 lines
  1. package CPANPLUS::Dist;
  2.  
  3. use strict;
  4.  
  5.  
  6. use CPANPLUS::Error;
  7. use CPANPLUS::Internals::Constants;
  8.  
  9. use Params::Check               qw[check];
  10. use Module::Load::Conditional   qw[can_load check_install];
  11. use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  12. use Object::Accessor;
  13.  
  14. local $Params::Check::VERBOSE = 1;
  15.  
  16. my @methods = qw[status parent];
  17. for my $key ( @methods ) {
  18.     no strict 'refs';
  19.     *{__PACKAGE__."::$key"} = sub {
  20.         my $self = shift;
  21.         $self->{$key} = $_[0] if @_;
  22.         return $self->{$key};
  23.     }
  24. }
  25.  
  26. =pod
  27.  
  28. =head1 NAME
  29.  
  30. CPANPLUS::Dist
  31.  
  32. =head1 SYNOPSIS
  33.  
  34.     my $dist = CPANPLUS::Dist->new(
  35.                                 format  => 'build',
  36.                                 module  => $modobj,
  37.                             );
  38.  
  39. =head1 DESCRIPTION
  40.  
  41. C<CPANPLUS::Dist> is a base class for C<CPANPLUS::Dist::MM>
  42. and C<CPANPLUS::Dist::Build>. Developers of other C<CPANPLUS::Dist::*>
  43. plugins should look at C<CPANPLUS::Dist::Base>.
  44.  
  45. =head1 ACCESSORS
  46.  
  47. =over 4
  48.  
  49. =item parent()
  50.  
  51. Returns the C<CPANPLUS::Module> object that parented this object.
  52.  
  53. =item status()
  54.  
  55. Returns the C<Object::Accessor> object that keeps the status for
  56. this module.
  57.  
  58. =back
  59.  
  60. =head1 STATUS ACCESSORS
  61.  
  62. All accessors can be accessed as follows:
  63.     $deb->status->ACCESSOR
  64.  
  65. =over 4
  66.  
  67. =item created()
  68.  
  69. Boolean indicating whether the dist was created successfully.
  70. Explicitly set to C<0> when failed, so a value of C<undef> may be
  71. interpreted as C<not yet attempted>.
  72.  
  73. =item installed()
  74.  
  75. Boolean indicating whether the dist was installed successfully.
  76. Explicitly set to C<0> when failed, so a value of C<undef> may be
  77. interpreted as C<not yet attempted>.
  78.  
  79. =item uninstalled()
  80.  
  81. Boolean indicating whether the dist was uninstalled successfully.
  82. Explicitly set to C<0> when failed, so a value of C<undef> may be
  83. interpreted as C<not yet attempted>.
  84.  
  85. =item dist()
  86.  
  87. The location of the final distribution. This may be a file or
  88. directory, depending on how your distribution plug in of choice
  89. works. This will be set upon a successful create.
  90.  
  91. =cut
  92.  
  93. =back
  94.  
  95. =head2 $dist = CPANPLUS::Dist->new( module => MODOBJ, [format => DIST_TYPE] );
  96.  
  97. Create a new C<CPANPLUS::Dist> object based on the provided C<MODOBJ>.
  98. The optional argument C<format> is used to indicate what type of dist
  99. you would like to create (like C<makemaker> for a C<CPANPLUS::Dist::MM>
  100. object, C<build> for a C<CPANPLUS::Dist::Build> object, and so on ).
  101. If not provided, will default to the setting as specified by your
  102. config C<dist_type>.
  103.  
  104. Returns a C<CPANPLUS::Dist> object on success and false on failure.
  105.  
  106. =cut
  107.  
  108. sub new {
  109.     my $self = shift;
  110.     my %hash = @_;
  111.  
  112.     local $Params::Check::ALLOW_UNKNOWN = 1;
  113.  
  114.     ### first verify we got a module object ###
  115.     my $mod;
  116.     my $tmpl = {
  117.         module  => { required => 1, allow => IS_MODOBJ, store => \$mod },
  118.     };
  119.     check( $tmpl, \%hash ) or return;
  120.  
  121.     ### get the conf object ###
  122.     my $conf = $mod->parent->configure_object();
  123.  
  124.     ### figure out what type of dist object to create ###
  125.     my $format;
  126.     my $tmpl2 = {
  127.         format  => {    default => $conf->get_conf('dist_type'),
  128.                         allow   => [ __PACKAGE__->dist_types ],
  129.                         store   => \$format  },
  130.     };
  131.     check( $tmpl2, \%hash ) or return;
  132.  
  133.  
  134.     unless( can_load( modules => { $format => '0.0' }, verbose => 1 ) ) {
  135.         error(loc("'%1' not found -- you need '%2' version '%3' or higher ".
  136.                     "to detect plugins", $format, 'Module::Pluggable','2.4'));
  137.         return;
  138.     }
  139.  
  140.     ### bless the object in the child class ###
  141.     my $obj = bless { parent => $mod }, $format;
  142.  
  143.     ### check if the format is available in this environment ###
  144.     if( $conf->_get_build('sanity_check') and not $obj->format_available ) {
  145.         error( loc( "Format '%1' is not available",$format) );
  146.         return;
  147.     }
  148.  
  149.     ### create a status object ###
  150.     {   my $acc = Object::Accessor->new;
  151.         $obj->status($acc);
  152.  
  153.         ### add minimum supported accessors
  154.         $acc->mk_accessors( qw[prepared created installed uninstalled 
  155.                                distdir dist] );
  156.     }
  157.  
  158.     ### now initialize it or admit failure
  159.     unless( $obj->init ) {
  160.         error(loc("Dist initialization of '%1' failed for '%2'",
  161.                     $format, $mod->module));
  162.         return;
  163.     }
  164.  
  165.     ### return the object
  166.     return $obj;
  167. }
  168.  
  169. =head2 @dists = CPANPLUS::Dist->dist_types;
  170.  
  171. Returns a list of the CPANPLUS::Dist::* classes available
  172.  
  173. =cut
  174.  
  175. ### returns a list of dist_types we support
  176. ### will get overridden by Module::Pluggable if loaded
  177. ### XXX add support for 'plugin' dir in config as well
  178. {   my $Loaded;
  179.     my @Dists   = (INSTALLER_MM);
  180.     my @Ignore  = ();
  181.  
  182.     ### backdoor method to add more dist types
  183.     sub _add_dist_types     { my $self = shift; push @Dists,  @_ };
  184.     
  185.     ### backdoor method to exclude dist types
  186.     sub _ignore_dist_types  { my $self = shift; push @Ignore, @_ };
  187.  
  188.     ### locally add the plugins dir to @INC, so we can find extra plugins
  189.     #local @INC = @INC, File::Spec->catdir(
  190.     #                        $conf->get_conf('base'),
  191.     #                        $conf->_get_build('plugins') );
  192.  
  193.     ### load any possible plugins
  194.     sub dist_types {
  195.  
  196.         if ( !$Loaded++ and check_install(  module  => 'Module::Pluggable',
  197.                                             version => '2.4')
  198.         ) {
  199.             require Module::Pluggable;
  200.  
  201.             my $only_re = __PACKAGE__ . '::\w+$';
  202.  
  203.             Module::Pluggable->import(
  204.                             sub_name    => '_dist_types',
  205.                             search_path => __PACKAGE__,
  206.                             only        => qr/$only_re/,
  207.                             except      => [ INSTALLER_MM, 
  208.                                              INSTALLER_SAMPLE,
  209.                                              INSTALLER_BASE,
  210.                                         ]
  211.                         );
  212.             my %ignore = map { $_ => $_ } @Ignore;                        
  213.                         
  214.             push @Dists, grep { not $ignore{$_}  } __PACKAGE__->_dist_types;
  215.         }
  216.  
  217.         return @Dists;
  218.     }
  219. }
  220.  
  221. =head2 prereq_satisfied( modobj => $modobj, version => $version_spec )
  222.  
  223. Returns true if this prereq is satisfied.  Returns false if it's not.
  224. Also issues an error if it seems "unsatisfiable," i.e. if it can't be
  225. found on CPAN or the latest CPAN version doesn't satisfy it.
  226.  
  227. =cut
  228.  
  229. sub prereq_satisfied {
  230.     my $dist = shift;
  231.     my $cb   = $dist->parent->parent;
  232.     my %hash = @_;
  233.   
  234.     my($mod,$ver);
  235.     my $tmpl = {
  236.         version => { required => 1, store => \$ver },
  237.         modobj  => { required => 1, store => \$mod, allow => IS_MODOBJ },
  238.     };
  239.     
  240.     check( $tmpl, \%hash ) or return;
  241.   
  242.     return 1 if $mod->is_uptodate( version => $ver );
  243.   
  244.     if ( $cb->_vcmp( $ver, $mod->version ) > 0 ) {
  245.  
  246.         error(loc(  
  247.                 "This distribution depends on %1, but the latest version".
  248.                 " of %2 on CPAN (%3) doesn't satisfy the specific version".
  249.                 " dependency (%4). You may have to resolve this dependency ".
  250.                 "manually.", 
  251.                 $mod->module, $mod->module, $mod->version, $ver ));
  252.   
  253.     }
  254.  
  255.     return;
  256. }
  257.  
  258. =head2 _resolve_prereqs
  259.  
  260. Makes sure prerequisites are resolved
  261.  
  262. XXX Need docs, internal use only
  263.  
  264. =cut
  265.  
  266. sub _resolve_prereqs {
  267.     my $dist = shift;
  268.     my $self = $dist->parent;
  269.     my $cb   = $self->parent;
  270.     my $conf = $cb->configure_object;
  271.     my %hash = @_;
  272.  
  273.     my ($prereqs, $format, $verbose, $target, $force, $prereq_build);
  274.     my $tmpl = {
  275.         ### XXX perhaps this should not be required, since it may not be
  276.         ### packaged, just installed...
  277.         ### Let it be empty as well -- that means the $modobj->install
  278.         ### routine will figure it out, which is fine if we didn't have any
  279.         ### very specific wishes (it will even detect the favourite
  280.         ### dist_type).
  281.         format          => { required => 1, store => \$format,
  282.                                 allow => ['',__PACKAGE__->dist_types], },
  283.         prereqs         => { required => 1, default => { },
  284.                                 strict_type => 1, store => \$prereqs },
  285.         verbose         => { default => $conf->get_conf('verbose'),
  286.                                 store => \$verbose },
  287.         force           => { default => $conf->get_conf('force'),
  288.                                 store => \$force },
  289.                         ### make sure allow matches with $mod->install's list
  290.         target          => { default => '', store => \$target,
  291.                                 allow => ['',qw[create ignore install]] },
  292.         prereq_build    => { default => 0, store => \$prereq_build },
  293.     };
  294.  
  295.     check( $tmpl, \%hash ) or return;
  296.  
  297.     ### so there are no prereqs? then don't even bother
  298.     return 1 unless keys %$prereqs;
  299.  
  300.     ### so you didn't provide an explicit target.
  301.     ### maybe your config can tell us what to do.
  302.     $target ||= {
  303.         PREREQ_ASK,     TARGET_INSTALL, # we'll bail out if the user says no
  304.         PREREQ_BUILD,   TARGET_CREATE,
  305.         PREREQ_IGNORE,  TARGET_IGNORE,
  306.         PREREQ_INSTALL, TARGET_INSTALL,
  307.     }->{ $conf->get_conf('prereqs') } || '';
  308.     
  309.     ### XXX BIG NASTY HACK XXX FIXME at some point.
  310.     ### when installing Bundle::CPANPLUS::Dependencies, we want to
  311.     ### install all packages matching 'cpanplus' to be installed last,
  312.     ### as all CPANPLUS' prereqs are being installed as well, but are
  313.     ### being loaded for bootstrapping purposes. This means CPANPLUS
  314.     ### can find them, but for example cpanplus::dist::build won't,
  315.     ### which gets messy FAST. So, here we sort our prereqs only IF
  316.     ### the parent module is Bundle::CPANPLUS::Dependencies.
  317.     ### Really, we would wnat some sort of sorted prereq mechanism,
  318.     ### but Bundle:: doesn't support it, and we flatten everything
  319.     ### to a hash internally. A sorted hash *might* do the trick if
  320.     ### we got a transparent implementation.. that would mean we would
  321.     ### just have to remove the 'sort' here, and all will be well
  322.     my @sorted_prereqs;
  323.     
  324.     ### use regex, could either be a module name, or a package name
  325.     if( $self->module =~ /^Bundle(::|-)CPANPLUS(::|-)Dependencies/ ) {
  326.         my (@first, @last);
  327.         for my $mod ( sort keys %$prereqs ) {
  328.             $mod =~ /CPANPLUS/
  329.                 ? push @last,  $mod
  330.                 : push @first, $mod;
  331.         }
  332.         @sorted_prereqs = (@first, @last);
  333.     } else {
  334.         @sorted_prereqs = sort keys %$prereqs;
  335.     }
  336.  
  337.     ### first, transfer this key/value pairing into a
  338.     ### list of module objects + desired versions
  339.     my @install_me;
  340.     
  341.     for my $mod ( @sorted_prereqs ) {
  342.         my $version = $prereqs->{$mod};
  343.         my $modobj  = $cb->module_tree($mod);
  344.  
  345.         #### XXX we ignore the version, and just assume that the latest
  346.         #### version from cpan will meet your requirements... dodgy =/
  347.         unless( $modobj ) {
  348.             error( loc( "No such module '%1' found on CPAN", $mod ) );
  349.             next;
  350.         }
  351.  
  352.         ### it's not uptodate, we need to install it
  353.         if( !$dist->prereq_satisfied(modobj => $modobj, version => $version)) {
  354.             msg(loc("Module '%1' requires '%2' version '%3' to be installed ",
  355.                     $self->module, $modobj->module, $version), $verbose );
  356.  
  357.             push @install_me, [$modobj, $version];
  358.  
  359.         ### it's not an MM or Build format, that means it's a package
  360.         ### manager... we'll need to install it as well, via the PM
  361.         } elsif ( INSTALL_VIA_PACKAGE_MANAGER->($format) and
  362.                     !$modobj->package_is_perl_core and
  363.                     ($target ne TARGET_IGNORE)
  364.         ) {
  365.             msg(loc("Module '%1' depends on '%2', may need to build a '%3' ".
  366.                     "package for it as well", $self->module, $modobj->module,
  367.                     $format));
  368.             push @install_me, [$modobj, $version];
  369.         }
  370.     }
  371.  
  372.  
  373.  
  374.     ### so you just want to ignore prereqs? ###
  375.     if( $target eq TARGET_IGNORE ) {
  376.  
  377.         ### but you have modules you need to install
  378.         if( @install_me ) {
  379.             msg(loc("Ignoring prereqs, this may mean your install will fail"),
  380.                 $verbose);
  381.             msg(loc("'%1' listed the following dependencies:", $self->module),
  382.                 $verbose);
  383.  
  384.             for my $aref (@install_me) {
  385.                 my ($mod,$version) = @$aref;
  386.  
  387.                 my $str = sprintf "\t%-35s %8s\n", $mod->module, $version;
  388.                 msg($str,$verbose);
  389.             }
  390.  
  391.             return;
  392.  
  393.         ### ok, no problem, you have all needed prereqs anyway
  394.         } else {
  395.             return 1;
  396.         }
  397.     }
  398.  
  399.     my $flag;
  400.     for my $aref (@install_me) {
  401.         my($modobj,$version) = @$aref;
  402.  
  403.         ### another prereq may have already installed this one...
  404.         ### so dont ask again if the module turns out to be uptodate
  405.         ### see bug [#11840]
  406.         ### if either force or prereq_build are given, the prereq
  407.         ### should be built anyway
  408.         next if (!$force and !$prereq_build) && 
  409.                 $dist->prereq_satisfied(modobj => $modobj, version => $version);
  410.  
  411.         ### either we're told to ignore the prereq,
  412.         ### or the user wants us to ask him
  413.         if( ( $conf->get_conf('prereqs') == PREREQ_ASK and not
  414.               $cb->_callbacks->install_prerequisite->($self, $modobj)
  415.             )
  416.         ) {
  417.             msg(loc("Will not install prerequisite '%1' -- Note " .
  418.                     "that the overall install may fail due to this",
  419.                     $modobj->module), $verbose);
  420.             next;
  421.         }
  422.  
  423.         ### value set and false -- means failure ###
  424.         if( defined $modobj->status->installed
  425.             && !$modobj->status->installed
  426.         ) {
  427.             error( loc( "Prerequisite '%1' failed to install before in " .
  428.                         "this session", $modobj->module ) );
  429.             $flag++;
  430.             last;
  431.         }
  432.  
  433.         ### part of core?
  434.         if( $modobj->package_is_perl_core ) {
  435.             error(loc("Prerequisite '%1' is perl-core (%2) -- not ".
  436.                       "installing that. Aborting install",
  437.                       $modobj->module, $modobj->package ) );
  438.             $flag++;
  439.             last;
  440.         }
  441.  
  442.         ### circular dependency code ###
  443.         my $pending = $cb->_status->pending_prereqs || {};
  444.  
  445.         ### recursive dependency ###
  446.         if ( $pending->{ $modobj->module } ) {
  447.             error( loc( "Recursive dependency detected (%1) -- skipping",
  448.                         $modobj->module ) );
  449.             next;
  450.         }
  451.  
  452.         ### register this dependency as pending ###
  453.         $pending->{ $modobj->module } = $modobj;
  454.         $cb->_status->pending_prereqs( $pending );
  455.  
  456.  
  457.         ### call $modobj->install rather than doing
  458.         ### CPANPLUS::Dist->new and the like ourselves,
  459.         ### since ->install will take care of fetch &&
  460.         ### extract as well
  461.         my $pa = $dist->status->_prepare_args   || {};
  462.         my $ca = $dist->status->_create_args    || {};
  463.         my $ia = $dist->status->_install_args   || {};
  464.  
  465.         unless( $modobj->install(   %$pa, %$ca, %$ia,
  466.                                     force   => $force,
  467.                                     verbose => $verbose,
  468.                                     format  => $format,
  469.                                     target  => $target )
  470.         ) {
  471.             error(loc("Failed to install '%1' as prerequisite " .
  472.                       "for '%2'", $modobj->module, $self->module ) );
  473.             $flag++;
  474.         }
  475.  
  476.         ### unregister the pending dependency ###
  477.         $pending->{ $modobj->module } = 0;
  478.         $cb->_status->pending_prereqs( $pending );
  479.  
  480.         last if $flag;
  481.  
  482.         ### don't want us to install? ###
  483.         if( $target ne TARGET_INSTALL ) {
  484.             my $dir = $modobj->status->extract
  485.                         or error(loc("No extraction dir for '%1' found ".
  486.                                      "-- weird", $modobj->module));
  487.  
  488.             $modobj->add_to_includepath();
  489.             
  490.             next;
  491.         }
  492.     }
  493.  
  494.     ### reset the $prereqs iterator, in case we bailed out early ###
  495.     keys %$prereqs;
  496.  
  497.     return 1 unless $flag;
  498.     return;
  499. }
  500.  
  501. 1;
  502.  
  503. # Local variables:
  504. # c-indentation-style: bsd
  505. # c-basic-offset: 4
  506. # indent-tabs-mode: nil
  507. # End:
  508. # vim: expandtab shiftwidth=4:
  509.