6 use Maintainers qw/%Modules/;
7 use lib 'dist/Module-CoreList/lib';
13 # generate the module changes for the Perl you are currently building
14 ./perl -Ilib Porting/corelist-perldelta.pl
16 # update the module changes for the Perl you are currently building
17 ./perl -Ilib Porting/corelist-perldelta.pl --mode=update pod/perldelta.pod
19 # generate a diff between the corelist sections of two perldelta* files:
20 perl Porting/corelist-perldelta.pl --mode=check 5.017001 5.017002 <perl5172delta.pod
24 corelist-perldelta.pl is a bit schizophrenic. The part to generate the
25 new Perldelta text does not need Algorithm::Diff, but wants to be
26 run with the freshly built Perl.
28 The part to check the diff wants to be run with a Perl that has an up-to-date
29 L<Module::CoreList>, but needs the outside L<Algorithm::Diff>.
31 Ideally, the program will be split into two separate programs, one
32 to generate the text and one to show the diff between the
33 corelist sections of the last perldelta and the next perldelta.
35 Currently no information about Removed Modules is displayed in any of the
41 new => qr/New Modules and Pragma(ta)?/,
42 updated => qr/Updated Modules and Pragma(ta)?/,
43 removed => qr/Removed Modules and Pragma(ta)?/,
47 new => 'New Modules and Pragmata',
48 updated => 'Updated Modules and Pragmata',
49 removed => 'Removed Modules and Pragmata',
55 my %opt = (mode => 'generate');
58 'mode|m:s', # 'generate', 'check', 'update'
61 # by default, compare latest two version in CoreList;
62 my ($old, $new) = latest_two_perl_versions();
64 # use the provided versions if present
65 # @ARGV >=2 means [old_version] [new_version] [path/to/file]
67 ($old, $new) = (shift @ARGV, shift @ARGV);
68 die "$old is an invalid version\n" if not exists
69 $Module::CoreList::version{$old};
70 die "$new is an invalid version\n" if not exists
71 $Module::CoreList::version{$new};
74 if ( $opt{mode} eq 'generate' ) {
75 do_generate($old => $new);
77 elsif ( $opt{mode} eq 'check' ) {
78 do_check(\*ARGV, $old => $new);
80 elsif ( $opt{mode} eq 'update' ) {
81 do_update_existing(shift @ARGV, $old => $new);
84 die "Unrecognized mode '$opt{mode}'\n";
90 sub latest_two_perl_versions {
92 my @versions = sort keys %Module::CoreList::version;
94 my $new = pop @versions;
96 # If a fully-padded version number ends in a zero (as in "5.019010"), that
97 # version shows up in %Module::CoreList::version both with and without its
98 # trailing zeros. So skip all versions that are numerically equal to $new.
99 pop @versions while @versions && $versions[-1] == $new;
101 die "Too few distinct core versions in %Module::CoreList::version ?!\n"
104 return $versions[-1], $new;
107 # Given two perl versions, it returns a list describing the core distributions that have changed.
108 # The first three elements are hashrefs corresponding to new, updated, and removed modules
109 # and are of the form (mostly, see the special remarks about removed):
110 # 'Distribution Name' => ['Distribution Name', previous version number, current version number]
111 # where the version number is undef if the distribution did not exist.
112 # The fourth element is an arrayref of core distribution names of those distribution for which it
113 # is unknown whether they have changed and therefore need to be manually checked.
115 # In most cases, the distribution name in %Modules corresponds to the module that is representative
116 # of the distribution as listed in Module::CoreList. However, there are a few distribution names
117 # that do not correspond to a module. %distToModules has been created which maps the distribution
118 # name to a representative module. The representative module was chosen by either looking at the
119 # Makefile of the distribution or by seeing which module the distribution has been traditionally
120 # listed under in past perldeltas.
122 # There are a few distributions for which there is no single representative module (e.g. libnet).
123 # These distributions are returned as the last element of the list.
125 # %Modules contains a final key, _PERLLIB, which contains a list of modules that are owned by p5p.
126 # This list contains modules and pragmata that may also be present in Module::CoreList.
127 # A list of modules are in the list @unclaimedModules, which were manually listed based on whether
128 # they were independent modules and whether they have been listed in past perldeltas.
129 # The pragmata were found by doing something like:
130 # say for sort grep { $_ eq lc $_ and !exists $Modules{$_}}
131 # keys %{$Module::CoreList::version{'5.019003'}}
132 # and manually filtering out pragmata that were already covered.
134 # It is currently not possible to differentiate between a removed module and a removed
135 # distribution. Therefore, the removed hashref contains every module that has been removed, even if
136 # the module's corresponding distribution has not been removed.
139 my ($old, $new) = @_;
140 my $corelist = \%Module::CoreList::version;
141 my %changes = Module::CoreList::changes_between( $old, $new );
142 $deprecated = $Module::CoreList::deprecated{$new};
144 my $getModifyType = sub {
146 if ( exists $data->{left} and exists $data->{right} ) {
149 elsif ( !exists $data->{left} and exists $data->{right} ) {
152 elsif ( exists $data->{left} and !exists $data->{right} ) {
158 my @unclaimedModules = qw/AnyDBM_File B B::Concise B::Deparse Benchmark Class::Struct Config::Extensions DB
159 DBM_Filter Devel::Peek DirHandle DynaLoader English Errno ExtUtils::Embed ExtUtils::Miniperl
160 ExtUtils::Typemaps ExtUtils::XSSymSet Fcntl File::Basename File::Compare File::Copy File::DosGlob
161 File::Find File::Glob File::stat FileCache FileHandle FindBin GDBM_File Getopt::Std Hash::Util Hash::Util::FieldHash
162 I18N::Langinfo IPC::Open3 NDBM_File ODBM_File Opcode PerlIO PerlIO::encoding PerlIO::mmap PerlIO::scalar PerlIO::via
163 Pod::Functions Pod::Html POSIX SDBM_File SelectSaver Symbol Sys::Hostname Thread Tie::Array Tie::Handle Tie::Hash
164 Tie::Hash::NamedCapture Tie::Memoize Tie::Scalar Tie::StdHandle Tie::SubstrHash Time::gmtime Time::localtime Time::tm
165 Unicode::UCD UNIVERSAL User::grent User::pwent VMS::DCLsym VMS::Filespec VMS::Stdio XS::Typemap XS::APItest Win32CORE/;
166 my @unclaimedPragmata = qw/arybase attributes blib bytes charnames deprecate diagnostics encoding feature fields filetest inc::latest integer less locale mro open ops overload overloading re sigtrap sort strict subs utf8 vars vmsish/;
167 my @unclaimed = (@unclaimedModules, @unclaimedPragmata);
169 my %distToModules = (
172 'name' => 'IO-Compress',
173 'modification' => $getModifyType->( $changes{'IO::Compress::Base'} ),
174 'data' => $changes{'IO::Compress::Base'}
180 'modification' => $getModifyType->( $changes{'Net::Cmd'} ),
181 'data' => $changes{'Net::Cmd'}
186 'name' => 'File::Spec',
187 'modification' => $getModifyType->( $changes{'Cwd'} ),
188 'data' => $changes{'Cwd'}
193 'name' => 'podlators',
194 'modification' => $getModifyType->( $changes{'Pod::Text'} ),
195 'data' => $changes{'Pod::Text'}
198 'Scalar-List-Utils' => [
200 'name' => 'List::Util',
201 'modification' => $getModifyType->( $changes{'List::Util'} ),
202 'data' => $changes{'List::Util'}
205 'name' => 'Scalar::Util',
206 'modification' => $getModifyType->( $changes{'Scalar::Util'} ),
207 'data' => $changes{'Scalar::Util'}
210 'name' => 'Sub::Util',
211 'modification' => $getModifyType->( $changes{'Sub::Util'} ),
212 'data' => $changes{'Sub::Util'}
215 'Text-Tabs+Wrap' => [
217 'name' => 'Text::Tabs',
218 'modification' => $getModifyType->( $changes{'Text::Tabs'} ),
219 'data' => $changes{'Text::Tabs'}
222 'name' => 'Text::Wrap',
223 'modification' => $getModifyType->( $changes{'Text::Wrap'} ),
224 'data' => $changes{'Text::Wrap'}
229 # structure is (new|removed|updated) => [ [ModuleName, previousVersion, newVersion] ]
230 my $deltaGrouping = {};
232 # list of distributions listed in %Modules that need to be manually checked because there is no module that represents it
235 # %Modules defines what is currently in core
236 for my $k ( keys %Modules ) {
237 next if $k eq '_PERLLIB'; #these are taken care of by being listed in @unclaimed
238 next if Module::CoreList::is_core($k) and !exists $changes{$k}; #modules that have not changed
240 my ( $distName, $modifyType, $data );
242 if ( exists $changes{$k} ) {
244 $modifyType = $getModifyType->( $changes{$k} );
245 $data = $changes{$k};
247 elsif ( exists $distToModules{$k} ) {
248 # modification will be undef if the distribution has not changed
249 my @modules = grep { $_->{modification} } @{ $distToModules{$k} };
251 $deltaGrouping->{ $_->{modification} }->{ $_->{name} } = [ $_->{name}, $_->{data}->{left}, $_->{data}->{right} ];
256 push @manuallyCheck, $k and next;
259 $deltaGrouping->{$modifyType}->{$distName} = [ $distName, $data->{left}, $data->{right} ];
262 for my $k (@unclaimed) {
263 if ( exists $changes{$k} ) {
264 $deltaGrouping->{ $getModifyType->( $changes{$k} ) }->{$k} =
265 [ $k, $changes{$k}->{left}, $changes{$k}->{right} ];
269 # in old corelist, but not this one => removed
270 # N.B. This is exhaustive -- not just what's in %Modules, so modules removed from
271 # distributions will show up here, too. Some person will have to review to see what's
272 # important. That's the best we can do without a historical Maintainers.pl
273 for my $k ( keys %{ $corelist->{$old} } ) {
274 if ( ! exists $corelist->{$new}{$k} ) {
275 $deltaGrouping->{'removed'}->{$k} = [ $k, $corelist->{$old}{$k}, undef ];
280 \%{ $deltaGrouping->{'new'} },
281 \%{ $deltaGrouping->{'removed'} },
282 \%{ $deltaGrouping->{'updated'} },
287 # currently does not update the Removed Module section
288 sub do_update_existing {
289 my ( $existing, $old, $new ) = @_;
291 my ( $added, $removed, $updated, $manuallyCheck ) = corelist_delta( $old => $new );
292 if (@{$manuallyCheck}) {
293 print "It cannot be determined whether the following distributions have changed.\n";
294 print "Please check and list accordingly:\n";
295 say "\t* $_" for sort @{$manuallyCheck};
302 #removed => $removed, ignore removed for now
305 my $text = DeltaUpdater::transform_pod( $existing, $data );
306 open my $out, '>', $existing or die "can't open perldelta file $existing: $!";
310 say "The New and Updated Modules and Pragmata sections in $existing have been updated";
311 say "Please ensure the Removed Modules and Pragmata section is up-to-date";
315 my ($old, $new) = @_;
316 my ($added, $removed, $updated, $manuallyCheck) = corelist_delta($old => $new);
318 if ($manuallyCheck) {
319 print "\nXXXIt cannot be determined whether the following distributions have changed.\n";
320 print "Please check and list accordingly:\n";
321 say "\t$_" for @{$manuallyCheck};
328 #removed => $removed, ignore removed for now
331 say DeltaUpdater::sections_to_pod($data)
335 my ($in, $old, $new) = @_;
337 my $delta = DeltaParser->new($in);
338 my ($added, $removed, $updated) = corelist_delta($old => $new);
340 # because of the difficulty in identifying the distribution for removed modules
341 # don't bother checking them
342 for my $ck ([ 'new', $delta->new_modules, $added ],
343 #[ 'removed', $delta->removed_modules, $removed ],
344 [ 'updated', $delta->updated_modules, $updated ] ) {
345 my @delta = @{ $ck->[1] };
346 my @corelist = sort { lc $a->[0] cmp lc $b->[0] } values %{ $ck->[2] };
348 printf $ck->[0] . ":\n";
350 require Algorithm::Diff;
351 my $diff = Algorithm::Diff->new(map {
352 [map { join q{ } => grep defined, @{ $_ } } @{ $_ }]
353 } \@delta, \@corelist);
355 while ($diff->Next) {
358 if (!$diff->Items(2)) {
359 printf "%d,%dd%d\n", $diff->Get(qw( Min1 Max1 Max2 ));
360 } elsif(!$diff->Items(1)) {
361 printf "%da%d,%d\n", $diff->Get(qw( Max1 Min2 Max2 ));
364 printf "%d,%dc%d,%d\n", $diff->Get(qw( Min1 Max1 Min2 Max2 ));
366 print "Delta< $_\n" for $diff->Items(1);
368 print "Corelist> $_\n" for $diff->Items(2);
377 package DeltaUpdater;
378 use List::Util 'reduce';
380 sub get_section_name_from_heading {
382 while (my ($key, $expression) = each %sections) {
383 if ($heading =~ $expression) {
384 return $titles{$key};
387 die "$heading did not match any section";
390 sub is_desired_section_name {
391 for (values %sections) {
392 return 1 if $_[0] =~ $_;
397 # verify the module and pragmata in the section, changing the stated version if necessary
398 # this subroutine warns if the module name cannot be parsed or if it is not listed in
399 # the results returned from corelist_delta()
401 # a side-effect of calling this function is that modules present in the section are
402 # removed from $data, resulting in $data containing only those modules and pragmata
403 # that were not listed in the perldelta file. This means we can then pass $data to
404 # add_to_section() without worrying about filtering out duplicates
406 my ( $section, $data, $title ) = @_;
407 my @items = @{ $section->{items} };
409 for my $item (@items) {
411 my $content = $item->{text};
412 my $module = $item->{name};
415 next if !$module and $content =~ /\s*xx*\s*/i;
417 say "Could not parse module name; line is:\n\t$content" and next unless $module;
419 if ( !$data->{$title}{$module} ) {
420 print "$module is not listed as being $title in Module::CoreList.\n";
421 print "Ensure Module::CoreList has been updated and\n";
422 print "check to see that the distribution is not listed under another name.\n\n";
426 if ( $title eq 'new' ) {
427 my ($new) = $content =~ /(\d[^\s]+)\s+has\s+been.*$/m;
428 say "Could not parse new version for $module; line is:\n\t$content" and next unless $new;
429 if ( $data->{$title}{$module}[2] ne $new ) {
430 say "$module: new version differs; version in pod: $new; version in corelist: " . $data->{$title}{$module}[2];
432 $content =~ s/\d[^\s]+(\s+has\s+been.*$)/$data->{$title}{$module}[2].$1/me;
435 elsif ( $title eq 'updated' ) {
436 my ( $prev, $new ) = $content =~ /from\s+(?:version\s+)?(\d[^\s]+)\s+to\s+(?:version\s+)?(\d[^\s,]+?)(?=[\s,]|\.\s|\.$|$).*/s;
437 say "Could not parse old and new version for $module; line is:\n\t$content" and next
438 unless $prev and $new;
439 if ( $data->{$title}{$module}[1] ne $prev ) {
440 say "$module: previous version differs; version in pod: $prev; version in corelist: " . $data->{$title}{$module}[1];
442 if ( $data->{$title}{$module}[2] ne $new ) {
443 say "$module: new version differs; version in pod: $new; version in corelist: " . $data->{$title}{$module}[2];
446 s/(from\s+(?:version\s+)?)\d[^\s]+(\s+to\s+(?:version\s+)?)\d[^\s,]+?(?=[\s,]|\.\s|\.$|$)(.*)/$1.$data->{$title}{$module}[1].$2.$data->{$title}{$module}[2].$3/se;
449 elsif ( $title eq 'removed' ) {
450 my ($prev) = $content =~ /^.*?was\s+(\d[^\s]+?)/m;
451 say "Could not parse old version for $module; line is:\n\t$content" and next unless $prev;
452 if ( $data->{$title}{$module}[1] ne $prev ) {
453 say "$module: previous version differs; $prev " . $data->{$title}{$module}[1];
455 $content =~ s/(^.*?was\s+)\d[^\s]+?/$1.$data->{$title}{$module}[1]/me;
458 delete $data->{$title}{$module};
459 $item->{text} = $content;
464 # add modules and pragmata present in $data to the section
466 my ( $section, $data, $title ) = @_;
468 #undef is a valid version name in Module::CoreList so suppress warnings about concatenating undef values
469 no warnings 'uninitialized';
470 for ( values %{ $data->{$title} } ) {
471 my ( $mod, $old_v, $new_v ) = @{$_};
474 $item = { name => $mod, text => "=item *\n" };
475 if ( $title eq 'new' ) {
476 $text = "L<$mod> $new_v has been added to the Perl core.\n";
479 elsif ( $title eq 'updated' ) {
480 $text = "L<$mod> has been upgraded from version $old_v to $new_v.\n";
481 if ( $deprecated->{$mod} ) {
482 $text .= "NOTE: L<$mod> is deprecated and may be removed from a future version of Perl.\n";
486 elsif ( $title eq 'removed' ) {
487 $text = "C<$mod> has been removed from the Perl core. Prior version was $old_v.\n";
490 $item->{text} .= "\n$text\n";
491 push @{ $section->{items} }, $item;
496 sub sort_items_in_section {
499 # if we could not parse the module name, it will be uninitialized
500 # in sort. This is not a problem as it will just result in these
501 # sections being placed near the beginning of the section
502 no warnings 'uninitialized';
504 [ sort { lc $a->{name} cmp lc $b->{name} } @{ $section->{items} } ];
508 # given a hashref of the form returned by corelist_delta()
509 # and a hash structured as documented in transform_pod(), it returns
510 # a pod string representation of the sections, creating sections
512 sub sections_to_pod {
513 my ( $data, %sections ) = @_;
518 [ 'New Modules and Pragmata', 'new' ],
519 [ 'Updated Modules and Pragmata', 'updated' ],
520 [ 'Removed Modules and Pragmata', 'removed' ]
524 my ( $section_name, $title ) = @{$_};
526 my $section = $sections{$section_name} // {
527 name => $section_name,
528 preceding_text => "=head2 $_->[0]\n=over 4\n",
529 following_text => "=back\n",
534 $section = update_section( $section, $data, $title );
535 $section = add_to_section( $section, $data, $title );
536 $section = sort_items_in_section( $section );
538 next if $section->{manual} and scalar @{ $section->{items} } == 0;
540 my $items = reduce { no warnings 'once'; $a . $b->{text} }
541 ( '', @{ $section->{items} } );
543 ( $section->{preceding_text} // '' )
545 . ( $section->{following_text} // '' );
550 # given a filename corresponding to an existing perldelta file
551 # and a hashref of the form returned by corelist_delta(), it
552 # returns a string of the resulting file after the module
553 # information has been added.
555 my ( $existing, $data ) = @_;
557 # will contain hashrefs corresponding to new, updated and removed
558 # modules and pragmata keyed by section name
559 # each section is hashref of the structure
560 # preceding_text => Text occurring before and including the over
561 # region containing the list of modules,
562 # items => [Arrayref of hashrefs corresponding to a module
564 # an entry has the form:
565 # name => Module name or undef if the name could not be determined
566 # text => The text of the entry, including the item heading
568 # following_text => Any text not corresponding to a module
569 # that occurs after the first module
571 # the sections are converted to a pod string by calling sections_to_pod()
574 # we are in the Modules_and_Pragmata's section
575 my $in_Modules_and_Pragmata;
577 # we are the Modules_and_Pragmata's section but have not
578 # encountered any of the desired sections. We use this
579 # flag to determine whether we should append the text to $out
580 # or we need to delay appending until the module listings are
581 # processed and instead append to $append_to_out
582 my $in_Modules_and_Pragmata_preamble;
584 my $done_processing_Modules_and_Pragmata;
588 # $nested_element_level == 0 : not in an over region, treat lines as text
589 # $nested_element_level == 1 : presumably in the top over region that
590 # corresponds to the module listing. Treat
591 # each item as a module
592 # $nested_element_level > 1 : we only consider these values when we are in an item
593 # We treat lines as the text of the current item.
594 my $nested_element_level = 0;
597 my $need_to_parse_module_name;
600 my $append_to_out = '';
602 open my $fh, '<', $existing or die "can't open perldelta file $existing: $!";
606 # treat the rest of the file as plain text
607 if ($done_processing_Modules_and_Pragmata) {
612 elsif ( !$in_Modules_and_Pragmata ) {
613 # entering Modules and Pragmata
614 if (/^=head1 Modules and Pragmata/) {
615 $in_Modules_and_Pragmata = 1;
616 $in_Modules_and_Pragmata_preamble = 1;
622 # leaving Modules and Pragmata
624 if ($current_section) {
625 push @{ $current_section->{items} }, $current_item
627 $sections{ $current_section->{name} } = $current_section;
629 $done_processing_Modules_and_Pragmata = 1;
631 sections_to_pod( $data, %sections ) . $append_to_out . $_;
635 # new section in Modules and Pragmata
636 elsif (/^=head2 (.*?)$/) {
638 if ($current_section) {
639 push @{ $current_section->{items} }, $current_item
641 $sections{ $current_section->{name} } = $current_section;
642 undef $current_section;
645 if ( is_desired_section_name($name) ) {
646 undef $in_Modules_and_Pragmata_preamble;
647 if ( $nested_element_level > 0 ) {
648 die "Unexpected head2 at line no. $.";
650 my $title = get_section_name_from_heading($name);
651 if ( exists $sections{$title} ) {
652 die "$name occurred twice at line no. $.";
654 $current_section = {};
655 $current_section->{name} = $title;
656 $current_section->{preceding_text} = $_;
657 $current_section->{items} = [];
658 $nested_element_level = 0;
662 # otherwise treat section as plain text
664 if ($in_Modules_and_Pragmata_preamble) {
668 $append_to_out .= $_;
674 elsif ($current_section) {
676 # not in an over region
677 if ( $nested_element_level == 0 ) {
679 $nested_element_level++;
681 if ( scalar @{ $current_section->{items} } > 0 ) {
682 $current_section->{following_text} .= $_;
685 $current_section->{preceding_text} .= $_;
691 if ($need_to_parse_module_name) {
692 # the item may not have a parsable module name, which means that
693 # $current_item->{name} will never be defined.
694 if (/^(?:L|C)<(.+?)>/) {
695 $current_item->{name} = $1;
696 undef $need_to_parse_module_name;
698 # =item or =back signals the end of an item
699 # block, which we handle below
700 if ( !/^=(?:item|back)/ ) {
701 $current_item->{text} .= $_;
705 # currently in an over region
706 # treat text inside region as plain text
707 if ( $nested_element_level > 1 ) {
709 $nested_element_level--;
712 $nested_element_level++;
714 $current_item->{text} .= $_;
717 # entering over region
719 $nested_element_level++;
720 $current_item->{text} .= $_;
723 # =item or =back signals the end of an item
724 # block, which we handle below
725 if ( !/^=(?:item|back)/ ) {
726 $current_item->{text} .= $_;
732 push @{ $current_section->{items} }, $current_item
734 $current_item = { text => $_ };
735 $need_to_parse_module_name = 1;
740 push @{ $current_section->{items} }, $current_item
743 $nested_element_level--;
746 if ( scalar @{ $current_section->{items} } == 0 ) {
747 $current_section->{preceding_text} .= $_;
750 $current_section->{following_text} .= $_;
755 # text in Modules and Pragmata not in a head2 region
757 if ($in_Modules_and_Pragmata_preamble) {
761 $append_to_out .= $_;
767 die 'Never saw Modules and Pragmata section' unless $in_Modules_and_Pragmata;
775 use Pod::Simple::SimpleTree;
778 my ($class, $input) = @_;
780 my $self = bless {} => $class;
782 my $parsed_pod = Pod::Simple::SimpleTree->new->parse_file($input)->root;
783 splice @{ $parsed_pod }, 0, 2; # we don't care about the document structure,
784 # just the nodes within it
786 $self->_parse_delta($parsed_pod);
791 # creates the accessor methods:
795 for my $k (keys %sections) {
797 my $m = "${k}_modules";
798 *$m = sub { $_[0]->{$m} };
802 my ($self, $pod) = @_;
804 my $new_section = $self->_look_for_section( $pod, $sections{new} );
805 my $updated_section = $self->_look_for_section( $pod, $sections{updated} );
806 my $removed_section = $self->_look_for_section( $pod, $sections{removed} );
808 $self->_parse_new_section($new_section);
809 $self->_parse_updated_section($updated_section);
810 $self->_parse_removed_section($removed_section);
812 for (qw/new_modules updated_modules removed_modules/) {
814 [ sort { lc $a->[0] cmp lc $b->[0] } @{ $self->{$_} } ];
820 sub _parse_new_section {
821 my ($self, $section) = @_;
823 $self->{new_modules} = [];
824 return unless $section;
825 $self->{new_modules} = $self->_parse_section($section => sub {
828 my ($first, $second) = @{ $el }[2, 3];
829 my ($ver) = $second =~ /(\d[^\s]+)\s+has\s+been/;
831 return [ $first->[2], undef, $ver ];
837 sub _parse_updated_section {
838 my ($self, $section) = @_;
840 $self->{updated_modules} = [];
841 return unless $section;
842 $self->{updated_modules} = $self->_parse_section($section => sub {
845 my ($first, $second) = @{ $el }[2, 3];
846 my $module = $first->[2];
848 # the regular expression matches the following:
849 # from VERSION_NUMBER to VERSION_NUMBER
850 # from VERSION_NUMBER to VERSION_NUMBER.
851 # from version VERSION_NUMBER to version VERSION_NUMBER.
852 # from VERSION_NUMBER to VERSION_NUMBER and MODULE from VERSION_NUMBER to VERSION_NUMBER
853 # from VERSION_NUMBER to VERSION_NUMBER, and MODULE from VERSION_NUMBER to VERSION_NUMBER
855 # some perldeltas contain more than one module listed in an entry, this only attempts to match the
857 my ($old, $new) = $second =~
858 /from\s+(?:version\s+)?(\d[^\s]+)\s+to\s+(?:version\s+)?(\d[^\s,]+?)(?=[\s,]|\.\s|\.$|$).*/s;
860 warn "Unable to extract old or new version of $module from perldelta"
861 if !defined $old || !defined $new;
863 return [ $module, $old, $new ];
869 sub _parse_removed_section {
870 my ($self, $section) = @_;
872 $self->{removed_modules} = [];
873 return unless $section;
874 $self->{removed_modules} = $self->_parse_section($section => sub {
877 my ($first, $second) = @{ $el }[2, 3];
878 my ($old) = $second =~ /was\s+(\d[^\s]+?)\.?$/;
880 return [ $first->[2], $old, undef ];
887 my ($self, $section, $parser) = @_;
889 my $items = $self->_look_down($section => sub {
891 return unless ref $el && $el->[0] =~ /^item-/
892 && @{ $el } > 2 && ref $el->[2];
893 return unless $el->[2]->[0] =~ /C|L/;
898 return [map { $parser->($_) } @{ $items }];
902 my ($self, $pod, $predicate) = @_;
906 while (my $el = shift @pod) {
907 push @l, $el if $predicate->($el);
911 unshift @pod, @el if @el;
915 return @l ? \@l : undef;
918 sub _look_for_section {
919 my ($self, $pod, $section) = @_;
922 $self->_look_for_range($pod,
925 my ($heading) = $el->[0] =~ /^head(\d)$/;
926 my $f = $heading && $el->[2] =~ /^$section/;
927 $level = $heading if $f && !$level;
932 $el->[0] =~ /^head(\d)$/ && $1 <= $level;
937 sub _look_for_range {
938 my ($self, $pod, $start_predicate, $stop_predicate) = @_;
941 for my $el (@{ $pod }) {
943 return \@l if $stop_predicate->($el);
946 next unless $start_predicate->($el);