#!/usr/bin/perl
###########################################
# 5005it -- make a PM file 5005-compatible
# Mike Schilli, 2002 (m@perlmeister.com)
###########################################
use 5.00503;
use strict;

use File::Find;

my $USEVARS_DONE = 0;
my @OUR_VARS     = ();

###########################################
sub mk5005 {
###########################################
    find(\&process_file, "lib", "t");
}

###########################################
sub process_file {
###########################################
    my($file) = $_;

    return unless -f $file;

    $USEVARS_DONE = 0;
    @OUR_VARS     = ();
    
    open FILE, "<$file" or die "Cannot open $file";
    my $data = join '', <FILE>;
    close FILE;

    while($data =~ /^our[\s(]+([\$%@][\w_]+).*[;=]/mg) {
        push @OUR_VARS, $1;
    }

        # Replace 'our' variables
    $data =~ s/^our[\s(]+[\$%@][\w_]+.*/rep_our($&)/meg;

        # Replace 'use 5.006' lines
    $data =~ s/^use\s+5\.006/\nuse 5.00503/mg;

        # Delete 'no/use warnings;': \s seems to eat newlines, so use []
    $data =~ s/^[ \t]*use warnings;//mg;
    $data =~ s/^[ \t]*no warnings.*?;/\$\^W = undef;/mg;

        # 5.00503 can't handle constants that start with a _
    $data =~ s/_INTERNAL_DEBUG/INTERNAL_DEBUG/g;

        # Anything before 5.6.0 doesn't have the two argument binmode.
        # Convert to one arg version by discarding second arg.
    $data =~ s{ binmode \s* \(? (.*?) , .* \)? \s* ; }{ "binmode $1 ;" }gex;

    open FILE, ">$file" or die "Cannot open $file";
    print FILE $data;
    close FILE;
}

###########################################
sub rep_our {
###########################################
    my($line) = @_;

    my $out = "";

    if(!$USEVARS_DONE) {
        $out = "use vars qw(" . join(" ", @OUR_VARS) . "); ";
        $USEVARS_DONE = 1;
    }

    if($line =~ /=/) {
            # There's an assignment, just skip the 'our'
        $line =~ s/^our\s+//;
    } else {
            # There's nothing, just get rid of the entire line
        $line = "\n";
    }

    $out .= $line;
    return $out;
}

1;