view release on metacpan or  search on metacpan

modinfo2xml.PL  view on Meta::CPAN

use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
	if ($Config{'osname'} eq 'VMS' or
	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!";
#!$^X -w

!GROK!THIS!

foreach my $dir (@INC) {
    print OUT qq{use lib '$dir';\n};
}

print OUT <<'!NO!SUBS!';


use strict;

use Getopt::Std;
use Pod::Usage;
use File::Copy 'cp';
use File::Find;
use IO::File;
use Devel::ModInfo::Util 'convert_modinfo_to_xml';

my %opts;
getopts('hri:o:x:', \%opts);

if ($opts{h}) {pod2usage(-verbose => 2)}

$opts{i} || $opts{r} || pod2usage(
	-verbose => 2, 
	-message => "-i and -r parameter missing.  Must provide input file nameor request recursive operation"
);

my @files;
if ($opts{r}) {
        find(\&file_found, '.');
	foreach my $file (@files) {
	    proc_file($file);
	}
}
else {
        proc_file($opts{i}, $opts{o});
}

sub file_found {
        if ($_ =~ /.pm$/) {
             my $in_path = $File::Find::name;
             return if $in_path =~ /\Q$opts{x}\E/;
             push(@files, $in_path);
        }
}

sub proc_file {
my ($in_path, $out_path) = @_;

my $out;
if ($out_path) {
        print "Processing $in_path to $out_path\n";
	$out = new IO::File("> $out_path");
	die "Failed to open $out_path for writing: $!" if $out->error;