#!/usr/bin/perl -w

# This perl script is intended to go through the fluxbox source
# code searching for the special NLS strings. It then dumps
# the requested details.
# 
# I started trying to write it fairly generic, but it was difficult :-)
# Should be fairly adaptable though
#
# It doesn't currently handle more than one NLS define per line
#    => If you get an "undefined" error, its probably 2 on one line

$VERSION = "0.1";

use strict;
use Getopt::Std;

$Getopt::Std::STANDARD_HELP_VERSION = 1;

# the boolitem and focusitem is pretty dodgy, but it'll do for now
my $match_re = "(?:_FB(?:TK)?TEXT|_BOOLITEM|_FOCUSITEM)";
# regular expression for not a unquoted quote
my $noquote = q'(?:[^\"]|\\")';

my $fielddelim = "\0";
my $recorddelim = "\0";

#############################
# Parse and validate arguments
my %opts;

my $command = $0;
$command =~ s,^.*/,,;

my $fullcommand = "$command " . join(" ", @ARGV);

if (!getopts("d:fhn:pr:vFHN:R", \%opts)) {
    HELP_MESSAGE("error");
    exit(1);
}

sub HELP_MESSAGE {
    my $arg = shift;
    my $FD = *STDOUT;
    if (defined($arg) && $arg eq "error") {
        $FD = *STDERR;
    }

    print $FD "Usage: $command [options] directory\n";
    print $FD " Where options can be:\n";
    print $FD "    -R\tDon't recurse into subdirectories.\n";
    print $FD "    -f\tThe argument is a file, not a directory\n";
    print $FD "    -F\tPrint full NLS names, not shorthand ones\n";
    print $FD "    -d delim\tUse delim as the default delimiter\n";
    print $FD "    -r delim\tUse delim as the record delimiter\n";
    print $FD "    -n\tHeader name, default FLUXBOX_NLS_HH\n";
    print $FD "    -N\tNamespace for header\n";
    print $FD "    -v\tverbose output\n";
    print $FD "    -h\tPrint this help message\n";
    print $FD "\nPlus one of the following options that direct how to operate:\n";
    print $FD "    -H\tGenerate a header file for the strings encountered (-n implied).\n";
    print $FD "    -p\tPrint out a null-separated tuple of Set,String,Default,Description\n";
    print $FD "    \t\n";
    print $FD "\n";

}

if (defined($opts{"h"})) {
    HELP_MESSAGE();
    exit(0);
}

my $num_modes = 0;
my $mode;

sub mode_opt {
    my $opt = shift;
    my $modename = shift;
    return if (!defined($opts{$opt}));
    $num_modes++;
    $mode = $modename;
}

mode_opt("H", "header");
mode_opt("p", "print");

if ($num_modes == 0) {
    print STDERR "Must give one mode of operation!\n";
    HELP_MESSAGE("error");
    exit(1);
} elsif ($num_modes > 1) {
    print STDERR "Too many modes of operation - must give exactly one!\n";
    HELP_MESSAGE("error");
    exit(1);
}

my $recurse = 1;
$recurse = 0 if (defined($opts{"R"}));

my $fullnames = 0;
$fullnames = 1 if (defined($opts{"f"}) || $mode eq "header");

my $headername = "FLUXBOX_NLS_HH";
$headername = $opts{"n"} if (defined($opts{"n"}));

my $namespace;
$namespace = $opts{"N"} if (defined($opts{"N"}));

my $verbose = 0;
$verbose = 1 if (defined($opts{"v"}));

if (defined($opts{"d"})) {
    $fielddelim = $opts{"d"};
    $recorddelim = $opts{"d"};
}

if (defined($opts{"r"})) {
    $recorddelim = $opts{"r"};
}


if (scalar(@ARGV) == 0) {
    print STDERR "Must give at least one more argument - the directory to scan\n";
    exit(1);
}


my @args = @ARGV;
if (!defined($opts{"f"})) {
    foreach my $dir (@args) {
        if (! -d $dir) {
            print STDERR "$dir is not a directory, aborting\n";
            exit(2);
        }
    }
} elsif (defined($opts{"f"})) {
    $recurse = 0;

    foreach my $file (@args) {
        if (! -r $file) {
            print STDERR "$file is not a readable file, aborting\n";
            exit(2);
        }
    }
}


#############################
# Actually do stuff! (finally...)

my %sets;

if (defined($opts{"f"})) {
    foreach my $file (@args) {
        process_file($file);
    }
} else {
    foreach my $dir (@args) {
        process_dir($dir);
    }
}

# Now we have the data, we need to print it out
eval "mode_$mode()";
exit(0);

# this function is given the fbtext arguments
# But the first argument is the macro name...
sub store {
    my ($type, $set, $str, $default, $desc) = @_;

    if ($type eq "_FBTKTEXT") {
        $set = "FbTk$set";
    }

    if ($fullnames == 1) {
        $str = $set . $str;
        $set = $set . "Set";
    }

    $sets{$set}->{$str}{"default"} = $default;
    $sets{$set}->{$str}{"desc"} = $desc;

}

# C strings can just be a bunch of quoted strings adjacent to 
# each other. This just puts them all together, removes the quotes
# and unquotes anything we want to.
# there may be newlines embedded... compare everything /s
sub squish {
    my $str = shift;

    # remove first and last quote
    $str =~ s/^\s*\"//s;
    $str =~ s/\"\s*$//s;
    
    # now remove any inner quotes and intervening spaces
    $str =~ s/([^\\])\"\s*\"/$1/sg;

    # finally, unescape any remaining quotes
    $str =~ s/\\\"/\"/g;

    return $str;
}

sub process_dir {
    my $dir = shift;
    print STDERR "Processing directory '$dir'\n" if ($verbose == 1);
    opendir(DIR, $dir) || die "can't opendir $dir: $!";
    my @files = grep { ( /\.(cc|hh)$/ && -f "$dir/$_" ) || 
                           ( -d "$dir/$_" && $_ !~ /^\.\.?$/ )
                         } readdir(DIR);
    closedir DIR;

    foreach my $file (@files) {
        if (-d "$dir/$file") {
            process_dir("$dir/$file") if ($recurse == 1);
        } else {
            process_file("$dir/$file");
        }
    }
}

# assumptions for now:
# - no more than one NLS thing on any single line
# - internal parenthesis are balanced
# - one nls thing can span several lines
sub process_file {
    my $file = shift;

    print STDERR "Processing file '$file'\n" if ($verbose == 1);
    open(FILE, "<$file") || die "Can't open file $file: $!";

    while (<FILE>) {
        chomp;
        if (/$match_re/ && $_ !~ /^\#(define|undef)/) {
            my $tail = $_;
            # strip away leading stuff
            # note that this doesn't work with more than one match on a line
            $tail =~ s/^.*($match_re)/$1/;
            # now we just need to find the end, looking out for any
            # quotes
            my $end = 0;
            my $full  = $tail;
            while ($end == 0) {
                # match the defined macro, plus the first 4 arguments 
                # (ignore any more), then handle them
                if ($full =~ /^($match_re)\(([^,]+),\s*([^,]+),((?:\s*\"$noquote*\")+),((?:\s*"$noquote*")+)\s*(?:,.*)?\)/s ) {
                    store($1, $2, $3, squish($4), squish($5));
                    $end++;
                } else {
                    my $extra = <FILE>;
                    last if (!defined($extra));
                    $full .= $extra;
                }
            }
        }
    }
    close(FILE);
}


sub mode_print {
    foreach my $set (sort keys %sets) {
        foreach my $str (sort keys %{$sets{$set}}) {
            print $set . $fielddelim . $str . $fielddelim . $sets{$set}->{$str}{"default"} . $fielddelim . $sets{$set}->{$str}{"desc"} . $recorddelim;
        }
    }
}

sub mode_header {
    print "// This file generated by $fullcommand, on " . localtime() . "\n\n";
    print "#ifndef $headername\n";
    print "#define $headername\n\n";
    print "namespace $namespace {\n\n" if (defined($namespace));
    print "enum {\n";

    my $setnum = 0;
    foreach my $set (sort keys %sets) {
        $setnum++;
        printf "\t%s = %d,\n", $set, $setnum; 

        my $strnum = 0;
        foreach my $str (sort keys %{$sets{$set}}) {
            $strnum++;
            printf "\t%s = %d,\n", $str, $strnum; 
        }
        print "\n";
    }
    print "\tdummy_not_used = 0 // just for the end\n\n";
    print "}; // end enum\n\n";
    print "}; // end namespace $namespace\n\n" if (defined($namespace));
    print "#endif // $headername\n";
}