#!/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();