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	#!/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