use strict; use vars qw(%PROP %SET %SET_ALIAS $VERSION); $VERSION=do{my @r=(q$Revision: 1.6 $=~/\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 @{[$PROP{pod_description}? " =head1 DESCRIPTION $PROP{pod_description}":'']} =cut EOH } sub table () { my $prefix = exists $PROP{prefix_name} ? $PROP{prefix_name} : $PROP{module_name}; my $r = ''; my @set; my %set_description; 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{^#DESCRIPTION\x20(.+)$}{ $set_description{qq(In${prefix}$_)} = $1; }me; $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(< $b} map {ord $_} split //, $SET{$_}), q(EOH)): @aitem > 0? (q(< 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 (sort {$a->[0] cmp $b->[0]} @set) { $r .= sprintf "=item %s\n\n", $_->[0]; $r .= sprintf "%s\n\n", $set_description{ $_->[0] } if $set_description{ $_->[0] }; } $r .= "=cut\n\n"; $r; } sub footer () { my $r = < 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; my @c; $s =~ s{^(#.+)}{ push @c, $1; ''; }gem; $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", @c, 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 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/09/07 12:55:01 $ ### mkpm.pl ends here