| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |