Char/Class/mkpm.pl

use strict;
use vars qw(%PROP %SET %SET_ALIAS $VERSION);
$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

$PROP{module_name} = 'FooScript';

sub header () {
<<"EOH";
## This is auto-generated (at @{[ sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0] ]}).  Do not edit by hand!
use strict;

package Char::InSet::$PROP{module_name};
use Exporter;
use vars qw(\@EXPORT_OK \@ISA \$VERSION);
\@ISA = qw(Exporter);
\$VERSION = '$PROP{version}';

=head1 NAME

$PROP{module_name}.pm --- @{[ $PROP{script_name} || $PROP{module_name} ]} character sets for C<\\p{In@{[ exists $PROP{prefix_name} ? $PROP{prefix_name} : $PROP{module_name} ]}HogeHoge}> regexps

=cut

EOH
}

sub table () {
my $prefix = exists $PROP{prefix_name} ? $PROP{prefix_name} : $PROP{module_name};
my $r = '';
my @set;
for (sort keys %SET) {
  my (@aline,@aitem);
  $SET{$_} =~ s{^#\+(\w+)$}{
    push @aline, qq(\&In${prefix}$1.); ''
  }mge;
  $SET{$_} =~ s{^!(.+)$}{       ## Pre-formated
    push @aitem, $1; ''
  }mge;
  $SET{$_} =~ s{^#.+$}{}mg;
  $SET{$_} =~ tr/\x09\x0A\x0D\x20//d;
  push @set, [qq(In${prefix}$_) => 
    join "\n", qq(sub In${prefix}$_ {),
               @aline,
               (length $SET{$_}?
                 (q(<<EOH;),
                 @aitem,
                 (map {sprintf '%04X', $_} sort {$a <=> $b}
                  map {ord $_} split //, $SET{$_}),
                 q(EOH)):
               @aitem > 0? (q(<<EOH;), @aitem, q(EOH)): "''"),
               q(})
  ];
}
for (sort keys %SET_ALIAS) {
  push @set, [qq(In${prefix}$_) => qq(\*In${prefix}$_ = \\&In${prefix}$SET_ALIAS{$_};)];
}

$r = qq(\@EXPORT_OK = qw(@{[map {$_->[0]} @set]});\n\n);
$r .= join '', map {$_->[1]."\n\n"} @set;

$r .= "=head1 COLLECTION NAMES\n\n=over 4\n\n";
for (@set) {
  $r .= sprintf "=item %s\n\n", $_->[0];
}
$r .= "=cut\n\n";

$r;
}

sub footer () {
my $r = <<EOH;
@{[$PROP{pod_description}? "=head1 DESCRIPTION

$PROP{pod_description}":'']}@{[$PROP{pod_example}? "
=head1 EXAMPLE

$PROP{pod_example}":'']}@{[$PROP{pod_see_also}? "
=head1 SEE ALSO

$PROP{pod_see_also}":'']}@{[$PROP{pod_license}? "
=head1 LICENSE

$PROP{pod_license}":"=head1 LICENSE

Copyright @{[(gmtime)[5]+1900]} $PROP{author_name} <$PROP{author_mail}>

This library and the library generated by it is free software;
you can redistribute them and/or modify them under the same
terms as Perl itself.
"]}
=cut

1;
### $PROP{module_name}.pm ends here
EOH
$r;
}

sub col2list ($) {
  my $s = shift;
  my @s;
  $s =~ s{^[\x20\x09]*([0-9A-F][0-9A-F])((?:[\x20\x09]+[0-9A-F][0-9A-F](?:-[0-9A-F][0-9A-F])?)+)}{
    my ($r, @c) = ($1, grep {length} split /\s+/, $2);
    for (@c) {
      if (/([0-9A-F][0-9A-F])-([0-9A-F][0-9A-F])/) {
        push @s, sprintf '%s%s  %s%s    ', $r,$1, $r,$2;
      } else {
        push @s, sprintf '%s%s', $r,$_;
      }
    }
  }gem;
  join ("\n", map {'!'.$_} @s)."\n";
}

sub print_module () {
  no warnings;
  print &header.&table.&footer;
}

=head1 NAME

mkpm.pl --- Char::InSet::Han modules generating library

=head1 LICENSE

Copyright 2002 Wakaba <w@suika.fam.cx>

This library and the library generated by it is free software;
you can redistribute them and/or modify them under the same
terms as Perl itself.

=cut

1; ## $Date: 2002/08/24 02:43:29 $
### mkpm.pl ends here
1	wakaba	1.1	use strict;
2			use vars qw(%PROP %SET %SET_ALIAS $VERSION);
3	wakaba	1.4	$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.1
5			$PROP{module_name} = 'FooScript';
6
7			sub header () {
8			<<"EOH";
9			## This is auto-generated (at @{[ sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0] ]}). Do not edit by hand!
10			use strict;
11
12			package Char::InSet::$PROP{module_name};
13			use Exporter;
14			use vars qw(\@EXPORT_OK \@ISA \$VERSION);
15			\@ISA = qw(Exporter);
16			\$VERSION = '$PROP{version}';
17	wakaba	1.4
18			=head1 NAME
19
20			$PROP{module_name}.pm --- @{[ $PROP{script_name} \|\| $PROP{module_name} ]} character sets for C<\\p{In@{[ exists $PROP{prefix_name} ? $PROP{prefix_name} : $PROP{module_name} ]}HogeHoge}> regexps
21
22			=cut
23
24	wakaba	1.1	EOH
25			}
26
27			sub table () {
28	wakaba	1.3	my $prefix = exists $PROP{prefix_name} ? $PROP{prefix_name} : $PROP{module_name};
29	wakaba	1.1	my $r = '';
30			my @set;
31			for (sort keys %SET) {
32	wakaba	1.2	my (@aline,@aitem);
33	wakaba	1.1	$SET{$_} =~ s{^#\+(\w+)$}{
34	wakaba	1.3	push @aline, qq(\&In${prefix}$1.); ''
35	wakaba	1.1	}mge;
36	wakaba	1.2	$SET{$_} =~ s{^!(.+)$}{ ## Pre-formated
37			push @aitem, $1; ''
38			}mge;
39	wakaba	1.1	$SET{$_} =~ s{^#.+$}{}mg;
40			$SET{$_} =~ tr/\x09\x0A\x0D\x20//d;
41	wakaba	1.3	push @set, [qq(In${prefix}$_) =>
42			join "\n", qq(sub In${prefix}$_ {),
43	wakaba	1.2	@aline,
44			(length $SET{$_}?
45			(q(<<EOH;),
46			@aitem,
47			(map {sprintf '%04X', $_} sort {$a <=> $b}
48			map {ord $_} split //, $SET{$_}),
49			q(EOH)):
50			@aitem > 0? (q(<<EOH;), @aitem, q(EOH)): "''"),
51			q(})
52	wakaba	1.1	];
53			}
54			for (sort keys %SET_ALIAS) {
55	wakaba	1.3	push @set, [qq(In${prefix}$_) => qq(\*In${prefix}$_ = \\&In${prefix}$SET_ALIAS{$_};)];
56	wakaba	1.1	}
57
58			$r = qq(\@EXPORT_OK = qw(@{[map {$_->[0]} @set]});\n\n);
59			$r .= join '', map {$_->[1]."\n\n"} @set;
60	wakaba	1.4
61			$r .= "=head1 COLLECTION NAMES\n\n=over 4\n\n";
62			for (@set) {
63			$r .= sprintf "=item %s\n\n", $_->[0];
64			}
65			$r .= "=cut\n\n";
66
67	wakaba	1.1	$r;
68			}
69
70			sub footer () {
71			my $r = <<EOH;
72	wakaba	1.4	@{[$PROP{pod_description}? "=head1 DESCRIPTION
73	wakaba	1.1
74	wakaba	1.4	$PROP{pod_description}":'']}@{[$PROP{pod_example}? "
75			=head1 EXAMPLE
76	wakaba	1.1
77	wakaba	1.4	$PROP{pod_example}":'']}@{[$PROP{pod_see_also}? "
78			=head1 SEE ALSO
79	wakaba	1.2
80	wakaba	1.4	$PROP{pod_see_also}":'']}@{[$PROP{pod_license}? "
81			=head1 LICENSE
82	wakaba	1.1
83	wakaba	1.2	$PROP{pod_license}":"=head1 LICENSE
84	wakaba	1.1
85	wakaba	1.2	Copyright @{[(gmtime)[5]+1900]} $PROP{author_name} <$PROP{author_mail}>
86	wakaba	1.1
87			This library and the library generated by it is free software;
88			you can redistribute them and/or modify them under the same
89			terms as Perl itself.
90	wakaba	1.4	"]}
91	wakaba	1.1	=cut
92
93			1;
94			### $PROP{module_name}.pm ends here
95			EOH
96			$r;
97			}
98
99	wakaba	1.3	sub col2list ($) {
100			my $s = shift;
101			my @s;
102			$s =~ s{^[\x20\x09]*([0-9A-F][0-9A-F])((?:[\x20\x09]+[0-9A-F][0-9A-F](?:-[0-9A-F][0-9A-F])?)+)}{
103			my ($r, @c) = ($1, grep {length} split /\s+/, $2);
104			for (@c) {
105			if (/([0-9A-F][0-9A-F])-([0-9A-F][0-9A-F])/) {
106			push @s, sprintf '%s%s %s%s ', $r,$1, $r,$2;
107			} else {
108			push @s, sprintf '%s%s', $r,$_;
109			}
110			}
111			}gem;
112			join ("\n", map {'!'.$_} @s)."\n";
113			}
114
115	wakaba	1.1	sub print_module () {
116			no warnings;
117			print &header.&table.&footer;
118			}
119
120			=head1 NAME
121
122			mkpm.pl --- Char::InSet::Han modules generating library
123
124			=head1 LICENSE
125
126			Copyright 2002 Wakaba <w@suika.fam.cx>
127
128			This library and the library generated by it is free software;
129			you can redistribute them and/or modify them under the same
130			terms as Perl itself.
131
132			=cut
133
134	wakaba	1.4	1; ## $Date: 2002/08/24 02:43:29 $
135	wakaba	1.1	### mkpm.pl ends here