Hey LanX,
Recently I updated one of my modules to use PPI, so this was fresh in my memory. This won't get you all the way, but it's a sane way to remove all POD and comment elements, as well as providing you an array of the sub names in the order they are currently listed in the file you're working on.
use warnings;
use strict;
use PPI;
my $file = 'Test.pm';
my $outfile = 'Nopod.pm';
my $ppi_doc = PPI::Document->new($file);
$ppi_doc->prune('PPI::Token::Pod');
$ppi_doc->prune('PPI::Token::Comment');
my @subs;
for (@{ $ppi_doc->find('PPI::Statement::Sub') }){
push @subs, $_->name;
}
$ppi_doc->save($outfile);
print "$_\n" for @subs;
Hope this helps!
Update: added code to catch the original order of subs in the file.
Update2: I monkeyed around with one of my own modules Devel::Examine::Subs (v1.56+) that does subroutine maintenance, and with some trickery (as a PoC), wrote a script that strips POD and comments, gets the order of the sub names, removes all subs from each file, and inserts them back in (starting at the first line where the first sub used to start in each file) in the order taken from the first argument. Just pass the script the two files, starting with the one who's sub order you want to keep.
use warnings;
use strict;
use Devel::Examine::Subs;
use PPI; # unneeded, technically due to above use
if (@ARGV != 2){
print "Usage: ./script.pl Good.pm Old.pm\n";
exit;
}
my @files = @ARGV;
my @order;
for my $file (@files){
my $outfile = "$file.new";
my $ppi_doc = PPI::Document->new($file);
$ppi_doc->prune('PPI::Token::Pod');
$ppi_doc->prune('PPI::Token::Comment');
my @subs;
for (@{ $ppi_doc->find('PPI::Statement::Sub') }){
push @subs, $_->name;
}
# set the order in the global var
@order = @subs if ! @order;
$ppi_doc->save($outfile);
my ($des, $sub_obj_hash);
{
$des = Devel::Examine::Subs->new(file => $outfile);
$sub_obj_hash = $des->objects(objects_in_hash => 1);
}
$ppi_doc = PPI::Document->new($outfile);
$ppi_doc->prune('PPI::Statement::Sub');
$ppi_doc->save($outfile);
$des = Devel::Examine::Subs->new(file => $outfile);
my $first_line = $sub_obj_hash->{$subs[0]}->start;
my @code;
for (@order){
push @code, @{ $sub_obj_hash->{$_}->code };
}
$des->inject(line_num => $first_line, code => \@code);
}
I know others have provided solutions already, but I'm curious to see how far this actually gets you. It assumes both files have the same subroutines, and the data is written to the same files passed in, with a ".new" extension.
Update: if you've read this far, you see what I'm trying to do. I'm going to take the CPAN namespace Devel::Examine::File so I can extend what I've already done, and make it officially file-based. The want that OP desired is something I've wanted to expand into anyways, and it will alleviate some of the hacks I have in the current module that it just shouldn't be doing. |