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') {
      $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 <[email protected]>.  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: 2003/10/25 12:00:20 $
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			$r = join (', ', map {qq("$_")} @$r);
61			}
62			$r;
63			}ge;
64			$s;
65			}
66
67			sub _get_replacement_text ($$) {
68			my ($n, $l) = @_;
69			my ($rm, $type) = ($l->{$n}->{value}, $l->{$n}->{type});
70			unless (defined $rm) {
71			if ($n eq 'current-date-time') {
72			$rm = sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ',
73			(gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
74			}
75			}
76			($rm, $type);
77			}
78
79			sub commentize ($) {
80			my $s = shift;
81			if ($opt{type} eq 'js') {
82			$s =~ s!^! * !mg;
83			return "/\n" . $s . " /\n";
84			} elsif ($opt{type} eq 'xml') {
85			$s =~ s!^! - !mg;
86			return "<!--\n" . $s . " -->\n";
87	wakaba	1.3	} else { # moz-properties
88	w	1.1	$s =~ s!^!## !mg;
89			return $s."\n";
90			}
91			}
92
93
94			=head1 LICENSE
95
96	wakaba	1.3	Copyright 2003-2004 Wakaba <[email protected]>. All rights reserved.
97	w	1.1
98			This program is free software; you can redistribute it and/or modify
99			it under the terms of the GNU General Public License as published by
100			the Free Software Foundation; either version 2 of the License, or
101			(at your option) any later version.
102
103			This program is distributed in the hope that it will be useful,
104			but WITHOUT ANY WARRANTY; without even the implied warranty of
105			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
106			GNU General Public License for more details.
107
108			You should have received a copy of the GNU General Public License
109			along with this program; see the file COPYING. If not, write to
110			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
111			Boston, MA 02111-1307, USA.
112
113			=cut
114
115	wakaba	1.3	## $Date: 2003/10/25 12:00:20 $