#!/usr/bin/perl -w

use strict;
use Template;

my @package_dir = qw(mozilla);
my @process_jar = qw(browser.jar);
my (%jar_list, %chrome_list);

sub process_jar_mn {
    my ($prefix) = @_;

    open(hJar, '<jar.mn')
        or die("cannot open jar.mn, $!");

    my $jar_file = '';
    while(<hJar>) {
        if(/^#/) {
            # comment
        } elsif(/^\s*$/) {
            # empty line (or a line with spaces only)
        } elsif(/^\s*(.+):\s*$/) {
            # jar file
            $jar_file = $1;
        } else {
            # jar file item
            if(!$jar_file) {
                die("missing jar file entry at $prefix/jar.mn");
            } else {
                if(/^\s*[\*\+]*\s*(.*?)\s*(?:\((.*?)\))?\s*$/) {
                    if(!exists $jar_list{$jar_file}->{$1}) {
                        my $path;
                        if(defined $2) {
                            if (-e $2) {
                                $path = $2;
                            } else {
                                die "referenced chrome file not found! ($2)";
                            }
                        } else {
                            if (-e $1) {
                                $path = $1;
                            } else {
                                # try the file name itself, without the path
                                my @path = split /\//, $1;
                                if (!-e ($path = pop @path)) {
                                    die "referenced chrome file not found! ($1)";
                                }
                            }
                        }

                        $jar_list{$jar_file}->{$1} = {
                            path       => "$prefix/$path", 
                            defined_in => "$prefix/jar.mn", 

                            jar        => $jar_file, 
                            jar_path   => $1, 

                            traced     => 0, 
                            consume    => [], 
                            consumer   => []
                        };

                   } else {
                        my $prev = $jar_list{$jar_file}->{$1}->{defined_in};
                        if($prev eq "$prefix/jar.mn") {
                            warn "duplicated entry in $jar_file:$1, redefined in same file! ($prev)\n\n";
                        } else {
                            warn "duplicated entry in $jar_file:$1, first defined in $jar_list{$jar_file}->{$1}->{defined_in}, now defined in $prefix/jar.mn\n\n";
                        }
                    }
                } else {
                    die "failed to parse $_ in $prefix/jar.mn";
                }
            }
        }
    }

    close(hJar);
}

sub process_dir {
    my ($dir, $prefix) = @_;

    chdir($dir)
        or die("cannot chdir($dir), $!");

    opendir(hDir, '.');
    foreach my $dir_item (readdir hDir) {
        if($dir_item ne '..' && $dir_item ne '.') {
            if(-d $dir_item) {
                # XXX only allows 'unix' to pass through, yeah!
                if ($dir_item ne 'win' && 
                    $dir_item ne 'mac' && 
                    $dir_item ne 'os2') {
                    process_dir($dir_item, "$prefix/$dir_item");
                }
            }

            if($dir_item eq 'jar.mn') {
                process_jar_mn($prefix);
            }
        }
    }
    closedir(hDir);

    chdir('..')
        or die("cannot chdir('..'), $!");
}

sub build_chrome_list {
    foreach my $jar (keys %jar_list) {
        $jar = $jar_list{$jar};

        foreach my $chrome (keys %$jar) {
            my $chrome = $jar->{$chrome};
            my @jar_path = split /\//, $chrome->{jar_path};

            my $chrome_path;
            if($jar_path[0] eq 'content') {
                # content/<package-name>/<path> => 
                # chrome:/<package-name>/content/<path>

                $chrome_path = "$jar_path[1]\/content\/" . 
                    join '/', @jar_path[2..$#jar_path];
            } elsif($jar_path[0] eq 'skin') {
                # skin/<skin-name>/<package-name>/<path> => 
                # chrome:/<package-name>/skin/<path>

                if($jar_path[1] eq 'classic') {
                    $chrome_path = "$jar_path[2]\/skin\/" . 
                        join '/', @jar_path[3..$#jar_path];
                } else {
                    warn "ignoring chrome belongs to skin: $jar_path[1]: $chrome->{jar}:$chrome->{jar_path}\n\n";
                }
            } elsif($jar_path[0] eq 'locale') {
                # locale/<locale-name>/<package-name>/<path> => 
                # chrome:/<package-name>/locale/<path>

                if($jar_path[1] eq 'en-US' || $jar_path[1] eq 'US') {
                    $chrome_path = "$jar_path[2]\/locale\/" . 
                        join '/', @jar_path[3..$#jar_path];
                } else {
                    warn "ignoring chrome belongs to locale $jar_path[1]: $chrome->{jar}:$chrome->{jar_path}\n\n";
                }
            } else {
                die 'unknown chrome category!';
            }

            if(defined $chrome_path) {
                if (!exists $chrome_list{$chrome_path}) {
                    $chrome->{chrome_path} = $chrome_path;
                    $chrome_list{$chrome_path} = $chrome;
                } else {
                    warn "duplicate chrome URL: chrome://$chrome_path\n\n";
                }
            }
        }
    }
}

sub trace_chrome {
    my ($chrome_path, $consumer) = @_;

    if(!exists $chrome_list{$chrome_path}) {
        # XXX this is an error, but user can know that from output
        #warn "chrome chrome://$chrome_path does not exist\n\n";
        return;
    }

    my $chrome = $chrome_list{$chrome_path};

    if(defined $consumer) {
        push(@{$chrome->{consumer}}, $consumer);
    }

    if ($chrome->{traced}) {
        # XXX this occurs frequently, and does not mean something goes wrong
        #warn "chrome chrome://$chrome->{chrome_path} already traced\n\n";
        return;
    }

    if (exists $chrome->{tracing}) {
        # XXX this occurs frequently, and does not mean something goes wrong
        #warn "recursive reference on chrome://$chrome->{chrome_path}\n\n";
        return;
    }

    $chrome->{tracing} = 1;

    open hChrome, "<$chrome->{path}";
    while(<hChrome>) {
        while(/chrome:\/\/([A-Za-z0-9\/\.-]+)/g) {
            push(@{$chrome->{consume}}, $1);
        }
    }
    close hChrome;

    my $this_chrome;
    foreach $this_chrome (@{$chrome->{consume}}) {
        trace_chrome($this_chrome, $chrome);

        if(exists $chrome_list{$this_chrome}) {
            $this_chrome = $chrome_list{$this_chrome};
        }
    }

    delete $chrome->{tracing};
    $chrome->{traced} = 1;
}

sub trace_jar {
    my ($jar) = @_;

    foreach my $jar_path (keys %{$jar_list{$jar}}) {
        if(exists $jar_list{$jar}->{$jar_path}->{chrome_path}) {
            trace_chrome($jar_list{$jar}->{$jar_path}->{chrome_path}, undef);
        } else {
            warn "$jar:$jar_path does not have a chrome path!\n\n";
        }
    }
}

# 
# main()
#

foreach my $dir (@package_dir) {
    process_dir($dir, $dir);
}

build_chrome_list();

foreach my $jar (@process_jar) {
    trace_jar($jar);
}

my $template = Template->new({
    INCLUDE_PATH => '/home/sprite/controlled/scripts', 
    EVAL_PERL    => 1
});
$template->process(
    'chrome-trace-report.htm', {
        jar_list    => \%jar_list, 
        chrome_list => \%chrome_list, 

        package_dir => \@package_dir, 
        process_jar => \@process_jar
    })
    or die $template->error();

