doc/template/splitddhtmls.pl

#!/usr/bin/perl 
use strict;

my $out = \*STDOUT;

my $lang2suffix = {
};
my $type2suffix = {
  'text/html' => '.html',
  'application/xhtml+xml' => '.xhtml',
};

sub fs ($) {
  my $s = shift;
  $s =~ s/([^\w.])/_/g;
  $s;
}

sub pdir ($) {
  my @dir = split m#/#, shift;
  pop @dir;
  use File::Path;
  mkpath ([join '/', @dir], 1, 0711);
}

while (<>) {
  if (/^<!\[\[<!\[\[<><\?\?>--<\?\?><>\]\]>\]\]>$/) {
    my %data;
    I: while (<>) {
      if (s/^<>([^:]+):\s*//) {
        $data{$1} = $_;
        $data{$1} =~ s/\s+$//;
      } else {
        last I;
      }
    }
    my $filename = $data{Name};
    my $lang = fs ($lang2suffix->{$data{Lang}} or $data{Lang} ? '.' . $data{Lang} : '');
    $filename .= $lang unless $filename =~ /\b\Q$lang\E\b/;
    my $type = fs ($type2suffix->{$data{Type}} or $data{Type} ? '.' . $data{Type} : '');
    $filename .= $type unless $filename =~ /\b\Q$type\E\b/;
    pdir ($filename);
    open $out, '>', $filename or die "$0: $ARGV Line $.: $filename: $!";
  } else {
    print $out $_;
  }
}

__END__

=head1 AUTHOR

Wakaba <w@suika.fam.cx>

=head1 LICENSE

Public domain.

=cut
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			my $out = \*STDOUT;
5
6			my $lang2suffix = {
7			};
8			my $type2suffix = {
9			'text/html' => '.html',
10			'application/xhtml+xml' => '.xhtml',
11			};
12
13			sub fs ($) {
14			my $s = shift;
15			$s =~ s/([^\w.])/_/g;
16			$s;
17			}
18
19			sub pdir ($) {
20			my @dir = split m#/#, shift;
21			pop @dir;
22			use File::Path;
23			mkpath ([join '/', @dir], 1, 0711);
24			}
25
26			while (<>) {
27			if (/^<!\[\[<!\[\[<><\?\?>--<\?\?><>\]\]>\]\]>$/) {
28			my %data;
29			I: while (<>) {
30			if (s/^<>([^:]+):\s*//) {
31			$data{$1} = $_;
32			$data{$1} =~ s/\s+$//;
33			} else {
34			last I;
35			}
36			}
37			my $filename = $data{Name};
38			my $lang = fs ($lang2suffix->{$data{Lang}} or $data{Lang} ? '.' . $data{Lang} : '');
39			$filename .= $lang unless $filename =~ /\b\Q$lang\E\b/;
40			my $type = fs ($type2suffix->{$data{Type}} or $data{Type} ? '.' . $data{Type} : '');
41			$filename .= $type unless $filename =~ /\b\Q$type\E\b/;
42			pdir ($filename);
43			open $out, '>', $filename or die "$0: $ARGV Line $.: $filename: $!";
44			} else {
45			print $out $_;
46			}
47			}
48
49			__END__
50
51			=head1 AUTHOR
52
53			Wakaba <w@suika.fam.cx>
54
55			=head1 LICENSE
56
57			Public domain.
58
59			=cut