SuikaWiki/Plugin/mkplugin.pl

#!/usr/bin/perl
use strict;

my %ReplaceText = &ReplaceText;
my %Info;
my $mode = 0;
my $section = '';
my %item;
while (<>) {
  if ($mode == 1) {     ## In a block
    if (/^\}$/) {
      for my $name (split /\n/, $item{Name}) {
        $item{Name} = $name;
        $item{ModuleName} ||= $name;
        $item{ModuleName} =~ s/[^0-9A-Za-z_]/_/g;
        push @{ $Info{part} }, {%item};
      }
      $mode = 0;  %item = ();
    } elsif (/^(.+):$/) {
      $section = $1;
    } elsif (/^\t(.*)$/) {
      my $l = $1;
      if ($item{$section}) {
        $item{$section} .= "\n".$l;
      } else {
        $item{$section} = $l;
      }
    }
  } else {      ## Out of blocks
    if (/^\{$/) {
      $mode = 1;
    } elsif (/^(.+):$/) {
      $section = $1;
    } elsif (/^\t(.*)$/) {
      my $t = $1;
      if ($Info{$section}) {
        $Info{$section} .= "\n".$t;
      } else {
        $Info{$section} = $t;
      }
    }
  }
}
$ReplaceText{MYSELF} = qq(SuikaWiki::Plugin::$Info{Name});

print <<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!

=head1 NAME

$ReplaceText{MYSELF} --- $Info{FullName}
<$Info{URI}>
@{[ $Info{'POD:DESCRIPTION'} ? qq{
=head1 DESCRIPTION

$Info{'POD:DESCRIPTION'}} : '']}

=cut

package $ReplaceText{MYSELF};
use strict;
our \$VERSION = q(@{[sprintf '%04d.%02d%02d.%02d%02d', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1]]});

$Info{Initialize}

EOH

my %part;
my $partinfo;
for my $fullpart (@{ $Info{part} }) {
  my ($type, $part) = split m#/#, $fullpart->{Name}, 2;
  my $part2 = $part; $part2 =~ tr/-/_/; $part2 =~ s/^_/-/;
  my $type2 = $type; $type2 =~ tr/-/_/;
  $part{$type2}->{$part} = <<EOH;
\$fmt->{q($part2)} = sub { my (\$r, \$p, \$o) = ('', \@_);
$fullpart->{Format}
\$r };
EOH
    $partinfo .= <<EOH;
  q($type2/$part2) => {FullName => q($fullpart->{FullName}), description => q($fullpart->{Description})},
EOH
}

my $provide = qq(qw/@{([join ' ', keys %part])}/);
print <<EOH;
sub import {
    my \$self = shift;
    \$self->SuikaWiki::Plugin::regist ($provide);
}

sub property (\$;\@) {
    shift;
    my \%prop = (
                name     => q($Info{FullName}),
                version  => \$VERSION,
                uri      => q($Info{URI}),
                description     => q($Info{Description}),
                provide  => [$provide],
                partinfo => {
$partinfo},
    );
    if (scalar \@_ == 0) {
        \\\%prop;
    } else {
        \@prop{\@_};
    }
}
EOH

print <<'EOH';
sub load_formatter ($$%) {
    my $self = shift;
    my ($fmt, %q) = @_;
    unless ($q{type}) {
        #
    }
EOH

for my $part (sort keys %part) {
print <<EOH;
    elsif (\$q{type} eq '$part') {
EOH
for my $name (sort keys %{$part{$part}}) {
print <<EOH;
      $part{$part}->{$name}
EOH
}
print <<'EOH';
    }
EOH
}

$Info{MODULE} =~ s/%%([A-Za-z0-9_]+)%%/$ReplaceText{$1}/g;
print <<EOH;
} # sub load_formatter

$Info{MODULE}

EOH

for my $name (qw/EXAMPLE/, 'SEE ALSO', 'TO DO', qw/AUTHORS LICENSE/) {
  if ($Info{qq(POD:$name)}) {
    $Info{qq(POD:$name)} =~ s/%%([A-Za-z0-9_]+)%%/$ReplaceText{$1}/g;
    print <<EOH;
=head1 $name

$Info{qq(POD:$name)}

EOH
  }
}

print <<EOH;
=cut

1;
EOH

sub ReplaceText () {
  my %RT = (
    GNUGPL2     => q{This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.},
    PerlLicense => q{This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.},
    YEAR => (gmtime)[5]+1900,
  );
  %RT;
}

=head1 LICENSE

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

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

Note that modules generated by this script should be
licensed by the licenser of source file so that copyright
holder of this script does not claim any right to them.

=cut

1;
# $Date: 2003/05/25 10:54:55 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			my %ReplaceText = &ReplaceText;
5			my %Info;
6			my $mode = 0;
7			my $section = '';
8			my %item;
9			while (<>) {
10			if ($mode == 1) { ## In a block
11			if (/^\}$/) {
12	wakaba	1.9	for my $name (split /\n/, $item{Name}) {
13			$item{Name} = $name;
14			$item{ModuleName} \|\|= $name;
15			$item{ModuleName} =~ s/[^0-9A-Za-z_]/_/g;
16			push @{ $Info{part} }, {%item};
17			}
18	wakaba	1.1	$mode = 0; %item = ();
19			} elsif (/^(.+):$/) {
20			$section = $1;
21			} elsif (/^\t(.*)$/) {
22			my $l = $1;
23			if ($item{$section}) {
24			$item{$section} .= "\n".$l;
25			} else {
26			$item{$section} = $l;
27			}
28			}
29			} else { ## Out of blocks
30			if (/^\{$/) {
31			$mode = 1;
32			} elsif (/^(.+):$/) {
33			$section = $1;
34			} elsif (/^\t(.*)$/) {
35			my $t = $1;
36			if ($Info{$section}) {
37			$Info{$section} .= "\n".$t;
38			} else {
39			$Info{$section} = $t;
40			}
41			}
42			}
43			}
44			$ReplaceText{MYSELF} = qq(SuikaWiki::Plugin::$Info{Name});
45
46			print <<EOH;
47			## This file is auto-generated (at @{[ sprintf '%04d-%02d-%02dT%02d:%02d:%02dZ', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0] ]}).
48			## Do not edit by hand!
49
50			=head1 NAME
51
52			$ReplaceText{MYSELF} --- $Info{FullName}
53			<$Info{URI}>
54			@{[ $Info{'POD:DESCRIPTION'} ? qq{
55			=head1 DESCRIPTION
56
57			$Info{'POD:DESCRIPTION'}} : '']}
58
59			=cut
60
61			package $ReplaceText{MYSELF};
62			use strict;
63	wakaba	1.2	our \$VERSION = q(@{[sprintf '%04d.%02d%02d.%02d%02d', (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1]]});
64	wakaba	1.1
65	wakaba	1.3	$Info{Initialize}
66
67	wakaba	1.1	EOH
68
69			my %part;
70			my $partinfo;
71			for my $fullpart (@{ $Info{part} }) {
72			my ($type, $part) = split m#/#, $fullpart->{Name}, 2;
73	wakaba	1.12	my $part2 = $part; $part2 =~ tr/-/_/; $part2 =~ s/^_/-/;
74	wakaba	1.11	my $type2 = $type; $type2 =~ tr/-/_/;
75			$part{$type2}->{$part} = <<EOH;
76	w	1.6	\$fmt->{q($part2)} = sub { my (\$r, \$p, \$o) = ('', \@_);
77	wakaba	1.1	$fullpart->{Format}
78			\$r };
79			EOH
80			$partinfo .= <<EOH;
81	wakaba	1.11	q($type2/$part2) => {FullName => q($fullpart->{FullName}), description => q($fullpart->{Description})},
82	wakaba	1.1	EOH
83			}
84
85			my $provide = qq(qw/@{([join ' ', keys %part])}/);
86			print <<EOH;
87			sub import {
88			my \$self = shift;
89			\$self->SuikaWiki::Plugin::regist ($provide);
90			}
91
92			sub property (\$;\@) {
93			shift;
94			my \%prop = (
95			name => q($Info{FullName}),
96			version => \$VERSION,
97			uri => q($Info{URI}),
98	wakaba	1.10	description => q($Info{Description}),
99	wakaba	1.1	provide => [$provide],
100			partinfo => {
101			$partinfo},
102			);
103			if (scalar \@_ == 0) {
104			\\\%prop;
105			} else {
106			\@prop{\@_};
107			}
108			}
109			EOH
110
111			print <<'EOH';
112			sub load_formatter ($$%) {
113			my $self = shift;
114			my ($fmt, %q) = @_;
115			unless ($q{type}) {
116			#
117			}
118			EOH
119
120			for my $part (sort keys %part) {
121			print <<EOH;
122			elsif (\$q{type} eq '$part') {
123			EOH
124			for my $name (sort keys %{$part{$part}}) {
125			print <<EOH;
126			$part{$part}->{$name}
127			EOH
128			}
129			print <<'EOH';
130			}
131			EOH
132			}
133
134	wakaba	1.8	$Info{MODULE} =~ s/%%([A-Za-z0-9_]+)%%/$ReplaceText{$1}/g;
135	wakaba	1.1	print <<EOH;
136			} # sub load_formatter
137
138	wakaba	1.8	$Info{MODULE}
139
140	wakaba	1.1	EOH
141
142			for my $name (qw/EXAMPLE/, 'SEE ALSO', 'TO DO', qw/AUTHORS LICENSE/) {
143			if ($Info{qq(POD:$name)}) {
144			$Info{qq(POD:$name)} =~ s/%%([A-Za-z0-9_]+)%%/$ReplaceText{$1}/g;
145			print <<EOH;
146			=head1 $name
147
148			$Info{qq(POD:$name)}
149
150			EOH
151			}
152			}
153
154			print <<EOH;
155			=cut
156
157			1;
158			EOH
159
160			sub ReplaceText () {
161			my %RT = (
162			GNUGPL2 => q{This program is free software; you can redistribute it and/or modify
163			it under the terms of the GNU General Public License as published by
164			the Free Software Foundation; either version 2 of the License, or
165			(at your option) any later version.
166
167			This program is distributed in the hope that it will be useful,
168			but WITHOUT ANY WARRANTY; without even the implied warranty of
169			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
170			GNU General Public License for more details.
171
172			You should have received a copy of the GNU General Public License
173			along with this program; see the file COPYING. If not, write to
174			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
175			Boston, MA 02111-1307, USA.},
176			PerlLicense => q{This library is free software; you can redistribute it
177			and/or modify it under the same terms as Perl itself.},
178			YEAR => (gmtime)[5]+1900,
179			);
180			%RT;
181			}
182
183			=head1 LICENSE
184
185			Copyright 2002 Wakaba <w@suika.fam.cx>
186
187			This library is free software; you can redistribute it
188			and/or modify it under the same terms as Perl itself.
189
190			Note that modules generated by this script should be
191			licensed by the licenser of source file so that copyright
192			holder of this script does not claim any right to them.
193
194			=cut
195
196			1;
197	wakaba	1.12	# $Date: 2003/05/25 10:54:55 $