genstrings2

#!/usr/bin/perl
#
# Copyright (c) 2006 Shoichi Fukusaka. All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use strict;
use warnings;
use utf8;
use English;

our $NSLocalizedString = "NSLocalizedString";
our @skipTables = ();
our $outputdir = ".";
our $inputencoding = "utf8";
our %Tables = ();
our %opts = ();

sub usage {
    print STDERR <<EOM;
Usage: genstrings2 [OPTION] file1.[mc] ... filen.[mc]

Options
 -j                       sets the input language to Java. (not implement)
 -a                       append output to the old strings files.
 -s substring             substitute 'substring' for NSLocalizedString.
 -skipTable tablename     skip over the file for 'tablename'.
 -noPositionalParameters  turns off positional parameter support. (not implement)
 -u                       allow unicode characters. (not implement)
 -q                       turns off multiple key/value pairs warning.
 -o dir                   place output files in 'dir'.
 -e encoding              input file encoding.

Please see the genstrings(1) man page for full documentation

EOM
    exit;
}

# parse OPTION
while ($ARGV[0] =~ /^-/) {
    my $opt = shift @ARGV;
    if ($opt eq '-j') { #NOT-IMPL
	$opts{'j'} = 1;
    }
    elsif ($opt eq '-a') {
	$opts{'a'} = 1;
    }
    elsif ($opt eq '-u') { #NOT-IMPL
	$opts{'u'} = 1;
    }
    elsif ($opt eq '-q') {
	$opts{'q'} = 1;
    }
    elsif ($opt eq '-noPositionalParameters') { #NOT-IMPL
	$opts{'noPositionalParameters'} = 1;
    }
    elsif (scalar(@ARGV) >= 1) {
	if ($opt eq '-s') {
	    $NSLocalizedString = shift @ARGV;
	}
	elsif ($opt eq '-skipTable') {
	    push(@skipTables,shift @ARGV);
	}
	elsif ($opt eq '-o') {
	    $outputdir = shift @ARGV;
	}
	elsif ($opt eq '-e') {
	    $inputencoding = shift @ARGV;
	}
	else {
	    &usage;
	}
    }
    else {
	&usage;
    }
}

&usage if (scalar(@ARGV)==0);

foreach my $file (@ARGV) {
    open IN, "<:encoding($inputencoding)", $file;
    parseFile({'handle' => *IN, 'lines' => "", 'in_comment' => 0});
    close IN;
}
&outputTables;

sub appendString {
    my($table,$key,$comment) = @_;
    my($comments);
    #print "$table,$key,$comment\n";
    $Tables{$table} = {} if (!defined($Tables{$table}));
    $Tables{$table}->{$key} = [] if (!defined($Tables{$table}->{$key}));
    return unless (defined($comment));

    $comments = $Tables{$table}->{$key};
    if (scalar(grep($_ eq $comment,@$comments)) == 0) {
	push(@$comments,$comment);
	if (!$opts{'q'} && scalar(@$comments) > 1) {
	    print STDERR "Key \"$key\" was used with mutliple values \"",join('" & "',@$comments),"\"\n";
	}
    }
}

sub outputTables {
    foreach my $table (keys(%Tables)) {
	#print "Table: $table\n";
	next unless(scalar(grep($_ eq $table,@skipTables)) == 0);
	open OUT, (($opts{'a'})?">>":">").":encoding(utf8)", "$outputdir/$table.strings";
	#*OUT = *STDOUT;
	my @keys = sort(keys(%{$Tables{$table}}));
	#print join(",",@keys),"\n";
	foreach my $key (@keys) {
	    my $comments = $Tables{$table}->{$key};
	    my $comment = ((scalar(@$comments)!=0)
			   ? join("\n   ",@$comments)
			   : "No comment provided by engineer.");

	    print OUT "/* $comment */\n";
	    print OUT "\"$key\" = \"$key\";\n";
	    print OUT "\n";
	}
	close OUT;
    }
}

sub nextLine {
    my($context) = @_;
    my($line, $str);
    local(*IN) = $context->{'handle'};
    return 0 unless (defined($line = <IN>));
  recheck: {
      if ($context->{'in_comment'}) {
	  if ($line =~ /\*\//) {
	      $context->{'in_comment'} = 0;
	      $line = $POSTMATCH;
	      goto recheck;
	  }
      } else {
	  $line =~ s#//.*$##;
	  if ($line =~ /\/\*/) {
	      $context->{'in_comment'} = 1;
	      $line = $POSTMATCH;
	      $context->{'lines'} .= $PREMATCH;
	      goto recheck;
	  }
	  $context->{'lines'} .= $line;
      }
    }
    #print "line($context->{'in_comment'}): $line";
    return 1;
}

sub nextToken {
    my($context) = @_;
    my($token,$lines);

    for (;;) {
	$lines = $context->{'lines'};
	$lines =~ s/^[\s\n]*//;
	if (length($lines)==0) {
	    $context->{'lines'} = "";
	    return undef if (!&nextLine($context));
	    next;
	}
      token: {
	  if ($lines =~ /^((["'])[^"]*\2)/) { # FIXME
	      $token = $1;
	      $lines = $POSTMATCH;
	  }
	  elsif ($lines =~ /^([\w]+)/) {
	      $token = $1;
	      $lines = $POSTMATCH;	
	  }
	  else { 
	      $token = substr($lines,0,1);
	      $lines = substr($lines,1,length($lines)-1);
	  }
	  $context->{'lines'} = $lines;
	  #print "token: $token\n";
	  return $token;
	}
    }
}

sub parseFile {
    my($context) = @_;
    my($token, $nest, $i, $str, @tokens);
    
    while (defined($token = &nextToken($context))) {
	#print "token: $token\n";
	next unless ($token eq $NSLocalizedString
		     || $token eq "${NSLocalizedString}FromTable" );
	@tokens  = ($token);
	$nest = 0;
	while (defined($token = &nextToken($context))) {
	    next unless ($token =~ /^(\(|,|\)|\"|\w)/);
	    #print "token: $token\n";
	    if ($nest == 0) {
		last if ($token ne "(");
		$nest++;
		push(@tokens,[]);
	    }
	    elsif ($nest >= 1) {
		if ($token eq ")") {
		    $nest--;
		}
		elsif ($token eq "(") {
		    $nest++;
		}
		elsif ($token eq "," && $nest == 1) {
		    push(@tokens,[]);
		}
		else {
		    push(@{$tokens[$#tokens]},$token);
		}
		last if ($nest > 15);
	    }
	    if ($nest == 0) {
		for ($i = 1; $i <= $#tokens; $i++) {
		    if ($tokens[$i]->[0] =~ /^\"/) {
			$str = "";
			foreach my $var (@{$tokens[$i]}) {
			    $str .= substr($var,1,length($var)-2);
			}
			$tokens[$i] = $str;
			#print "[$str]\n";
		    } else {
			$tokens[$i] = undef;
			#print "not\n";
		    }
		}
		
		if ($tokens[0] eq $NSLocalizedString
		    && scalar(@tokens) == 3)
		{
		    appendString("Localizable",$tokens[1],$tokens[2]);
		}
		elsif ($tokens[0] eq "${NSLocalizedString}FromTable"
		       && scalar(@tokens) == 4)
		{
		    appendString($tokens[2],$tokens[1],$tokens[3]);
		}
		else {
		    # ...
		}
		last;
	    }
	}
    }
    #print "token: $token\n";
}