Char/Class/mkpm.pl

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

$PROP{perl_namespace_name} = 'Char::Class::';
$PROP{module_name} = 'FooScript';

sub header () {
<<"EOH";
## This file 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 $PROP{perl_namespace_name}$PROP{module_name};
our \$VERSION = '$PROP{version}';
@{[
#package main;
]}
use Exporter;
use vars qw(\@EXPORT_OK \@ISA \$VERSION);
\@ISA = qw(Exporter);

=head1 NAME

$PROP{module_name}.pm --- @{[ $PROP{script_name} || $PROP{module_name} ]} character set classes 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

sub import (\$;\@) {
  my (\$self, \@sub) = (shift, \@_);
  for (\@sub) {
    no strict 'refs';
    *{'main::'.\$_} = \\&{\$_};
  }
  \$Exporter::ExportLevel = 1;
  \$self->SUPER::import (\@_);
  \$Exporter::ExportLevel = 0;
}

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-formatted
    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(<<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{$_};)];
  $set_description{qq(In${prefix}$_)} = qq<Alias for 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 = <<EOH;
@{[$PROP{pod_example}? "
=head1 EXAMPLE

$PROP{pod_example}":"
=head1 EXAMPLE

 use $PROP{perl_namespace_name}$PROP{module_name};
 if (\$s =~ /\\p{In$PROP{module_name}HogeHoge}/) {
   print \"Match!\\n\";
 }
"]}@{[$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;
  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::Class::* modules generating library

=head1 LICENSE

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