Create inversion list for Assigned code points

[perl5.git] / Porting / corelist.pl

diff --git a/Porting/corelist.pl b/Porting/corelist.pl
index 5d302d3..448cb9d 100755 (executable)
--- a/Porting/corelist.pl
+++ b/Porting/corelist.pl
@@ -23,7 +23,6 @@ use IO::Uncompress::Gunzip;
 
 my $corelist_file = 'dist/Module-CoreList/lib/Module/CoreList.pm';
 my $utils_file = 'dist/Module-CoreList/lib/Module/CoreList/Utils.pm';
-my $pod_file = 'dist/Module-CoreList/lib/Module/CoreList.pod';
 
 my %lines;
 my %module_to_file;
@@ -100,19 +99,21 @@ find(
         /(\.pm|_pm\.PL)$/ or return;
         /PPPort\.pm$/ and return;
         my $module = $File::Find::name;
-        $module =~ /\b(demo|t|private)\b/ and return;    # demo or test modules
+        $module =~ /\b(demo|t|private|corpus)\b/ and return;    # demo or test modules
         my $version = MM->parse_version($_);
         defined $version or $version = 'undef';
         $version =~ /\d/ and $version = "'$version'";
 
         # some heuristics to figure out the module name from the file name
-        $module =~ s{^(lib|cpan|dist|(?:symbian/)?ext)/}{}
+        $module =~ s{^(lib|cpan|dist|(?:symbian/)?ext|os2/OS2)/}{}
                        and $1 ne 'lib'
             and (
             $module =~ s{\b(\w+)/\1\b}{$1},
             $module =~ s{^B/O}{O},
             $module =~ s{^Devel-PPPort}{Devel},
             $module =~ s{^libnet/}{},
+            $module =~ s{^PathTools/}{},
+            $module =~ s{REXX/DLL}{DLL},
             $module =~ s{^Encode/encoding}{encoding},
             $module =~ s{^IPC-SysV/}{IPC/},
             $module =~ s{^MIME-Base64/QuotedPrint}{MIME/QuotedPrint},
@@ -128,6 +129,7 @@ find(
         $lines{$module}          = $version;
         $module_to_file{$module} = $File::Find::name;
     },
+    'os2/OS2',
     'symbian/ext',
     'lib',
     'ext',
@@ -152,14 +154,14 @@ my $delta_data = make_corelist_delta(
 my $versions_in_release = "    " . $perl_vnum . " => {\n";
 $versions_in_release .= "        delta_from => $delta_data->{delta_from},\n";
 $versions_in_release .= "        changed => {\n";
-foreach my $key (sort keys $delta_data->{changed}) {
+foreach my $key (sort keys $delta_data->{changed}->%*) {
   $versions_in_release .= sprintf "            %-24s=> %s,\n", "'$key'",
       defined $delta_data->{changed}{$key} ? "'"
         . $delta_data->{changed}{$key} . "'" : "undef";
 }
 $versions_in_release .= "        },\n";
 $versions_in_release .= "        removed => {\n";
-for my $key (sort keys($delta_data->{removed} || {})) {
+for my $key (sort keys %{ $delta_data->{removed} || {} }) {
   $versions_in_release .= sprintf "            %-24s=> %s,\n", "'$key'", 1;
 }
 $versions_in_release .= "        }\n";
@@ -258,14 +260,14 @@ $corelist =~ s/^%upstream .*? ;$/$upstream_stanza/ismx;
   my $deprecated_stanza = "    " . $perl_vnum . " => {\n";
   $deprecated_stanza .= "        delta_from => $delta_data->{delta_from},\n";
   $deprecated_stanza .= "        changed => {\n";
-  foreach my $key (sort keys $delta_data->{changed}) {
+  foreach my $key (sort keys $delta_data->{changed}->%*) {
     $deprecated_stanza .= sprintf "            %-24s=> %s,\n", "'$key'",
         defined $delta_data->{changed}{$key} ? "'"
           . $delta_data->{changed}{$key} . "'" : "undef";
   }
   $deprecated_stanza .= "        },\n";
   $deprecated_stanza .= "        removed => {\n";
-  for my $key (sort keys($delta_data->{removed} || {})) {
+  for my $key (sort keys %{ $delta_data->{removed} || {} }) {
     $deprecated_stanza .= sprintf "           %-24s=> %s,\n", "'$key'", 1;
   }
   $deprecated_stanza .= "        }\n";
@@ -298,16 +300,6 @@ $corelist =~ s/^%bug_tracker .*? ;/$tracker/eismx;
 
 write_corelist($corelist,$corelist_file);
 
-open( my $pod_fh, '<', $pod_file );
-my $pod = join( '', <$pod_fh> );
-
-unless ( $pod =~ /and $perl_vstring releases of perl/ ) {
-    warn "Adding $perl_vstring to the list of perl versions covered by Module::CoreList\n";
-    $pod =~ s/(currently\s+covers\s+(?:.*?))\s*and\s+(.*?)\s+releases\s+of\s+perl/$1, $2 and $perl_vstring releases of perl/ism;
-}
-
-write_corelist($pod,$pod_file);
-
 open( my $utils_fh, '<', $utils_file );
 my $utils = join( '', <$utils_fh> );
 close $utils_fh;
@@ -319,14 +311,14 @@ my $delta_utils = make_coreutils_delta($perl_vnum, \%utils);
 my $utilities_in_release = "    " . $perl_vnum . " => {\n";
 $utilities_in_release .= "        delta_from => $delta_utils->{delta_from},\n";
 $utilities_in_release .= "        changed => {\n";
-foreach my $key (sort keys $delta_utils->{changed}) {
+foreach my $key (sort keys $delta_utils->{changed}->%*) {
   $utilities_in_release .= sprintf "            %-24s=> %s,\n", "'$key'",
       defined $delta_utils->{changed}{$key} ? "'"
         . $delta_utils->{changed}{$key} . "'" : "undef";
 }
 $utilities_in_release .= "        },\n";
 $utilities_in_release .= "        removed => {\n";
-for my $key (sort keys($delta_utils->{removed} || {})) {
+for my $key (sort keys %{ $delta_utils->{removed} || {} }) {
   $utilities_in_release .= sprintf "            %-24s=> %s,\n", "'$key'", 1;
 }
 $utilities_in_release .= "        }\n";
@@ -338,7 +330,7 @@ $utils =~ s/^(my %delta\s*=\s*.*?)(^\);)$/$1$utilities_in_release$2/ism;
 write_corelist($utils,$utils_file);
 
 warn "All done. Please check over the following files carefully before committing.\nThanks!\n";
-warn "$corelist_file\n$pod_file\n$utils_file\n";
+warn "$corelist_file\n$utils_file\n";
 
 sub write_corelist {
     my $content = shift;
@@ -373,18 +365,17 @@ sub make_corelist_delta {
   my %deltas;
   # Search for the release with the least amount of changes (this avoids having
   # to ask for where this perl was branched from).
-  for my $previous (reverse sort keys %$existing) {
+  for my $previous (reverse sort { $a <=> $b } keys %$existing) {
     # Shouldn't happen, but ensure we don't load weird data...
-    next if $previous > $version || $previous == $version && $previous eq $version;
-
+    next if $previous > $version || $previous == $version;
     my $delta = $deltas{$previous} = {};
     ($delta->{changed}, $delta->{removed}) = calculate_delta(
       $existing->{$previous}, \%versions);
   }
 
   my $smallest = (sort {
-      ((keys($deltas{$a}->{changed}) + keys($deltas{$a}->{removed})) <=>
-       (keys($deltas{$b}->{changed}) + keys($deltas{$b}->{removed}))) ||
+      ((keys($deltas{$a}->{changed}->%*) + keys($deltas{$a}->{removed}->%*)) <=>
+       (keys($deltas{$b}->{changed}->%*) + keys($deltas{$b}->{removed}->%*))) ||
       $b <=> $a
     } keys %deltas)[0];
 
@@ -407,9 +398,9 @@ sub make_coreutils_delta {
   my %deltas;
   # Search for the release with the least amount of changes (this avoids having
   # to ask for where this perl was branched from).
-  for my $previous (reverse sort keys %Module::CoreList::Utils::utilities) {
+  for my $previous (reverse sort { $a <=> $b } keys %Module::CoreList::Utils::utilities) {
     # Shouldn't happen, but ensure we don't load weird data...
-    next if $previous > $version || $previous == $version && $previous eq $version;
+    next if $previous > $version || $previous == $version;
 
     my $delta = $deltas{$previous} = {};
     ($delta->{changed}, $delta->{removed}) = calculate_delta(
@@ -417,8 +408,8 @@ sub make_coreutils_delta {
   }
 
   my $smallest = (sort {
-      ((keys($deltas{$a}->{changed}) + keys($deltas{$a}->{removed})) <=>
-       (keys($deltas{$b}->{changed}) + keys($deltas{$b}->{removed}))) ||
+      ((keys($deltas{$a}->{changed}->%*) + keys($deltas{$a}->{removed}->%*)) <=>
+       (keys($deltas{$b}->{changed}->%*) + keys($deltas{$b}->{removed}->%*))) ||
       $b <=> $a
     } keys %deltas)[0];
 
@@ -434,13 +425,13 @@ sub calculate_delta {
   my($from, $to) = @_;
   my(%changed, %removed);
 
-  for my $package(keys $from) {
+  for my $package(keys %$from) {
     if(not exists $to->{$package}) {
       $removed{$package} = 1;
     }
   }
 
-  for my $package(keys $to) {
+  for my $package(keys %$to) {
     if(!exists $from->{$package}
         || (defined $from->{$package} && !defined $to->{$package})
         || (!defined $from->{$package} && defined $to->{$package})