view release on metacpan or  search on metacpan

Porting/corelist.pl  view on Meta::CPAN

    # Shouldn't happen, but ensure we don't load weird data...
    next if $previous > $version || $previous == $version;

    my $delta = $deltas{$previous} = {};
    ($delta->{changed}, $delta->{removed}) = calculate_delta(
      $Module::CoreList::Utils::utilities{$previous}, \%utilities);
  }

  my $smallest = (sort {
      ((keys($deltas{$a}->{changed}->%*) + keys($deltas{$a}->{removed}->%*)) <=>
       (keys($deltas{$b}->{changed}->%*) + keys($deltas{$b}->{removed}->%*))) ||
      $b <=> $a
    } keys %deltas)[0];

  return {
    delta_from => $smallest,
    changed => $deltas{$smallest}{changed},
    removed => $deltas{$smallest}{removed},
  }
}

# Calculate (changed, removed) modules between two versions.
sub calculate_delta {
  my($from, $to) = @_;
  my(%changed, %removed);

  for my $package(keys %$from) {
    if(not exists $to->{$package}) {
      $removed{$package} = 1;
    }
  }

  for my $package(keys %$to) {
    if(!exists $from->{$package}
        || (defined $from->{$package} && !defined $to->{$package})
        || (!defined $from->{$package} && defined $to->{$package})
        || (defined $from->{$package} && defined $to->{$package}
            && $from->{$package} ne $to->{$package})) {
      $changed{$package} = $to->{$package};
    }
  }

  return \%changed, \%removed;
}

sub quote {
    my ($str) = @_;
    # There's gotta be something already doing this properly that we could just
    # reuse, but I can't quite thing of where to look for it, so I'm gonna do
    # the simplest possible thing that'll allow me to release 5.17.7.  --rafl
    $str =~ s/'/\\'/g;
    "'${str}'";
}

sub parse_utils_lst {
  require File::Spec::Unix;
  my @scripts;
  open my $fh, '<', 'utils.lst' or die "$!\n";
  while (<$fh>) {
    chomp;
    my ($file,$extra) = split m!#!;
    $file =~ s!\s+!!g;
    push @scripts, $file;
    $extra =~ s!\s+!!g if $extra;
    if ( $extra and my ($link) = $extra =~ m!^link=(.+?)$! ) {
      push @scripts, $link;
    }
  }
  return map { +( File::Spec::Unix->splitpath( $_ ) )[-1] } @scripts;
}