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 / Selfupdate.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  16.0 KB  |  536 lines
  1. package CPANPLUS::Selfupdate;
  2.  
  3. use strict;
  4. use Params::Check               qw[check];
  5. use IPC::Cmd                    qw[can_run];
  6. use CPANPLUS::Error             qw[error msg];
  7. use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';
  8.  
  9. use CPANPLUS::Internals::Constants;
  10.  
  11. $Params::Check::VERBOSE = 1;
  12.  
  13. =head1 NAME
  14.  
  15. CPANPLUS::Selfupdate
  16.  
  17. =head1 SYNOPSIS
  18.  
  19.     $su     = $cb->selfupdate_object;
  20.     
  21.     @feats  = $su->list_features;
  22.     @feats  = $su->list_enabled_features;
  23.     
  24.     @mods   = map { $su->modules_for_feature( $_ ) } @feats;
  25.     @mods   = $su->list_core_dependencies;
  26.     @mods   = $su->list_core_modules;
  27.     
  28.     for ( @mods ) {
  29.         print $_->name " should be version " . $_->version_required;
  30.         print "Installed version is not uptodate!" 
  31.             unless $_->is_installed_version_sufficient;
  32.     }
  33.     
  34.     $ok     = $su->selfupdate( update => 'all', latest => 0 );
  35.  
  36. =cut
  37.  
  38. ### a config has describing our deps etc
  39. {
  40.  
  41.     my $Modules = {
  42.         dependencies => {
  43.             'File::Fetch'               => '0.13_04', # win32 & VMS file://
  44.             'File::Spec'                => '0.82',
  45.             'IPC::Cmd'                  => '0.36', # 5.6.2 compat: 2-arg open
  46.             'Locale::Maketext::Simple'  => '0.01',
  47.             'Log::Message'              => '0.01',
  48.             'Module::Load'              => '0.10',
  49.             'Module::Load::Conditional' => '0.18', # Better parsing: #23995,
  50.                                                    # uses version.pm for <=>
  51.             'version'                   => '0.73', # needed for M::L::C
  52.                                                    # addresses #24630 and 
  53.                                                    # #24675
  54.                                                    # Address ~0 overflow issue
  55.             'Params::Check'             => '0.22',
  56.             'Package::Constants'        => '0.01',
  57.             'Term::UI'                  => '0.18', # option parsing
  58.             'Test::Harness'             => '2.62', # due to bug #19505
  59.                                                    # only 2.58 and 2.60 are bad
  60.             'Test::More'                => '0.47', # to run our tests
  61.             'Archive::Extract'          => '0.16', # ./Dir bug fix
  62.             'Archive::Tar'              => '1.23',
  63.             'IO::Zlib'                  => '1.04', # needed for Archive::Tar
  64.             'Object::Accessor'          => '0.32', # overloaded stringification
  65.             'Module::CoreList'          => '2.09',
  66.             'Module::Pluggable'         => '2.4',
  67.             'Module::Loaded'            => '0.01',
  68.         },
  69.     
  70.         features => {
  71.             # config_key_name => [
  72.             #     sub { } to list module key/value pairs
  73.             #     sub { } to check if feature is enabled
  74.             # ]
  75.             prefer_makefile => [
  76.                 sub {
  77.                     my $cb = shift;
  78.                     $cb->configure_object->get_conf('prefer_makefile') 
  79.                         ? { }
  80.                         : { 'CPANPLUS::Dist::Build' => '0.04'  };
  81.                 },
  82.                 sub { return 1 },   # always enabled
  83.             ],            
  84.             cpantest        => [
  85.                 {
  86.                     'YAML::Tiny'     => '0.0',
  87.                     'Test::Reporter' => '1.34',
  88.                 },
  89.                 sub { 
  90.                     my $cb = shift;
  91.                     return $cb->configure_object->get_conf('cpantest');
  92.                 },
  93.             ],                
  94.             dist_type => [
  95.                 sub { 
  96.                     my $cb      = shift;
  97.                     my $dist    = $cb->configure_object->get_conf('dist_type');
  98.                     return { $dist => '0.0' } if $dist;
  99.                     return;
  100.                 },            
  101.                 sub { 
  102.                     my $cb = shift;
  103.                     return $cb->configure_object->get_conf('dist_type');
  104.                 },
  105.             ],
  106.  
  107.             md5 => [
  108.                 {
  109.                     'Digest::MD5'   => '0.0',
  110.                 },            
  111.                 sub { 
  112.                     my $cb = shift;
  113.                     return $cb->configure_object->get_conf('md5');
  114.                 },
  115.             ],
  116.             shell => [
  117.                 sub { 
  118.                     my $cb      = shift;
  119.                     my $dist    = $cb->configure_object->get_conf('shell');
  120.                     
  121.                     ### we bundle these shells, so don't bother having a dep
  122.                     ### on them... If we don't do this, CPAN.pm actually detects
  123.                     ### a recursive dependency and breaks (see #26077).
  124.                     ### This is not an issue for CPANPLUS itself, it handles
  125.                     ### it smartly.
  126.                     return if $dist eq SHELL_DEFAULT or $dist eq SHELL_CLASSIC;
  127.                     return { $dist => '0.0' } if $dist;
  128.                     return;
  129.                 },            
  130.                 sub { return 1 },
  131.             ],                
  132.             signature => [
  133.                 sub {
  134.                     my $cb      = shift;
  135.                     return {
  136.                         'Module::Signature' => '0.06',
  137.                     } if can_run('gpg');
  138.                     ### leave this out -- Crypt::OpenPGP is fairly
  139.                     ### painful to install, and broken on some platforms
  140.                     ### so we'll just always fall back to gpg. It may
  141.                     ### issue a warning or 2, but that's about it.
  142.                     ### this change due to this ticket: #26914
  143.                     # and $cb->configure_object->get_conf('prefer_bin');
  144.  
  145.                     return { 
  146.                         'Crypt::OpenPGP'    => '0.0', 
  147.                         'Module::Signature' => '0.06',
  148.                     };
  149.                 },            
  150.                 sub {
  151.                     my $cb = shift;
  152.                     return $cb->configure_object->get_conf('signature');
  153.                 },
  154.             ],
  155.             storable => [
  156.                 { 'Storable' => '0.0' },         
  157.                 sub { 
  158.                     my $cb = shift;
  159.                     return $cb->configure_object->get_conf('storable');
  160.                 },
  161.             ],
  162.         },
  163.         core => {
  164.             'CPANPLUS' => '0.0',
  165.         },
  166.     };
  167.  
  168.     sub _get_config { return $Modules }
  169. }
  170.  
  171. =head1 METHODS
  172.  
  173. =head2 $self = CPANPLUS::Selfupdate->new( $backend_object );
  174.  
  175. Sets up a new selfupdate object. Called automatically when
  176. a new backend object is created.
  177.  
  178. =cut
  179.  
  180. sub new {
  181.     my $class = shift;
  182.     my $cb    = shift or return;
  183.     return bless sub { $cb }, $class;
  184. }    
  185.  
  186.  
  187. {   ### cache to find the relevant modules
  188.     my $cache = {
  189.         core 
  190.             => sub { my $self = shift;
  191.                      core => [ $self->list_core_modules ]   },
  192.  
  193.         dependencies        
  194.             => sub { my $self = shift;
  195.                      dependencies => [ $self->list_core_dependencies ] },
  196.  
  197.         enabled_features    
  198.             => sub { my $self = shift;
  199.                      map { $_ => [ $self->modules_for_feature( $_ ) ] }
  200.                         $self->list_enabled_features 
  201.                    },
  202.         features
  203.             => sub { my $self = shift;
  204.                      map { $_ => [ $self->modules_for_feature( $_ ) ] }
  205.                         $self->list_features   
  206.                    },
  207.             ### make sure to do 'core' first, in case
  208.             ### we are out of date ourselves
  209.         all => [ qw|core dependencies enabled_features| ],
  210.     };
  211.     
  212.     
  213. =head2 @cat = $self->list_categories
  214.  
  215. Returns a list of categories that the C<selfupdate> method accepts.
  216.  
  217. See C<selfupdate> for details.
  218.  
  219. =cut
  220.  
  221.     sub list_categories { return sort keys %$cache }
  222.  
  223. =head2 %list = $self->list_modules_to_update( update => "core|dependencies|enabled_features|features|all", [latest => BOOL] )
  224.     
  225. List which modules C<selfupdate> would upgrade. You can update either 
  226. the core (CPANPLUS itself), the core dependencies, all features you have
  227. currently turned on, or all features available, or everything.
  228.  
  229. The C<latest> option determines whether it should update to the latest
  230. version on CPAN, or if the minimal required version for CPANPLUS is
  231. good enough.
  232.     
  233. Returns a hash of feature names and lists of module objects to be
  234. upgraded based on the category you provided. For example:
  235.  
  236.     %list = $self->list_modules_to_update( update => 'core' );
  237.     
  238. Would return:
  239.  
  240.     ( core => [ $module_object_for_cpanplus ] );
  241.     
  242. =cut    
  243.     
  244.     sub list_modules_to_update {
  245.         my $self = shift;
  246.         my $cb   = $self->();
  247.         my $conf = $cb->configure_object;
  248.         my %hash = @_;
  249.         
  250.         my($type, $latest);
  251.         my $tmpl = {
  252.             update => { required => 1, store => \$type,
  253.                          allow   => [ keys %$cache ], },
  254.             latest => { default  => 0, store => \$latest, allow => BOOLEANS },                     
  255.         };    
  256.     
  257.         {   local $Params::Check::ALLOW_UNKNOWN = 1;
  258.             check( $tmpl, \%hash ) or return;
  259.         }
  260.     
  261.         my $ref     = $cache->{$type};
  262.  
  263.         ### a list of ( feature1 => \@mods, feature2 => \@mods, etc )        
  264.         my %list    = UNIVERSAL::isa( $ref, 'ARRAY' )
  265.                             ? map { $cache->{$_}->( $self ) } @$ref
  266.                             : $ref->( $self );
  267.  
  268.         ### filter based on whether we need the latest ones or not
  269.         for my $aref ( values %list ) {              
  270.               $aref = [ $latest 
  271.                         ? grep { !$_->is_uptodate } @$aref
  272.                         : grep { !$_->is_installed_version_sufficient } @$aref
  273.                       ];
  274.         }
  275.         
  276.         return %list;
  277.     }
  278.     
  279. =head2 $bool = $self->selfupdate( update => "core|dependencies|enabled_features|features|all", [latest => BOOL, force => BOOL] )
  280.  
  281. Selfupdate CPANPLUS. You can update either the core (CPANPLUS itself),
  282. the core dependencies, all features you have currently turned on, or
  283. all features available, or everything.
  284.  
  285. The C<latest> option determines whether it should update to the latest
  286. version on CPAN, or if the minimal required version for CPANPLUS is
  287. good enough.
  288.  
  289. Returns true on success, false on error.
  290.  
  291. =cut
  292.  
  293.     sub selfupdate {
  294.         my $self = shift;
  295.         my $cb   = $self->();
  296.         my $conf = $cb->configure_object;
  297.         my %hash = @_;
  298.     
  299.         my $force;
  300.         my $tmpl = {
  301.             force  => { default => $conf->get_conf('force'), store => \$force },
  302.         };    
  303.     
  304.         {   local $Params::Check::ALLOW_UNKNOWN = 1;
  305.             check( $tmpl, \%hash ) or return;
  306.         }
  307.     
  308.         my %list = $self->list_modules_to_update( %hash ) or return;
  309.  
  310.         ### just the modules please
  311.         my @mods = map { @$_ } values %list;
  312.         
  313.         my $flag;
  314.         for my $mod ( @mods ) {
  315.             unless( $mod->install( force => $force ) ) {
  316.                 $flag++;
  317.                 error(loc("Failed to update module '%1'", $mod->name));
  318.             }
  319.         }
  320.         
  321.         return if $flag;
  322.         return 1;
  323.     }    
  324.  
  325. }
  326.  
  327. =head2 @features = $self->list_features
  328.  
  329. Returns a list of features that are supported by CPANPLUS.
  330.  
  331. =cut
  332.  
  333. sub list_features {
  334.     my $self = shift;
  335.     return keys %{ $self->_get_config->{'features'} };
  336. }
  337.  
  338. =head2 @features = $self->list_enabled_features
  339.  
  340. Returns a list of features that are enabled in your current
  341. CPANPLUS installation.
  342.  
  343. =cut
  344.  
  345. sub list_enabled_features {
  346.     my $self = shift;
  347.     my $cb   = $self->();
  348.     
  349.     my @enabled;
  350.     for my $feat ( $self->list_features ) {
  351.         my $ref = $self->_get_config->{'features'}->{$feat}->[1];
  352.         push @enabled, $feat if $ref->($cb);
  353.     }
  354.     
  355.     return @enabled;
  356. }
  357.  
  358. =head2 @mods = $self->modules_for_feature( FEATURE [,AS_HASH] )
  359.  
  360. Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
  361. represent the modules required to support this feature.
  362.  
  363. For a list of features, call the C<list_features> method.
  364.  
  365. If the C<AS_HASH> argument is provided, no module objects are
  366. returned, but a hashref where the keys are names of the modules,
  367. and values are their minimum versions.
  368.  
  369. =cut
  370.  
  371. sub modules_for_feature {
  372.     my $self    = shift;
  373.     my $feature = shift or return;
  374.     my $as_hash = shift || 0;
  375.     my $cb      = $self->();
  376.     
  377.     unless( exists $self->_get_config->{'features'}->{$feature} ) {
  378.         error(loc("Unknown feature '%1'", $feature));
  379.         return;
  380.     }
  381.     
  382.     my $ref = $self->_get_config->{'features'}->{$feature}->[0];
  383.     
  384.     ### it's either a list of modules/versions or a subroutine that
  385.     ### returns a list of modules/versions
  386.     my $href = UNIVERSAL::isa( $ref, 'HASH' ) ? $ref : $ref->( $cb );
  387.     
  388.     return unless $href;    # nothing needed for the feature?
  389.  
  390.     return $href if $as_hash;
  391.     return $self->_hashref_to_module( $href );
  392. }
  393.  
  394.  
  395. =head2 @mods = $self->list_core_dependencies( [AS_HASH] )
  396.  
  397. Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
  398. represent the modules that comprise the core dependencies of CPANPLUS.
  399.  
  400. If the C<AS_HASH> argument is provided, no module objects are
  401. returned, but a hashref where the keys are names of the modules,
  402. and values are their minimum versions.
  403.  
  404. =cut
  405.  
  406. sub list_core_dependencies {
  407.     my $self    = shift;
  408.     my $as_hash = shift || 0;
  409.     my $cb      = $self->();
  410.     my $href    = $self->_get_config->{'dependencies'};
  411.  
  412.     return $href if $as_hash;
  413.     return $self->_hashref_to_module( $href );
  414. }
  415.  
  416. =head2 @mods = $self->list_core_modules( [AS_HASH] )
  417.  
  418. Returns a list of C<CPANPLUS::Selfupdate::Module> objects which 
  419. represent the modules that comprise the core of CPANPLUS.
  420.  
  421. If the C<AS_HASH> argument is provided, no module objects are
  422. returned, but a hashref where the keys are names of the modules,
  423. and values are their minimum versions.
  424.  
  425. =cut
  426.  
  427. sub list_core_modules {
  428.     my $self    = shift;
  429.     my $as_hash = shift || 0;
  430.     my $cb      = $self->();
  431.     my $href    = $self->_get_config->{'core'};
  432.  
  433.     return $href if $as_hash;
  434.     return $self->_hashref_to_module( $href );
  435. }
  436.  
  437. sub _hashref_to_module {
  438.     my $self = shift;
  439.     my $cb   = $self->();
  440.     my $href = shift or return;
  441.     
  442.     return map { 
  443.             CPANPLUS::Selfupdate::Module->new(
  444.                 $cb->module_tree($_) => $href->{$_}
  445.             )
  446.         } keys %$href;
  447. }        
  448.     
  449.  
  450. =head1 CPANPLUS::Selfupdate::Module
  451.  
  452. C<CPANPLUS::Selfupdate::Module> extends C<CPANPLUS::Module> objects
  453. by providing accessors to aid in selfupdating CPANPLUS.
  454.  
  455. These objects are returned by all methods of C<CPANPLUS::Selfupdate>
  456. that return module objects.
  457.  
  458. =cut
  459.  
  460. {   package CPANPLUS::Selfupdate::Module;
  461.     use base 'CPANPLUS::Module';
  462.     
  463.     ### stores module name -> cpanplus required version
  464.     ### XXX only can deal with 1 pair!
  465.     my %Cache = ();
  466.     my $Acc   = 'version_required';
  467.     
  468.     sub new {
  469.         my $class = shift;
  470.         my $mod   = shift or return;
  471.         my $ver   = shift;          return unless defined $ver;
  472.         
  473.         my $obj   = $mod->clone;    # clone the module object
  474.         bless $obj, $class;         # rebless it to our class
  475.         
  476.         $obj->$Acc( $ver );
  477.         
  478.         return $obj;
  479.     }
  480.  
  481. =head2 $version = $mod->version_required
  482.  
  483. Returns the version of this module required for CPANPLUS.
  484.  
  485. =cut
  486.     
  487.     sub version_required {
  488.         my $self = shift;
  489.         $Cache{ $self->name } = shift() if @_;
  490.         return $Cache{ $self->name };
  491.     }        
  492.  
  493. =head2 $bool = $mod->is_installed_version_sufficient
  494.  
  495. Returns true if the installed version of this module is sufficient
  496. for CPANPLUS, or false if it is not.
  497.  
  498. =cut
  499.  
  500.     
  501.     sub is_installed_version_sufficient {
  502.         my $self = shift;
  503.         return $self->is_uptodate( version => $self->$Acc );
  504.     }
  505.  
  506. }    
  507.  
  508. 1;
  509.  
  510. =pod
  511.  
  512. =head1 BUG REPORTS
  513.  
  514. Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
  515.  
  516. =head1 AUTHOR
  517.  
  518. This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
  519.  
  520. =head1 COPYRIGHT
  521.  
  522. The CPAN++ interface (of which this module is a part of) is copyright (c) 
  523. 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
  524.  
  525. This library is free software; you may redistribute and/or modify it 
  526. under the same terms as Perl itself.
  527.  
  528. =cut
  529.  
  530. # Local variables:
  531. # c-indentation-style: bsd
  532. # c-basic-offset: 4
  533. # indent-tabs-mode: nil
  534. # End:
  535. # vim: expandtab shiftwidth=4:
  536.