view release on metacpan or  search on metacpan

Porting/corelist-perldelta.pl  view on Meta::CPAN

            $current_item->{text} .= $_;
            next;
          }
          # =item or =back signals the end of an item
          # block, which we handle below
          if ( !/^=(?:item|back)/ ) {
            $current_item->{text} .= $_;
            next;
          }
        }

        if (/^=item \*/) {
          push @{ $current_section->{items} }, $current_item
            if $current_item;
          $current_item = { text => $_ };
          $need_to_parse_module_name = 1;
          next;
        }

        if (/^=back/) {
          push @{ $current_section->{items} }, $current_item
            if $current_item;
          undef $current_item;
          $nested_element_level--;
        }

        if ( scalar @{ $current_section->{items} } == 0 ) {
          $current_section->{preceding_text} .= $_;
        }
        else {
          $current_section->{following_text} .= $_;
        }
        next;
      }

      # text in Modules and Pragmata not in a head2 region
      else {
        if ($in_Modules_and_Pragmata_preamble) {
          $out .= $_;
        }
        else {
          $append_to_out .= $_;
        }
        next;
      }
    }
    close $fh;
    die 'Never saw Modules and Pragmata section' unless $in_Modules_and_Pragmata;
    return $out;
  }

}

{
  package DeltaParser;
  use Pod::Simple::SimpleTree;

  sub new {
    my ($class, $input) = @_;

    my $self = bless {} => $class;

    my $parsed_pod = Pod::Simple::SimpleTree->new->parse_file($input)->root;
    splice @{ $parsed_pod }, 0, 2; # we don't care about the document structure,
                                   # just the nodes within it

    $self->_parse_delta($parsed_pod);

    return $self;
  }

  # creates the accessor methods:
  #   new_modules
  #   updated_modules
  #   removed_modules
  for my $k (keys %sections) {
    no strict 'refs';
    my $m = "${k}_modules";
    *$m = sub { $_[0]->{$m} };
  }

  sub _parse_delta {
    my ($self, $pod) = @_;

    my $new_section     = $self->_look_for_section( $pod, $sections{new} );
    my $updated_section = $self->_look_for_section( $pod, $sections{updated} );
    my $removed_section = $self->_look_for_section( $pod, $sections{removed} );

    $self->_parse_new_section($new_section);
    $self->_parse_updated_section($updated_section);
    $self->_parse_removed_section($removed_section);

    for (qw/new_modules updated_modules removed_modules/) {
      $self->{$_} =
        [ sort { lc $a->[0] cmp lc $b->[0] } @{ $self->{$_} } ];
    }

    return;
  }

  sub _parse_new_section {
    my ($self, $section) = @_;

    $self->{new_modules} = [];
    return unless $section;
    $self->{new_modules} = $self->_parse_section($section => sub {
      my ($el) = @_;

      my ($first, $second) = @{ $el }[2, 3];
      my ($ver) = $second =~ /(\d[^\s]+)\s+has\s+been/;

      return [ $first->[2], undef, $ver ];
    });

    return;
  }

  sub _parse_updated_section {
    my ($self, $section) = @_;

    $self->{updated_modules} = [];