my %parsers;
sub end_input {
- #my ($parser, $command, $paragraph, $line_num) = (@_);
- my $parser = shift;
-
- return unless $parser->{active};
-
- print "Found end of $parser->{active}\n" if ($parser->{DEBUG});
- my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}};
- print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n"
- if ($parser->{DEBUG});
-
- $parser->{paragraphs} =~ s/^\s*|\s*$//gs
- if $parser->{trimmed_tags}->{$parser->{active}};
-
- if (ref $whereto eq "CODE") {
- print "calling sub\n" if $parser->{DEBUG};
- local ($_) = $parser->{paragraphs};
- $whereto->();
- print "done\n" if $parser->{DEBUG};
- } elsif (ref $whereto eq "SCALAR") {
- print "inserting into scalar\n" if $parser->{DEBUG};
- $$whereto = $parser->{paragraphs};
- } elsif (ref $whereto eq "ARRAY") {
- print "inserting into array\n" if $parser->{DEBUG};
- @$whereto = split /\n/, $parser->{paragraphs};
- } elsif (ref $whereto eq "HASH") {
- print "inserting into hash\n" if $parser->{DEBUG};
- # Oh, sorry, should I be in LISP101?
- %$whereto = (map { map { s/^\s*|\s*$//g; $_ }
- split /=>/, $_ }
- grep m/^
- ( (?:[^=]|=[^>])+ ) # scan up to "=>"
- =>
- ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
- $/x,
- split /\n/, $parser->{paragraphs});
- } else { die $whereto }
- $parser->{active} = undef;
+ #my ($parser, $command, $paragraph, $line_num) = (@_);
+ my $parser = shift;
+
+ return unless $parser->{active};
+
+ print "Found end of $parser->{active}\n" if ($parser->{DEBUG});
+ my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}};
+ print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n"
+ if ($parser->{DEBUG});
+
+ $parser->{paragraphs} =~ s/^\s*|\s*$//gs
+ if $parser->{trimmed_tags}->{$parser->{active}};
+
+ if (ref $whereto eq "CODE") {
+ print "calling sub\n" if $parser->{DEBUG};
+ local ($_) = $parser->{paragraphs};
+ $whereto->();
+ print "done\n" if $parser->{DEBUG};
+ } elsif (ref $whereto eq "SCALAR") {
+ print "inserting into scalar\n" if $parser->{DEBUG};
+ $$whereto = $parser->{paragraphs};
+ } elsif (ref $whereto eq "ARRAY") {
+ print "inserting into array\n" if $parser->{DEBUG};
+ @$whereto = split /\n/, $parser->{paragraphs};
+ } elsif (ref $whereto eq "HASH") {
+ print "inserting into hash\n" if $parser->{DEBUG};
+ # Oh, sorry, should I be in LISP101?
+ %$whereto = (map { map { s/^\s*|\s*$//g; $_ }
+ split /=>/, $_ }
+ grep m/^
+ ( (?:[^=]|=[^>])+ ) # scan up to "=>"
+ =>
+ ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
+ $/x,
+ split /\n/, $parser->{paragraphs});
+ } else { die $whereto }
+ $parser->{active} = undef;
}
# Pod::Parser overloaded command
sub command {
- my ($parser, $command, $paragraph, $line_num) = @_;
+ my ($parser, $command, $paragraph, $line_num) = @_;
+
+ $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
+
+ print "Got command =$command, value=$paragraph\n"
+ if $parser->{DEBUG};
+
+ $parser->end_input() if $parser->{active};
+
+ my $does_she_want_it_sir;
+
+ my ($lookup);
+ # first check for a catch-all for this command type
+ if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) {
+ $parser->{paragraphs} = $paragraph;
+ $parser->{active} = "*$command";
+ $does_she_want_it_sir = "oohw";
+
+ } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) {
+ if ( $2 ) {
+ # if it's a "for" or "begin" section, the title is the
+ # first word only
+ ($lookup, $parser->{paragraphs}) =
+ ($paragraph =~ m/^\s*(\S*)\s*(.*)/s);
+ } else {
+ # otherwise, it's up to the end of the line
+ ($lookup, $parser->{paragraphs})
+ = ($paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s);
+ }
+
+ # Look for a match by name
+ if (defined $lookup
+ and exists $parser->{wanted_pod_tags}->{$lookup}) {
+ print "Found $lookup\n" if ($parser->{DEBUG});
+ $parser->{active} = $lookup;
+ $does_she_want_it_sir = "suits you sir";
+ }
- $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
-
- print "Got command =$command, value=$paragraph\n"
- if $parser->{DEBUG};
-
- $parser->end_input() if $parser->{active};
-
- my $does_she_want_it_sir;
-
- my ($lookup);
- # first check for a catch-all for this command type
- if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) {
- $parser->{paragraphs} = $paragraph;
- $parser->{active} = "*$command";
- $does_she_want_it_sir = "oohw";
-
- } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) {
- if ( $2 ) {
- # if it's a "for" or "begin" section, the title is the
- # first word only
- ($lookup, $parser->{paragraphs}) =
- ($paragraph =~ m/^\s*(\S*)\s*(.*)/s);
} else {
- # otherwise, it's up to the end of the line
- ($lookup, $parser->{paragraphs})
- = ($paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s);
+ # nothing
+ print "Ignoring =$command (not known)\n" if $parser->{DEBUG};
}
- # Look for a match by name
- if (defined $lookup
- and exists $parser->{wanted_pod_tags}->{$lookup}) {
- print "Found $lookup\n" if ($parser->{DEBUG});
- $parser->{active} = $lookup;
- $does_she_want_it_sir = "suits you sir";
- }
-
- } else {
- # nothing
- print "Ignoring =$command (not known)\n" if $parser->{DEBUG};
- }
-
- {
- local $^W = 0;
- print "Ignoring =$command $paragraph (lookup = $lookup)\n"
- if (!$does_she_want_it_sir and $parser->{DEBUG})
- }
+ {
+ local $^W = 0;
+ print "Ignoring =$command $paragraph (lookup = $lookup)\n"
+ if (!$does_she_want_it_sir and $parser->{DEBUG})
+ }
}
# Pod::Parser overloaded verbatim
sub verbatim {
- my ($parser, $paragraph, $line_num) = @_;
- $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
+ my ($parser, $paragraph, $line_num) = @_;
+ $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
- print("Got paragraph: $paragraph ("
- .($parser->{active}?"using":"ignoring").")\n")
- if $parser->{DEBUG};
+ print("Got paragraph: $paragraph ("
+ .($parser->{active}?"using":"ignoring").")\n")
+ if $parser->{DEBUG};
- if (defined $parser->{active}) {
- $parser->{paragraphs} .= $paragraph;
- }
+ if (defined $parser->{active}) {
+ $parser->{paragraphs} .= $paragraph;
+ }
}
# Pod::Parser overloaded textblock
HOOK => sub {
%hash =
(map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
- (grep m/^
- ( (?:[^=]|=[^>])+ ) # scan up to "=>"
- =>
- ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
- $/x, split /\n/, $_));
+ (grep m/^
+ ( (?:[^=]|=[^>])+ ) # scan up to "=>"
+ =>
+ ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
+ $/x, split /\n/, $_));
}
Well, they're simple if you can grok map, a regular expression like
=cut
sub import {
- my $class = shift;
-
- # if no args, just return
- return unless (@_);
-
- # try to guess the source file of the caller
- my $source_file;
- if (caller ne "main") {
- (my $module = caller().".pm") =~ s|::|/|g;
- $source_file = $INC{$module};
- }
- $source_file ||= $0;
-
- ( -f $source_file )
- or croak ("Cannot find source file (guessed $source_file) for"
- ." package ".caller());
-
- # nasty tricks with the stack so we don't have to be silly with
- # caller()
- unshift @_, $source_file;
- goto \&import_from_file;
+ my $class = shift;
+
+ # if no args, just return
+ return unless (@_);
+
+ # try to guess the source file of the caller
+ my $source_file;
+ if (caller ne "main") {
+ (my $module = caller().".pm") =~ s|::|/|g;
+ $source_file = $INC{$module};
+ }
+ $source_file ||= $0;
+
+ ( -f $source_file )
+ or croak ("Cannot find source file (guessed $source_file) for"
+ ." package ".caller());
+
+ # nasty tricks with the stack so we don't have to be silly with
+ # caller()
+ unshift @_, $source_file;
+ goto \&import_from_file;
}
=head2 import_from_file($filename, @args)
use IO::Handle;
sub import_from_file {
- my $filename = shift;
+ my $filename = shift;
- my $parser = __PACKAGE__->new();
+ my $parser = __PACKAGE__->new();
- $parser->{wanted_pod_tags} = {};
- $parser->{trimmed_tags} = {};
- $parser->{trim_next} = 0;
- $parser->{DEBUG} = 0;
- $parser->{active} = undef;
- $parsers{caller()} = $parser;
+ $parser->{wanted_pod_tags} = {};
+ $parser->{trimmed_tags} = {};
+ $parser->{trim_next} = 0;
+ $parser->{DEBUG} = 0;
+ $parser->{active} = undef;
+ $parsers{caller()} = $parser;
- $parser->add_hook(@_);
+ $parser->add_hook(@_);
- print "Pod::Parser: DEBUG: Opening $filename for reading\n"
- if $parser->{DEBUG};
- my $fh = new IO::Handle;
- open $fh, "<$filename"
- or die ("cannot open $filename for reading; $!");
+ print "Pod::Parser: DEBUG: Opening $filename for reading\n"
+ if $parser->{DEBUG};
+ my $fh = new IO::Handle;
+ open $fh, "<$filename"
+ or die ("cannot open $filename for reading; $!");
- $parser->parse_from_filehandle($fh, \*STDOUT);
+ $parser->parse_from_filehandle($fh, \*STDOUT);
- close $fh;
+ close $fh;
}
=head2 add_hook(NAME => value)
=cut
sub add_hook {
- my $parser;
- if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
- $parser = shift;
- } else {
- $parser = $parsers{caller()}
- or die("add_hook called, but don't know what for - "
- ."caller = ".caller());
- }
- while (my ($pod_tag, $var) = splice @_, 0, 2) {
- #print "$pod_tag: $var\n";
- if (lc($pod_tag) eq "-trim") {
- $parser->{trim_next} = $var;
- } elsif ( lc($pod_tag) eq "-debug" ) {
- $parser->{DEBUG} = $var;
- } elsif (lc($pod_tag) eq "-usage") {
- # an idea for later - automatic "usage"
- #%wanted_pod_tags{@tags}
+ my $parser;
+ if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
+ $parser = shift;
} else {
- if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
- print "Will look for $pod_tag.\n"
- if ($parser->{DEBUG});
- $parser->{wanted_pod_tags}->{$pod_tag} = $var;
- $parser->{trimmed_tags}->{$pod_tag} = 1
- if $parser->{trim_next};
- } else {
- die ("Sorry - need a reference to import POD "
- ."sections into, not the scalar value $var"
- ." importing $pod_tag into ".caller());
- }
+ $parser = $parsers{caller()}
+ or die("add_hook called, but don't know what for - "
+ ."caller = ".caller());
+ }
+ while (my ($pod_tag, $var) = splice @_, 0, 2) {
+ #print "$pod_tag: $var\n";
+ if (lc($pod_tag) eq "-trim") {
+ $parser->{trim_next} = $var;
+ } elsif ( lc($pod_tag) eq "-debug" ) {
+ $parser->{DEBUG} = $var;
+ } elsif (lc($pod_tag) eq "-usage") {
+ # an idea for later - automatic "usage"
+ #%wanted_pod_tags{@tags}
+ } else {
+ if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
+ print "Will look for $pod_tag.\n"
+ if ($parser->{DEBUG});
+ $parser->{wanted_pod_tags}->{$pod_tag} = $var;
+ $parser->{trimmed_tags}->{$pod_tag} = 1
+ if $parser->{trim_next};
+ } else {
+ die ("Sorry - need a reference to import POD "
+ ."sections into, not the scalar value $var"
+ ." importing $pod_tag into ".caller());
+ }
+ }
}
- }
}
=head2 delete_hook(@list)
=cut
sub delete_hook {
- my $parser;
- if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
- $parser = shift;
- } else {
- $parser = $parsers{caller()}
- or die("delete_hook called, but don't know what for - "
- ."caller = ".caller());
- }
- while ( my $label = shift ) {
- delete $parser->{wanted_pod_tags}->{$label};
- delete $parser->{trimmed_tags}->{$label};
- }
+ my $parser;
+ if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
+ $parser = shift;
+ } else {
+ $parser = $parsers{caller()}
+ or die("delete_hook called, but don't know what for - "
+ ."caller = ".caller());
+ }
+ while ( my $label = shift ) {
+ delete $parser->{wanted_pod_tags}->{$label};
+ delete $parser->{trimmed_tags}->{$label};
+ }
}
=head2 CLOSURES AS DESTINATIONS
WriteMakefile
(
- 'NAME' => $NAME,
+ 'NAME' => $NAME,
'PREREQ_PM' => $PREREQ_PM,
'VERSION' => $VERSION,
($] >= 5.005 ? ## Add these new keywords supported since 5.005
=cut
BEGIN {
- Pod::Constants->import
- (
- SYNOPSIS => sub {
- eval pop @{[ grep /^\s*\$VERSION/, split /\n/, $_ ]}
- }
- )
+ Pod::Constants->import
+ (
+ SYNOPSIS => sub {
+ eval pop @{[ grep /^\s*\$VERSION/, split /\n/, $_ ]}
+ }
+ )
};
1.4142;
projects / pod-constants.git / commitdiff