CAPOEIRAB / Perl-Dist-Strawberry-4.024 / lib / Perl / Dist / Strawberry / Step / UpgradeCpanModules.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

              
package Perl::Dist::Strawberry::Step::UpgradeCpanModules;
use 5.012;
use warnings;
use base 'Perl::Dist::Strawberry::Step';
use Data::Dump            qw(pp);
use Storable              qw(retrieve);
use File::Spec::Functions qw(catfile);
sub check {
#xxx-todo $self->{config}->{exceptions}
}
sub run {
  my $self = shift;
  my $success = 1;
   
  $self->boss->message(1, "getting upgrade module list");
  my $data = $self->_get_cpan_upgrades_list();
  my @list = @{$data->{to_upgrade}};
  my @toinstall = ();
   
  my $count = scalar(@list);
  if ($count>0) {
    $self->boss->message(1, "gonna upgrade $count modules");
    $self->boss->message(3, "* $_->{cpan_file}") for (@list);
    # Now go through the loop for each module.
    my $i = 0;
    for my $module (@list) {
      my $item = { module=> $module->{cpan_file}, install_to=>'perl' };
      my $extra = $self->_get_extra_install_options($module);
      if (!defined $extra) {
        $self->boss->message(2, sprintf("SKIPPING! %2d/%d '%s'", $i, $count, $module));
        next;
      }
      $item->{ignore_testfailure} = 1 if $extra->{"-ignore_testfailure"};
      $item->{skiptest}           = 1 if $extra->{"-skiptest"};
      push @toinstall, $item;
    }
    if (@toinstall) {
      $success = $self->install_modlist(@toinstall);      
    }
    $self->boss->message(1, "upgrade finished [success=$success]");
  }
  else {
    $self->boss->message(1, "all modules up to date");
  }
   
  die "FAILED\n" unless $success;
}
sub _get_extra_install_options {
  my ($self, $modinfo) = @_;
  for my $ex (@{$self->{config}->{exceptions}}) {
    my $do = $ex->{do};
    for my $k (keys %$ex) {
      if ($k eq 'distribution') {
        if ( (ref $ex->{$k} eq 'Regexp' && $modinfo->{distribution} =~ $ex->{$k}) || $modinfo->{distribution} eq $ex->{$k} ) {
          return undef if $do eq 'skip';
          return { "-$do" => 1 };
        }
      }
      elsif ($k eq 'version') {
        if ( (ref $ex->{$k} eq 'Regexp' && $modinfo->{cpan_version} =~ $ex->{$k}) || $modinfo->{cpan_version} eq $ex->{$k} ) {
          return undef if $do eq 'skip';
          return { "-$do" => 1 };
        }
      }
      elsif ($k eq 'cpan_file') {
        if ( (ref $ex->{$k} eq 'Regexp' && $modinfo->{cpan_file} =~ $ex->{$k}) || $modinfo->{cpan_file} eq $ex->{$k} ) {
          return undef if $do eq 'skip';
          return { "-$do" => 1 };
        }
      }
    }
  }
  return {};
}
sub _get_cpan_upgrades_list {
  my $self = shift;
  my $script_pl = $self->boss->resolve_name("<dist_sharedir>/utils/CPAN_get_upgrade_list.pl");
  my $log = catfile($self->global->{debug_dir}, "cpan_upgrade.log.txt");
  my $dumper_file = catfile($self->global->{debug_dir}, "cpan_upgrade.dumper.txt");
  my $nstore_file = catfile($self->global->{debug_dir}, "cpan_upgrade.nstore.txt");
  # Execute the CPAN upgrade script.
  my $rv = $self->execute_special(['perl', $script_pl, '-url', $self->global->{cpan_url},
                                                   '-out_nstore', $nstore_file,
                                                   '-out_dumper', $dumper_file ], $log);
  die "ERROR: exec '$script_pl' failed" unless defined $rv && $rv == 0;
  die "ERROR: missing file '$nstore_file'" unless -f $nstore_file;
  my $data = retrieve($nstore_file) or die "ERROR: retrieve failed, probably error while executing '$script_pl'";
  die "ERROR: invalid upgrade list" unless defined $data && ref $data eq 'HASH' && exists $data->{to_upgrade};
  return $data;
}
1;