mozilla/tool/replace.pl

#!/usr/bin/perl
use strict;
require Getopt::Long;
my %opt = (type => 'js');
Getopt::Long::GetOptions (
  'input=s'     => \$opt{input},
  'output-type=s'       => \$opt{type},
);

my %var = (percent => {value => '%'});
my $name;
while (<>) {
  if (/^(.+?)(?:\[([^]]+)\])?:\s*$/) {
    $name = $1;
    $var{$name}->{type} = $2;
  } elsif (/^\t(.*)/) {
    my $s = $1;
    $s =~ tr/\x0D\x0A//d;
    $s = replace_percent ($s, \%var);
    if ($var{$name}->{type} eq 'list') {
      push @{$var{$name}->{value}}, $s;
    } else {
      $var{$name}->{value} .= "\n" if defined $var{$name}->{value};
      $var{$name}->{value} .= $s;
    }
  }
}

open SRC, $opt{input} or die "$0: $opt{input}: $!";
  print scalar commentize (qq(This file is auto-generated (at @{[
                              sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
                                      (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
                              ]}).\n)
                          .qq(Do not edit by hand!\n))
        unless $opt{type} eq 'xml';
  while (<SRC>) {
    print scalar escape (replace_percent ($_, \%var));
  }
close SRC;

exit;

sub escape ($) {
  my $s = shift;
  if ($opt{type} eq 'moz-properties') {
    require Encode;
    $s = Encode::decode ('utf8', $s);
    ## TODO: How to encode U+10000 - U-7F000000 ?
    $s =~ s/([^\x0A\x0D\x20-\x22\x24-\x5B\x5D-\x7E])/sprintf '\u%04X', ord $1/ge
      unless $s =~ /^\s*\#/;
  }
  $s;
}

sub replace_percent ($$) {
  my ($s, $l) = @_;
  $s =~ s{%%([^%]+)%%}{
    my ($r, $type) = _get_replacement_text ($1, $l);
    if ($type eq 'list') {
      ## Note: Expansion of list needs more study.
      warn "List $1 is expanded\n";
      if ($opt{type} eq 'xml') {
        $r = join (' ', @$r);
      } else {
        $r = join (', ', map {qq("$_")} @$r);
      }
    }
    $r;
  }ge;
  $s;
}

sub _get_replacement_text ($$) {
  my ($n, $l) = @_;
  my ($rm, $type) = ($l->{$n}->{value}, $l->{$n}->{type});
  unless (defined $rm) {
    if ($n eq 'current-date-time') {
      $rm = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
                    (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
    }
  }
  ($rm, $type);
}

sub commentize ($) {
  my $s = shift;
  if ($opt{type} eq 'js') {
    $s =~ s!^! * !mg;
    return "/*\n" . $s . " */\n";
  } elsif ($opt{type} eq 'xml') {
    $s =~ s!^!   - !mg;
    return "<!--\n" . $s . "   -->\n";
  } else { # moz-properties
    $s =~ s!^!## !mg;
    return $s."\n";
  }
}


=head1 LICENSE

Copyright 2003-2004 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=cut

## $Date: 2004/04/14 12:17:38 $
1	w	1.1	#!/usr/bin/perl
2			use strict;
3			require Getopt::Long;
4			my %opt = (type => 'js');
5			Getopt::Long::GetOptions (
6			'input=s' => \$opt{input},
7			'output-type=s' => \$opt{type},
8			);
9
10	wakaba	1.3	my %var = (percent => {value => '%'});
11	w	1.1	my $name;
12			while (<>) {
13	wakaba	1.2	if (/^(.+?)(?:\[([^]]+)\])?:\s*$/) {
14	w	1.1	$name = $1;
15			$var{$name}->{type} = $2;
16	wakaba	1.2	} elsif (/^\t(.*)/) {
17			my $s = $1;
18			$s =~ tr/\x0D\x0A//d;
19			$s = replace_percent ($s, \%var);
20	w	1.1	if ($var{$name}->{type} eq 'list') {
21			push @{$var{$name}->{value}}, $s;
22			} else {
23			$var{$name}->{value} .= "\n" if defined $var{$name}->{value};
24			$var{$name}->{value} .= $s;
25			}
26			}
27			}
28
29			open SRC, $opt{input} or die "$0: $opt{input}: $!";
30			print scalar commentize (qq(This file is auto-generated (at @{[
31			sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
32			(gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
33			]}).\n)
34			.qq(Do not edit by hand!\n))
35			unless $opt{type} eq 'xml';
36			while (<SRC>) {
37	wakaba	1.3	print scalar escape (replace_percent ($_, \%var));
38	w	1.1	}
39			close SRC;
40
41			exit;
42
43	wakaba	1.3	sub escape ($) {
44			my $s = shift;
45			if ($opt{type} eq 'moz-properties') {
46			require Encode;
47			$s = Encode::decode ('utf8', $s);
48			## TODO: How to encode U+10000 - U-7F000000 ?
49			$s =~ s/([^\x0A\x0D\x20-\x22\x24-\x5B\x5D-\x7E])/sprintf '\u%04X', ord $1/ge
50			unless $s =~ /^\s*\#/;
51			}
52			$s;
53			}
54
55	w	1.1	sub replace_percent ($$) {
56			my ($s, $l) = @_;
57			$s =~ s{%%([^%]+)%%}{
58			my ($r, $type) = _get_replacement_text ($1, $l);
59			if ($type eq 'list') {
60	wakaba	1.4	## Note: Expansion of list needs more study.
61			warn "List $1 is expanded\n";
62			if ($opt{type} eq 'xml') {
63			$r = join (' ', @$r);
64			} else {
65			$r = join (', ', map {qq("$_")} @$r);
66			}
67	w	1.1	}
68			$r;
69			}ge;
70			$s;
71			}
72
73			sub _get_replacement_text ($$) {
74			my ($n, $l) = @_;
75			my ($rm, $type) = ($l->{$n}->{value}, $l->{$n}->{type});
76			unless (defined $rm) {
77			if ($n eq 'current-date-time') {
78			$rm = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
79			(gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
80			}
81			}
82			($rm, $type);
83			}
84
85			sub commentize ($) {
86			my $s = shift;
87			if ($opt{type} eq 'js') {
88			$s =~ s!^! * !mg;
89			return "/\n" . $s . " /\n";
90			} elsif ($opt{type} eq 'xml') {
91			$s =~ s!^! - !mg;
92			return "<!--\n" . $s . " -->\n";
93	wakaba	1.3	} else { # moz-properties
94	w	1.1	$s =~ s!^!## !mg;
95			return $s."\n";
96			}
97			}
98
99
100			=head1 LICENSE
101
102	wakaba	1.3	Copyright 2003-2004 Wakaba <w@suika.fam.cx>. All rights reserved.
103	w	1.1
104			This program is free software; you can redistribute it and/or modify
105			it under the terms of the GNU General Public License as published by
106			the Free Software Foundation; either version 2 of the License, or
107			(at your option) any later version.
108
109			This program is distributed in the hope that it will be useful,
110			but WITHOUT ANY WARRANTY; without even the implied warranty of
111			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
112			GNU General Public License for more details.
113
114			You should have received a copy of the GNU General Public License
115			along with this program; see the file COPYING. If not, write to
116			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
117			Boston, MA 02111-1307, USA.
118
119			=cut
120
121	wakaba	1.4	## $Date: 2004/04/14 12:17:38 $