git.maemo.org Git - pkg-perl/blob - deb-src/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/PullParser.pm

   1
   2 require 5;
   3 package Pod::Simple::PullParser;
   4 $VERSION = '2.02';
   5 use Pod::Simple ();
   6 BEGIN {@ISA = ('Pod::Simple')}
   7
   8 use strict;
   9 use Carp ();
  10
  11 use Pod::Simple::PullParserStartToken;
  12 use Pod::Simple::PullParserEndToken;
  13 use Pod::Simple::PullParserTextToken;
  14
  15 BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
  16
  17 __PACKAGE__->_accessorize(
  18   'source_fh',         # the filehandle we're reading from
  19   'source_scalar_ref', # the scalarref we're reading from
  20   'source_arrayref',   # the arrayref we're reading from
  21 );
  22
  23 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  24 #
  25 #  And here is how we implement a pull-parser on top of a push-parser...
  26
  27 sub filter {
  28   my($self, $source) = @_;
  29   $self = $self->new unless ref $self;
  30
  31   $source = *STDIN{IO} unless defined $source;
  32   $self->set_source($source);
  33   $self->output_fh(*STDOUT{IO});
  34
  35   $self->run; # define run() in a subclass if you want to use filter()!
  36   return $self;
  37 }
  38
  39 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  40
  41 sub parse_string_document {
  42   my $this = shift;
  43   $this->set_source(\ $_[0]);
  44   $this->run;
  45 }
  46
  47 sub parse_file {
  48   my($this, $filename) = @_;
  49   $this->set_source($filename);
  50   $this->run;
  51 }
  52
  53 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  54 #  In case anyone tries to use them:
  55
  56 sub run {
  57   use Carp ();
  58   if( __PACKAGE__ eq ref($_[0]) || $_[0]) { # I'm not being subclassed!
  59     Carp::croak "You can call run() only on subclasses of "
  60      . __PACKAGE__;
  61   } else {
  62     Carp::croak join '',
  63       "You can't call run() because ",
  64       ref($_[0]) || $_[0], " didn't define a run() method";
  65   }
  66 }
  67
  68 sub parse_lines {
  69   use Carp ();
  70   Carp::croak "Use set_source with ", __PACKAGE__,
  71     " and subclasses, not parse_lines";
  72 }
  73
  74 sub parse_line {
  75   use Carp ();
  76   Carp::croak "Use set_source with ", __PACKAGE__,
  77     " and subclasses, not parse_line";
  78 }
  79
  80 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  81
  82 sub new {
  83   my $class = shift;
  84   my $self = $class->SUPER::new(@_);
  85   die "Couldn't construct for $class" unless $self;
  86
  87   $self->{'token_buffer'} ||= [];
  88   $self->{'start_token_class'} ||= 'Pod::Simple::PullParserStartToken';
  89   $self->{'text_token_class'}  ||= 'Pod::Simple::PullParserTextToken';
  90   $self->{'end_token_class'}   ||= 'Pod::Simple::PullParserEndToken';
  91
  92   DEBUG > 1 and print "New pullparser object: $self\n";
  93
  94   return $self;
  95 }
  96
  97 # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
  98
  99 sub get_token {
 100   my $self = shift;
 101   DEBUG > 1 and print "\nget_token starting up on $self.\n";
 102   DEBUG > 2 and print " Items in token-buffer (",
 103    scalar( @{ $self->{'token_buffer'} } ) ,
 104    ") :\n", map(
 105      "    " . $_->dump . "\n", @{ $self->{'token_buffer'} }
 106    ),
 107    @{ $self->{'token_buffer'} } ? '' : '       (no tokens)',
 108    "\n"
 109   ;
 110
 111   until( @{ $self->{'token_buffer'} } ) {
 112     DEBUG > 3 and print "I need to get something into my empty token buffer...\n";
 113     if($self->{'source_dead'}) {
 114       DEBUG and print "$self 's source is dead.\n";
 115       push @{ $self->{'token_buffer'} }, undef;
 116     } elsif(exists $self->{'source_fh'}) {
 117       my @lines;
 118       my $fh = $self->{'source_fh'}
 119        || Carp::croak('You have to call set_source before you can call get_token');
 120
 121       DEBUG and print "$self 's source is filehandle $fh.\n";
 122       # Read those many lines at a time
 123       for(my $i = Pod::Simple::MANY_LINES; $i--;) {
 124         DEBUG > 3 and print " Fetching a line from source filehandle $fh...\n";
 125         local $/ = $Pod::Simple::NL;
 126         push @lines, scalar(<$fh>); # readline
 127         DEBUG > 3 and print "  Line is: ",
 128           defined($lines[-1]) ? $lines[-1] : "<undef>\n";
 129         unless( defined $lines[-1] ) {
 130           DEBUG and print "That's it for that source fh!  Killing.\n";
 131           delete $self->{'source_fh'}; # so it can be GC'd
 132           last;
 133         }
 134          # but pass thru the undef, which will set source_dead to true
 135
 136         # TODO: look to see if $lines[-1] is =encoding, and if so,
 137         # do horribly magic things
 138
 139       }
 140
 141       if(DEBUG > 8) {
 142         print "* I've gotten ", scalar(@lines), " lines:\n";
 143         foreach my $l (@lines) {
 144           if(defined $l) {
 145             print "  line {$l}\n";
 146           } else {
 147             print "  line undef\n";
 148           }
 149         }
 150         print "* end of ", scalar(@lines), " lines\n";
 151       }
 152
 153       $self->SUPER::parse_lines(@lines);
 154
 155     } elsif(exists $self->{'source_arrayref'}) {
 156       DEBUG and print "$self 's source is arrayref $self->{'source_arrayref'}, with ",
 157        scalar(@{$self->{'source_arrayref'}}), " items left in it.\n";
 158
 159       DEBUG > 3 and print "  Fetching ", Pod::Simple::MANY_LINES, " lines.\n";
 160       $self->SUPER::parse_lines(
 161         splice @{ $self->{'source_arrayref'} },
 162         0,
 163         Pod::Simple::MANY_LINES
 164       );
 165       unless( @{ $self->{'source_arrayref'} } ) {
 166         DEBUG and print "That's it for that source arrayref!  Killing.\n";
 167         $self->SUPER::parse_lines(undef);
 168         delete $self->{'source_arrayref'}; # so it can be GC'd
 169       }
 170        # to make sure that an undef is always sent to signal end-of-stream
 171
 172     } elsif(exists $self->{'source_scalar_ref'}) {
 173
 174       DEBUG and print "$self 's source is scalarref $self->{'source_scalar_ref'}, with ",
 175         length(${ $self->{'source_scalar_ref'} }) -
 176         (pos(${ $self->{'source_scalar_ref'} }) || 0),
 177         " characters left to parse.\n";
 178
 179       DEBUG > 3 and print " Fetching a line from source-string...\n";
 180       if( ${ $self->{'source_scalar_ref'} } =~
 181         m/([^\n\r]*)((?:\r?\n)?)/g
 182       ) {
 183         #print(">> $1\n"),
 184         $self->SUPER::parse_lines($1)
 185          if length($1) or length($2)
 186           or pos(     ${ $self->{'source_scalar_ref'} })
 187            != length( ${ $self->{'source_scalar_ref'} });
 188          # I.e., unless it's a zero-length "empty line" at the very
 189          #  end of "foo\nbar\n" (i.e., between the \n and the EOS).
 190       } else { # that's the end.  Byebye
 191         $self->SUPER::parse_lines(undef);
 192         delete $self->{'source_scalar_ref'};
 193         DEBUG and print "That's it for that source scalarref!  Killing.\n";
 194       }
 195
 196
 197     } else {
 198       die "What source??";
 199     }
 200   }
 201   DEBUG and print "get_token about to return ",
 202    Pod::Simple::pretty( @{$self->{'token_buffer'}}
 203      ? $self->{'token_buffer'}[-1] : undef
 204    ), "\n";
 205   return shift @{$self->{'token_buffer'}}; # that's an undef if empty
 206 }
 207
 208 use UNIVERSAL ();
 209 sub unget_token {
 210   my $self = shift;
 211   DEBUG and print "Ungetting ", scalar(@_), " tokens: ",
 212    @_ ? "@_\n" : "().\n";
 213   foreach my $t (@_) {
 214     Carp::croak "Can't unget that, because it's not a token -- it's undef!"
 215      unless defined $t;
 216     Carp::croak "Can't unget $t, because it's not a token -- it's a string!"
 217      unless ref $t;
 218     Carp::croak "Can't unget $t, because it's not a token object!"
 219      unless UNIVERSAL::can($t, 'type');
 220   }
 221
 222   unshift @{$self->{'token_buffer'}}, @_;
 223   DEBUG > 1 and print "Token buffer now has ",
 224    scalar(@{$self->{'token_buffer'}}), " items in it.\n";
 225   return;
 226 }
 227
 228 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 229
 230 # $self->{'source_filename'} = $source;
 231
 232 sub set_source {
 233   my $self = shift @_;
 234   return $self->{'source_fh'} unless @_;
 235   my $handle;
 236   if(!defined $_[0]) {
 237     Carp::croak("Can't use empty-string as a source for set_source");
 238   } elsif(ref(\( $_[0] )) eq 'GLOB') {
 239     $self->{'source_filename'} = '' . ($handle = $_[0]);
 240     DEBUG and print "$self 's source is glob $_[0]\n";
 241     # and fall thru
 242   } elsif(ref( $_[0] ) eq 'SCALAR') {
 243     $self->{'source_scalar_ref'} = $_[0];
 244     DEBUG and print "$self 's source is scalar ref $_[0]\n";
 245     return;
 246   } elsif(ref( $_[0] ) eq 'ARRAY') {
 247     $self->{'source_arrayref'} = $_[0];
 248     DEBUG and print "$self 's source is array ref $_[0]\n";
 249     return;
 250   } elsif(ref $_[0]) {
 251     $self->{'source_filename'} = '' . ($handle = $_[0]);
 252     DEBUG and print "$self 's source is fh-obj $_[0]\n";
 253   } elsif(!length $_[0]) {
 254     Carp::croak("Can't use empty-string as a source for set_source");
 255   } else {  # It's a filename!
 256     DEBUG and print "$self 's source is filename $_[0]\n";
 257     {
 258       local *PODSOURCE;
 259       open(PODSOURCE, "<$_[0]") || Carp::croak "Can't open $_[0]: $!";
 260       $handle = *PODSOURCE{IO};
 261     }
 262     $self->{'source_filename'} = $_[0];
 263     DEBUG and print "  Its name is $_[0].\n";
 264
 265     # TODO: file-discipline things here!
 266   }
 267
 268   $self->{'source_fh'} = $handle;
 269   DEBUG and print "  Its handle is $handle\n";
 270   return 1;
 271 }
 272
 273 # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
 274
 275 sub get_title_short {  shift->get_short_title(@_)  } # alias
 276
 277 sub get_short_title {
 278   my $title = shift->get_title(@_);
 279   $title = $1 if $title =~ m/^(\S{1,60})\s+--?\s+./s;
 280     # turn "Foo::Bar -- bars for your foo" into "Foo::Bar"
 281   return $title;
 282 }
 283
 284 sub get_title       { shift->_get_titled_section(
 285   'NAME', max_token => 50, desperate => 1, @_)
 286 }
 287 sub get_version     { shift->_get_titled_section(
 288    'VERSION',
 289     max_token => 400,
 290     accept_verbatim => 1,
 291     max_content_length => 3_000,
 292    @_,
 293   );
 294 }
 295 sub get_description { shift->_get_titled_section(
 296    'DESCRIPTION',
 297     max_token => 400,
 298     max_content_length => 3_000,
 299    @_,
 300 ) }
 301
 302 sub get_authors     { shift->get_author(@_) }  # a harmless alias
 303
 304 sub get_author      {
 305   my $this = shift;
 306   # Max_token is so high because these are
 307   #  typically at the end of the document:
 308   $this->_get_titled_section('AUTHOR' , max_token => 10_000, @_) ||
 309   $this->_get_titled_section('AUTHORS', max_token => 10_000, @_);
 310 }
 311
 312 #--------------------------------------------------------------------------
 313
 314 sub _get_titled_section {
 315   # Based on a get_title originally contributed by Graham Barr
 316   my($self, $titlename, %options) = (@_);
 317
 318   my $max_token            = delete $options{'max_token'};
 319   my $desperate_for_title  = delete $options{'desperate'};
 320   my $accept_verbatim      = delete $options{'accept_verbatim'};
 321   my $max_content_length   = delete $options{'max_content_length'};
 322   $max_content_length = 120 unless defined $max_content_length;
 323
 324   Carp::croak( "Unknown " . ((1 == keys %options) ? "option: " : "options: ")
 325     . join " ", map "[$_]", sort keys %options
 326   )
 327    if keys %options;
 328
 329   my %content_containers;
 330   $content_containers{'Para'} = 1;
 331   if($accept_verbatim) {
 332     $content_containers{'Verbatim'} = 1;
 333     $content_containers{'VerbatimFormatted'} = 1;
 334   }
 335
 336   my $token_count = 0;
 337   my $title;
 338   my @to_unget;
 339   my $state = 0;
 340   my $depth = 0;
 341
 342   Carp::croak "What kind of titlename is \"$titlename\"?!" unless
 343    defined $titlename and $titlename =~ m/^[A-Z ]{1,60}$/s; #sanity
 344   my $titlename_re = quotemeta($titlename);
 345
 346   my $head1_text_content;
 347   my $para_text_content;
 348
 349   while(
 350     ++$token_count <= ($max_token || 1_000_000)
 351     and defined(my $token = $self->get_token)
 352   ) {
 353     push @to_unget, $token;
 354
 355     if ($state == 0) { # seeking =head1
 356       if( $token->is_start and $token->tagname eq 'head1' ) {
 357         DEBUG and print "  Found head1.  Seeking content...\n";
 358         ++$state;
 359         $head1_text_content = '';
 360       }
 361     }
 362
 363     elsif($state == 1) { # accumulating text until end of head1
 364       if( $token->is_text ) {
 365         DEBUG and print "   Adding \"", $token->text, "\" to head1-content.\n";
 366         $head1_text_content .= $token->text;
 367       } elsif( $token->is_end and $token->tagname eq 'head1' ) {
 368         DEBUG and print "  Found end of head1.  Considering content...\n";
 369         if($head1_text_content eq $titlename
 370           or $head1_text_content =~ m/\($titlename_re\)/s
 371           # We accept "=head1 Nomen Modularis (NAME)" for sake of i18n
 372         ) {
 373           DEBUG and print "  Yup, it was $titlename.  Seeking next para-content...\n";
 374           ++$state;
 375         } elsif(
 376           $desperate_for_title
 377            # if we're so desperate we'll take the first
 378            #  =head1's content as a title
 379           and $head1_text_content =~ m/\S/
 380           and $head1_text_content !~ m/^[ A-Z]+$/s
 381           and $head1_text_content !~
 382             m/\((?:
 383              NAME | TITLE | VERSION | AUTHORS? | DESCRIPTION | SYNOPSIS
 384              | COPYRIGHT | LICENSE | NOTES? | FUNCTIONS? | METHODS?
 385              | CAVEATS? | BUGS? | SEE\ ALSO | SWITCHES | ENVIRONMENT
 386             )\)/sx
 387             # avoid accepting things like =head1 Thingy Thongy (DESCRIPTION)
 388           and ($max_content_length
 389             ? (length($head1_text_content) <= $max_content_length) # sanity
 390             : 1)
 391         ) {
 392           DEBUG and print "  It looks titular: \"$head1_text_content\".\n",
 393             "\n  Using that.\n";
 394           $title = $head1_text_content;
 395           last;
 396         } else {
 397           --$state;
 398           DEBUG and print "  Didn't look titular ($head1_text_content).\n",
 399             "\n  Dropping back to seeking-head1-content mode...\n";
 400         }
 401       }
 402     }
 403
 404     elsif($state == 2) {
 405       # seeking start of para (which must immediately follow)
 406       if($token->is_start and $content_containers{ $token->tagname }) {
 407         DEBUG and print "  Found start of Para.  Accumulating content...\n";
 408         $para_text_content = '';
 409         ++$state;
 410       } else {
 411         DEBUG and print
 412          "  Didn't see an immediately subsequent start-Para.  Reseeking H1\n";
 413         $state = 0;
 414       }
 415     }
 416
 417     elsif($state == 3) {
 418       # accumulating text until end of Para
 419       if( $token->is_text ) {
 420         DEBUG and print "   Adding \"", $token->text, "\" to para-content.\n";
 421         $para_text_content .= $token->text;
 422         # and keep looking
 423
 424       } elsif( $token->is_end and $content_containers{ $token->tagname } ) {
 425         DEBUG and print "  Found end of Para.  Considering content: ",
 426           $para_text_content, "\n";
 427
 428         if( $para_text_content =~ m/\S/
 429           and ($max_content_length
 430            ? (length($para_text_content) <= $max_content_length)
 431            : 1)
 432         ) {
 433           # Some minimal sanity constraints, I think.
 434           DEBUG and print "  It looks contentworthy, I guess.  Using it.\n";
 435           $title = $para_text_content;
 436           last;
 437         } else {
 438           DEBUG and print "  Doesn't look at all contentworthy!\n  Giving up.\n";
 439           undef $title;
 440           last;
 441         }
 442       }
 443     }
 444
 445     else {
 446       die "IMPOSSIBLE STATE $state!\n";  # should never happen
 447     }
 448
 449   }
 450
 451   # Put it all back!
 452   $self->unget_token(@to_unget);
 453
 454   if(DEBUG) {
 455     if(defined $title) { print "  Returing title <$title>\n" }
 456     else { print "Returning title <>\n" }
 457   }
 458
 459   return '' unless defined $title;
 460   $title =~ s/^\s+//;
 461   return $title;
 462 }
 463
 464 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 465 #
 466 #  Methods that actually do work at parse-time:
 467
 468 sub _handle_element_start {
 469   my $self = shift;   # leaving ($element_name, $attr_hash_r)
 470   DEBUG > 2 and print "++ $_[0] (", map("<$_> ", %{$_[1]}), ")\n";
 471
 472   push @{ $self->{'token_buffer'} },
 473        $self->{'start_token_class'}->new(@_);
 474   return;
 475 }
 476
 477 sub _handle_text {
 478   my $self = shift;   # leaving ($text)
 479   DEBUG > 2 and print "== $_[0]\n";
 480   push @{ $self->{'token_buffer'} },
 481        $self->{'text_token_class'}->new(@_);
 482   return;
 483 }
 484
 485 sub _handle_element_end {
 486   my $self = shift;   # leaving ($element_name);
 487   DEBUG > 2 and print "-- $_[0]\n";
 488   push @{ $self->{'token_buffer'} },
 489        $self->{'end_token_class'}->new(@_);
 490   return;
 491 }
 492
 493 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 494
 495 1;
 496
 497
 498 __END__
 499
 500 =head1 NAME
 501
 502 Pod::Simple::PullParser -- a pull-parser interface to parsing Pod
 503
 504 =head1 SYNOPSIS
 505
 506  my $parser = SomePodProcessor->new;
 507  $parser->set_source( "whatever.pod" );
 508  $parser->run;
 509
 510 Or:
 511
 512  my $parser = SomePodProcessor->new;
 513  $parser->set_source( $some_filehandle_object );
 514  $parser->run;
 515
 516 Or:
 517
 518  my $parser = SomePodProcessor->new;
 519  $parser->set_source( \$document_source );
 520  $parser->run;
 521
 522 Or:
 523
 524  my $parser = SomePodProcessor->new;
 525  $parser->set_source( \@document_lines );
 526  $parser->run;
 527
 528 And elsewhere:
 529
 530  require 5;
 531  package SomePodProcessor;
 532  use strict;
 533  use base qw(Pod::Simple::PullParser);
 534
 535  sub run {
 536    my $self = shift;
 537   Token:
 538    while(my $token = $self->get_token) {
 539      ...process each token...
 540    }
 541  }
 542
 543 =head1 DESCRIPTION
 544
 545 This class is for using Pod::Simple to build a Pod processor -- but
 546 one that uses an interface based on a stream of token objects,
 547 instead of based on events.
 548
 549 This is a subclass of L<Pod::Simple> and inherits all its methods.
 550
 551 A subclass of Pod::Simple::PullParser should define a C<run> method
 552 that calls C<< $token = $parser->get_token >> to pull tokens.
 553
 554 See the source for Pod::Simple::RTF for an example of a formatter
 555 that uses Pod::Simple::PullParser.
 556
 557 =head1 METHODS
 558
 559 =over
 560
 561 =item my $token = $parser->get_token
 562
 563 This returns the next token object (which will be of a subclass of
 564 L<Pod::Simple::PullParserToken>), or undef if the parser-stream has hit
 565 the end of the document.
 566
 567 =item $parser->unget_token( $token )
 568
 569 =item $parser->unget_token( $token1, $token2, ... )
 570
 571 This restores the token object(s) to the front of the parser stream.
 572
 573 =back
 574
 575 The source has to be set before you can parse anything.  The lowest-level
 576 way is to call C<set_source>:
 577
 578 =over
 579
 580 =item $parser->set_source( $filename )
 581
 582 =item $parser->set_source( $filehandle_object )
 583
 584 =item $parser->set_source( \$document_source )
 585
 586 =item $parser->set_source( \@document_lines )
 587
 588 =back
 589
 590 Or you can call these methods, which Pod::Simple::PullParser has defined
 591 to work just like Pod::Simple's same-named methods:
 592
 593 =over
 594
 595 =item $parser->parse_file(...)
 596
 597 =item $parser->parse_string_document(...)
 598
 599 =item $parser->filter(...)
 600
 601 =item $parser->parse_from_file(...)
 602
 603 =back
 604
 605 For those to work, the Pod-processing subclass of
 606 Pod::Simple::PullParser has to have defined a $parser->run method --
 607 so it is advised that all Pod::Simple::PullParser subclasses do so.
 608 See the Synopsis above, or the source for Pod::Simple::RTF.
 609
 610 Authors of formatter subclasses might find these methods useful to
 611 call on a parser object that you haven't started pulling tokens
 612 from yet:
 613
 614 =over
 615
 616 =item my $title_string = $parser->get_title
 617
 618 This tries to get the title string out of $parser, by getting some tokens,
 619 and scanning them for the title, and then ungetting them so that you can
 620 process the token-stream from the beginning.
 621
 622 For example, suppose you have a document that starts out:
 623
 624   =head1 NAME
 625
 626   Hoo::Boy::Wowza -- Stuff B<wow> yeah!
 627
 628 $parser->get_title on that document will return "Hoo::Boy::Wowza --
 629 Stuff wow yeah!".
 630
 631 In cases where get_title can't find the title, it will return empty-string
 632 ("").
 633
 634 =item my $title_string = $parser->get_short_title
 635
 636 This is just like get_title, except that it returns just the modulename, if
 637 the title seems to be of the form "SomeModuleName -- description".
 638
 639 For example, suppose you have a document that starts out:
 640
 641   =head1 NAME
 642
 643   Hoo::Boy::Wowza -- Stuff B<wow> yeah!
 644
 645 then $parser->get_short_title on that document will return
 646 "Hoo::Boy::Wowza".
 647
 648 But if the document starts out:
 649
 650   =head1 NAME
 651
 652   Hooboy, stuff B<wow> yeah!
 653
 654 then $parser->get_short_title on that document will return "Hooboy,
 655 stuff wow yeah!".
 656
 657 If the title can't be found, then get_short_title returns empty-string
 658 ("").
 659
 660 =item $author_name   = $parser->get_author
 661
 662 This works like get_title except that it returns the contents of the
 663 "=head1 AUTHOR\n\nParagraph...\n" section, assuming that that section
 664 isn't terribly long.
 665
 666 (This method tolerates "AUTHORS" instead of "AUTHOR" too.)
 667
 668 =item $description_name = $parser->get_description
 669
 670 This works like get_title except that it returns the contents of the
 671 "=head1 PARAGRAPH\n\nParagraph...\n" section, assuming that that section
 672 isn't terribly long.
 673
 674 =item $version_block = $parser->get_version
 675
 676 This works like get_title except that it returns the contents of
 677 the "=head1 VERSION\n\n[BIG BLOCK]\n" block.  Note that this does NOT
 678 return the module's C<$VERSION>!!
 679
 680
 681 =back
 682
 683 =head1 NOTE
 684
 685 You don't actually I<have> to define a C<run> method.  If you're
 686 writing a Pod-formatter class, you should define a C<run> just so
 687 that users can call C<parse_file> etc, but you don't I<have> to.
 688
 689 And if you're not writing a formatter class, but are instead just
 690 writing a program that does something simple with a Pod::PullParser
 691 object (and not an object of a subclass), then there's no reason to
 692 bother subclassing to add a C<run> method.
 693
 694 =head1 SEE ALSO
 695
 696 L<Pod::Simple>
 697
 698 L<Pod::Simple::PullParserToken> -- and its subclasses
 699 L<Pod::Simple::PullParserStartToken>,
 700 L<Pod::Simple::PullParserTextToken>, and
 701 L<Pod::Simple::PullParserEndToken>.
 702
 703 L<HTML::TokeParser>, which inspired this.
 704
 705 =head1 COPYRIGHT AND DISCLAIMERS
 706
 707 Copyright (c) 2002 Sean M. Burke.  All rights reserved.
 708
 709 This library is free software; you can redistribute it and/or modify it
 710 under the same terms as Perl itself.
 711
 712 This program is distributed in the hope that it will be useful, but
 713 without any warranty; without even the implied warranty of
 714 merchantability or fitness for a particular purpose.
 715
 716 =head1 AUTHOR
 717
 718 Sean M. Burke C<sburke@cpan.org>
 719
 720 =cut
 721
 722
 723
 724 JUNK:
 725
 726 sub _old_get_title {  # some witchery in here
 727   my $self = $_[0];
 728   my $title;
 729   my @to_unget;
 730
 731   while(1) {
 732     push @to_unget, $self->get_token;
 733     unless(defined $to_unget[-1]) { # whoops, short doc!
 734       pop @to_unget;
 735       last;
 736     }
 737
 738     DEBUG and print "-Got token ", $to_unget[-1]->dump, "\n";
 739
 740     (DEBUG and print "Too much in the buffer.\n"),
 741      last if @to_unget > 25; # sanity
 742
 743     my $pattern = '';
 744     if( #$to_unget[-1]->type eq 'end'
 745         #and $to_unget[-1]->tagname eq 'Para'
 746         #and
 747         ($pattern = join('',
 748          map {;
 749             ($_->type eq 'start') ? ("<" . $_->tagname .">")
 750           : ($_->type eq 'end'  ) ? ("</". $_->tagname .">")
 751           : ($_->type eq 'text' ) ? ($_->text =~ m<^([A-Z]+)$>s ? $1 : 'X')
 752           : "BLORP"
 753          } @to_unget
 754        )) =~ m{<head1>NAME</head1><Para>(X|</?[BCIFLS]>)+</Para>$}s
 755     ) {
 756       # Whee, it fits the pattern
 757       DEBUG and print "Seems to match =head1 NAME pattern.\n";
 758       $title = '';
 759       foreach my $t (reverse @to_unget) {
 760         last if $t->type eq 'start' and $t->tagname eq 'Para';
 761         $title = $t->text . $title if $t->type eq 'text';
 762       }
 763       undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
 764       last;
 765
 766     } elsif ($pattern =~ m{<head(\d)>(.+)</head\d>$}
 767       and !( $1 eq '1' and $2 eq 'NAME' )
 768     ) {
 769       # Well, it fits a fallback pattern
 770       DEBUG and print "Seems to match NAMEless pattern.\n";
 771       $title = '';
 772       foreach my $t (reverse @to_unget) {
 773         last if $t->type eq 'start' and $t->tagname =~ m/^head\d$/s;
 774         $title = $t->text . $title if $t->type eq 'text';
 775       }
 776       undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
 777       last;
 778
 779     } else {
 780       DEBUG and $pattern and print "Leading pattern: $pattern\n";
 781     }
 782   }
 783
 784   # Put it all back:
 785   $self->unget_token(@to_unget);
 786
 787   if(DEBUG) {
 788     if(defined $title) { print "  Returing title <$title>\n" }
 789     else { print "Returning title <>\n" }
 790   }
 791
 792   return '' unless defined $title;
 793   return $title;
 794 }
 795