#!/usr/bin/perl -w

use Data::Dumper;
use File::Find;
use Getopt::Std;
use IO::File;
use strict;

my ( $EXCLUDE, $HELP, $QUIET, $TEST );

my $usage = <<EOF;
Usage: $0 -hqt [-e <regexp>] <directory> [<directory>...]
-e <regexp>: Exclude paths matching <regexp> case-insensitive. e.g. "(.gif|.jpg)$"
-h: Display help message and exit
-q: Quiet mode, do not report normal processing of files
-t: Do not actually change files, just report what changes would be made
EOF

my $helpmsg = <<EOF;
This utility converts existing components to use new syntax
introduced in Mason 0.8.

1. Old-style mc_commands (mc_comp, mc_file, etc.) are converted to
new-style \$m methods (\$m->comp, \$m->file, etc.) See Commands.pod for
all the conversions to be performed.

2. References to request variable \$REQ are converted to \$m.

All directories will be traversed recursively.  We STRONGLY recommend
that you backup your components, and/or use the -t flag to preview,
before running this program for real.  Files are modified
destructively and no automatic backups are created.
EOF

my $warning = <<EOF;
Warning: All directories will be traversed recursively.  Files are
modified destructively and no automatic backups are created.
EOF

sub usage {
    print $usage;
    exit;
}

sub main {
    my (%opts);
    getopts( 'e:hlqtu', \%opts );
    ( $EXCLUDE, $HELP, $QUIET, $TEST ) = @opts{qw(e h q t)};
    if ($HELP)    { print "$helpmsg\n$usage"; exit }
    if ( !@ARGV ) { print "$usage\n$helpmsg"; exit }
    my @dirs = @ARGV;

    if ( !$TEST ) {
        print "*** Mason 0.8 Conversion ***\n\n";
        print "Quiet mode.\n"                          if defined($QUIET);
        print "Excluding paths matching ($EXCLUDE).\n" if defined($EXCLUDE);
        print "Processing "
            . ( @dirs == 1 ? "directory " : "directories " )
            . join( ",", @dirs ) . "\n";
        print $warning;
        print "\nProceed? [n] ";
        exit if ( ( my $ans = <STDIN> ) !~ /[Yy]/ );
    }
    my $sub = sub {
        if ( -f $_ && -s _ ) {
            return
                if defined($EXCLUDE) && "$File::Find::dir/$_" =~ /$EXCLUDE/i;
            convert( $_, "$File::Find::dir/$_" );
        }
    };
    find( $sub, @dirs );
}

sub convert {
    my ( $file, $path ) = @_;
    my $buf;
    my $infh = new IO::File $file;
    if ( !$infh ) { warn "cannot read $path: $!"; return }
    { local $/ = undef; $buf = <$infh> }

    my $c = 0;
    my ( @changes, @failures );
    my $report = sub {
        push( @changes, $_[1] ? "$_[0]  -->  $_[1]" : "removed $_[0]" );
    };
    my $report_failure = sub { push( @failures, $_[0] ) };

    #
    # Convert mc_ commands to $m-> method equivalents
    #
    # Easy substitutions
    #
    my $easy_cmds = join(
        "|",
        qw(abort cache cache_self call_self comp comp_exists dhandler_arg file file_root out time)
    );
    if ( !$TEST ) {
        $c += ( $buf =~ s{mc_($easy_cmds)(?![A-Za-z0-9 _])}{"\$m->$1"}geo );
    }
    else {
        while ( $buf =~ m{(mc_($easy_cmds)(?![A-Za-z0-9 _]))}go ) {
            $report->( $1, "\$m->$2" );
        }
    }

    # Boilerplate substitutions for methods with no arguments
    my @subs = (
        [ 'mc_auto_comp',   '$m->fetch_next->path' ],
        [ 'mc_caller',      '$m->callers(1)->path' ],
        [ 'mc_comp_source', '$m->current_comp->source_file' ],
        [ 'mc_comp_stack',  'map($_->title,$m->callers)' ],
    );
    foreach my $sub (@subs) {
        my ( $mc_cmd, $repl ) = @$sub;
        if ( !$TEST ) {
            $c += ( $buf =~ s{$mc_cmd(\s*\(\))?(?!\s*[\(])}{$repl}ge );
        }
        else {
            while ( $buf =~ m{($mc_cmd(\s*\(\))?(?!\s*[\(]))}g ) {
                $report->( $1, $repl );
            }
        }
    }

    # Boilerplate substitutions for methods with arguments
    @subs = (
        [ 'mc_auto_next', '$m->call_next' ],
    );
    foreach my $sub (@subs) {
        my ( $mc_cmd, $repl ) = @$sub;
        if ( !$TEST ) {
            $c += ( $buf =~ s{$mc_cmd}{$repl}ge );
        }
        else {
            while ( $buf =~ m{($mc_cmd)}g ) {
                $report->( $1, $repl );
            }
        }
    }

    # mc_comp_source with simple argument
    if ( !$TEST ) {
        $c
            += ( $buf
                =~ s{mc_comp_source\s*\(([^\(\)]+)\)}{"\$m->fetch_comp($1)->source_file"}ge
            );
    }
    else {
        while ( $buf =~ m{(mc_comp_source\s*\(([^\(\)]+)\))}g ) {
            $report->( $1, "\$m->fetch_comp($2)->source_file" );
        }
    }

    # mc_suppress_http_header with and without arguments
    if ( !$TEST ) {
        $c += ( $buf =~ s{mc_suppress_http_header\s*(?!\s*\();?}{}g );
        $c += ( $buf =~ s{mc_suppress_http_header\s*\([^\(\)]*\)\s*;?}{}g );
    }
    else {
        while ( $buf =~ m{(mc_suppress_http_header\s*(?!\s*\();?)}g ) {
            $report->( $1, "" );
        }
        while ( $buf =~ m{(mc_suppress_http_header\s*\([^\(\)]*\)\s*;?)}g ) {
            $report->( $1, "" );
        }
    }

    #
    # Convert $REQ to $m
    #
    if ( !$TEST ) {
        $c += ( $buf =~ s{\$REQ(?![A-Za-z0-9_])}{\$m}go );
    }
    else {
        while ( $buf =~ m{(\$REQ(?![A-Za-z0-9_]))}go ) {
            $report->( $1, "\$m" );
        }
    }

    # Report substitutions we can't handle
    foreach my $cmd (qw(mc_comp_source mc_suppress_http_header)) {
        if ( $buf =~ m{$cmd\s*\([^\)]*\(} ) {
            $report_failure->("Can't convert $cmd with complex arguments");
        }
    }
    if ( $buf =~ m{mc_date} ) {
        $report_failure->("Can't convert mc_date");
    }

    if ($TEST) {
        if (@changes) {
            print scalar(@changes) . " substitutions in $path:\n";
            print join( "\n", @changes ) . "\n";
        }
    }

    if ( $c && !$TEST ) {
        print "$c substitutions in $path\n" if !$QUIET;
        my $outfh = new IO::File ">$file";
        if ( !$outfh ) { warn "cannot write $path: $!"; return }
        $outfh->print($buf);
    }

    foreach my $failure (@failures) {
        print "** Warning: $failure; must fix manually\n";
    }

    print "\n" if ( ( $TEST && @changes ) || @failures );
}

main();