lib/Pod/ParseUtils.pm

   1 #############################################################################
   2 # Pod/ParseUtils.pm -- helpers for POD parsing and conversion
   3 #
   4 # Copyright (C) 1999 by Marek Rouchal. All rights reserved.
   5 # This file is part of "PodParser". PodParser is free software;
   6 # you can redistribute it and/or modify it under the same terms
   7 # as Perl itself.
   8 #############################################################################
   9
  10 package Pod::ParseUtils;
  11
  12 use vars qw($VERSION);
  13 $VERSION = 0.2;    ## Current version of this package
  14 require  5.004;    ## requires this Perl version or later
  15
  16 =head1 NAME
  17
  18 Pod::ParseUtils - helpers for POD parsing and conversion
  19
  20 =head1 SYNOPSIS
  21
  22   use Pod::ParseUtils;
  23
  24   my $list = new Pod::List;
  25   my $link = Pod::Hyperlink->new('Pod::Parser');
  26
  27 =head1 DESCRIPTION
  28
  29 B<Pod::ParseUtils> contains a few object-oriented helper packages for
  30 POD parsing and processing (i.e. in POD formatters and translators).
  31
  32 =cut
  33
  34 #-----------------------------------------------------------------------------
  35 # Pod::List
  36 #
  37 # class to hold POD list info (=over, =item, =back)
  38 #-----------------------------------------------------------------------------
  39
  40 package Pod::List;
  41
  42 use Carp;
  43
  44 =head2 Pod::List
  45
  46 B<Pod::List> can be used to hold information about POD lists
  47 (written as =over ... =item ... =back) for further processing.
  48 The following methods are available:
  49
  50 =over 4
  51
  52 =item new()
  53
  54 Create a new list object. Properties may be specified through a hash
  55 reference like this:
  56
  57   my $list = Pod::List->new({ -start => $., -indent => 4 });
  58
  59 See the individual methods/properties for details.
  60
  61 =cut
  62
  63 sub new {
  64     my $this = shift;
  65     my $class = ref($this) || $this;
  66     my %params = @_;
  67     my $self = {%params};
  68     bless $self, $class;
  69     $self->initialize();
  70     return $self;
  71 }
  72
  73 sub initialize {
  74     my $self = shift;
  75     $self->{-file} ||= 'unknown';
  76     $self->{-start} ||= 'unknown';
  77     $self->{-indent} ||= 4; # perlpod: "should be the default"
  78     $self->{_items} = [];
  79     $self->{-type} ||= '';
  80 }
  81
  82 =item file()
  83
  84 Without argument, retrieves the file name the list is in. This must
  85 have been set before by either specifying B<-file> in the B<new()>
  86 method or by calling the B<file()> method with a scalar argument.
  87
  88 =cut
  89
  90 # The POD file name the list appears in
  91 sub file {
  92    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
  93 }
  94
  95 =item start()
  96
  97 Without argument, retrieves the line number where the list started.
  98 This must have been set before by either specifying B<-start> in the
  99 B<new()> method or by calling the B<start()> method with a scalar
 100 argument.
 101
 102 =cut
 103
 104 # The line in the file the node appears
 105 sub start {
 106    return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
 107 }
 108
 109 =item indent()
 110
 111 Without argument, retrieves the indent level of the list as specified
 112 in C<=over n>. This must have been set before by either specifying
 113 B<-indent> in the B<new()> method or by calling the B<indent()> method
 114 with a scalar argument.
 115
 116 =cut
 117
 118 # indent level
 119 sub indent {
 120    return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
 121 }
 122
 123 =item type()
 124
 125 Without argument, retrieves the list type, which can be an arbitrary value,
 126 e.g. C<OL>, C<UL>, ... when thinking the HTML way.
 127 This must have been set before by either specifying
 128 B<-type> in the B<new()> method or by calling the B<type()> method
 129 with a scalar argument.
 130
 131 =cut
 132
 133 # The type of the list (UL, OL, ...)
 134 sub type {
 135    return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
 136 }
 137
 138 =item rx()
 139
 140 Without argument, retrieves a regular expression for simplifying the
 141 individual item strings once the list type has been determined. Usage:
 142 E.g. when converting to HTML, one might strip the leading number in
 143 an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
 144 This must have been set before by either specifying
 145 B<-rx> in the B<new()> method or by calling the B<rx()> method
 146 with a scalar argument.
 147
 148 =cut
 149
 150 # The regular expression to simplify the items
 151 sub rx {
 152    return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
 153 }
 154
 155 =item item()
 156
 157 Without argument, retrieves the array of the items in this list.
 158 The items may be represented by any scalar.
 159 If an argument has been given, it is pushed on the list of items.
 160
 161 =cut
 162
 163 # The individual =items of this list
 164 sub item {
 165     my ($self,$item) = @_;
 166     if(defined $item) {
 167         push(@{$self->{_items}}, $item);
 168         return $item;
 169     }
 170     else {
 171         return @{$self->{_items}};
 172     }
 173 }
 174
 175 =item parent()
 176
 177 Without argument, retrieves information about the parent holding this
 178 list, which is represented as an arbitrary scalar.
 179 This must have been set before by either specifying
 180 B<-parent> in the B<new()> method or by calling the B<parent()> method
 181 with a scalar argument.
 182
 183 =cut
 184
 185 # possibility for parsers/translators to store information about the
 186 # lists's parent object
 187 sub parent {
 188    return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
 189 }
 190
 191 =item tag()
 192
 193 Without argument, retrieves information about the list tag, which can be
 194 any scalar.
 195 This must have been set before by either specifying
 196 B<-tag> in the B<new()> method or by calling the B<tag()> method
 197 with a scalar argument.
 198
 199 =back
 200
 201 =cut
 202
 203 # possibility for parsers/translators to store information about the
 204 # list's object
 205 sub tag {
 206    return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
 207 }
 208
 209 #-----------------------------------------------------------------------------
 210 # Pod::Hyperlink
 211 #
 212 # class to manipulate POD hyperlinks (L<>)
 213 #-----------------------------------------------------------------------------
 214
 215 package Pod::Hyperlink;
 216
 217 =head2 Pod::Hyperlink
 218
 219 B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
 220
 221   my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
 222
 223 The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
 224 C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
 225 different parts of a POD hyperlink for further processing. It can also be
 226 used to construct hyperlinks.
 227
 228 =over 4
 229
 230 =item new()
 231
 232 The B<new()> method can either be passed a set of key/value pairs or a single
 233 scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
 234 of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
 235 failure, the error message is stored in C<$@>.
 236
 237 =cut
 238
 239 use Carp;
 240
 241 sub new {
 242     my $this = shift;
 243     my $class = ref($this) || $this;
 244     my $self = +{};
 245     bless $self, $class;
 246     $self->initialize();
 247     if(defined $_[0]) {
 248         if(ref($_[0])) {
 249             # called with a list of parameters
 250             %$self = %{$_[0]};
 251             $self->_construct_text();
 252         }
 253         else {
 254             # called with L<> contents
 255             return undef unless($self->parse($_[0]));
 256         }
 257     }
 258     return $self;
 259 }
 260
 261 sub initialize {
 262     my $self = shift;
 263     $self->{-line} ||= 'undef';
 264     $self->{-file} ||= 'undef';
 265     $self->{-page} ||= '';
 266     $self->{-node} ||= '';
 267     $self->{-alttext} ||= '';
 268     $self->{-type} ||= 'undef';
 269     $self->{_warnings} = [];
 270 }
 271
 272 =item parse($string)
 273
 274 This method can be used to (re)parse a (new) hyperlink, i.e. the contents
 275 of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
 276
 277 =cut
 278
 279 sub parse {
 280     my $self = shift;
 281     local($_) = $_[0];
 282     # syntax check the link and extract destination
 283     my ($alttext,$page,$node,$type) = ('','','','');
 284
 285     $self->{_warnings} = [];
 286
 287     # collapse newlines with whitespace
 288     if(s/\s*\n+\s*/ /g) {
 289         $self->warning("collapsing newlines to blanks");
 290     }
 291     # strip leading/trailing whitespace
 292     if(s/^[\s\n]+//) {
 293         $self->warning("ignoring leading whitespace in link");
 294     }
 295     if(s/[\s\n]+$//) {
 296         $self->warning("ignoring trailing whitespace in link");
 297     }
 298     unless(length($_)) {
 299         _invalid_link("empty link");
 300         return undef;
 301     }
 302
 303     ## Check for different possibilities. This is tedious and error-prone
 304     # we match all possibilities (alttext, page, section/item)
 305     #warn "DEBUG: link=$_\n";
 306
 307     # only page
 308     if(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) {
 309         $page = $1 . $2;
 310         $type = 'page';
 311     }
 312     # alttext, page and section
 313     elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) {
 314         ($alttext, $page, $node) = ($1, $2 . $3, $4);
 315         $type = 'section';
 316     }
 317     # page and section
 318     elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*"(.+)"$!) {
 319         ($page, $node) = ($1 . $2, $3);
 320         $type = 'section';
 321     }
 322     # page and item
 323     elsif(m!^(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) {
 324         ($page, $node) = ($1 . $2, $3);
 325         $type = 'item';
 326     }
 327     # only section
 328     elsif(m!^(?:/\s*|)"(.+)"$!) {
 329         $node = $1;
 330         $type = 'section';
 331     }
 332     # only item
 333     elsif(m!^/(.+)$!) {
 334         $node = $1;
 335         $type = 'item';
 336     }
 337     # non-standard: Hyperlink
 338     elsif(m!^((?:http|ftp|mailto|news):.+)$!i) {
 339         $node = $1;
 340         $type = 'hyperlink';
 341     }
 342     # alttext, page and item
 343     elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)\s*/\s*(.+)$!) {
 344         ($alttext, $page, $node) = ($1, $2 . $3, $4);
 345         $type = 'item';
 346     }
 347     # alttext and page
 348     elsif(m!^(.+?)\s*[|]\s*(\w+(?:::\w+)*)\s*(\(\w*\)|)$!) {
 349         ($alttext, $page) = ($1, $2 . $3);
 350         $type = 'page';
 351     }
 352     # alttext and section
 353     elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
 354         ($alttext, $node) = ($1,$2);
 355         $type = 'section';
 356     }
 357     # alttext and item
 358     elsif(m!^(.+?)\s*[|]\s*/(.+)$!) {
 359         ($alttext, $node) = ($1,$2);
 360     }
 361     # nonstandard: alttext and hyperlink
 362     elsif(m!^(.+?)\s*[|]\s*((?:http|ftp|mailto|news):.+)$!) {
 363         ($alttext, $node) = ($1,$2);
 364         $type = 'hyperlink';
 365     }
 366     # must be an item or a "malformed" section (without "")
 367     else {
 368         $node = $_;
 369         $type = 'item';
 370     }
 371
 372     if($page =~ /[(]\w*[)]$/) {
 373         $self->warning("section in `$page' deprecated");
 374     }
 375     $self->{-page} = $page;
 376     $self->{-node} = $node;
 377     $self->{-alttext} = $alttext;
 378     #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
 379     $self->{-type} = $type;
 380     $self->_construct_text();
 381     1;
 382 }
 383
 384 sub _construct_text {
 385     my $self = shift;
 386     my $alttext = $self->alttext();
 387     my $type = $self->type();
 388     my $section = $self->node();
 389     my $page = $self->page();
 390     my $page_ext = '';
 391     $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
 392     if($alttext) {
 393         $self->{_text} = $alttext;
 394     }
 395     elsif($type eq 'hyperlink') {
 396         $self->{_text} = $section;
 397     }
 398     else {
 399         $self->{_text} = (!$section ? '' :
 400             $type eq 'item' ? "the $section entry" :
 401                 "the section on $section" ) .
 402             ($page ? ($section ? ' in ':'') . "the $page$page_ext manpage" :
 403                 ' elsewhere in this document');
 404     }
 405     # for being marked up later
 406     # use the non-standard markers P<> and Q<>, so that the resulting
 407     # text can be parsed by the translators. It's their job to put
 408     # the correct hypertext around the linktext
 409     if($alttext) {
 410         $self->{_markup} = "Q<$alttext>";
 411     }
 412     elsif($type eq 'hyperlink') {
 413         $self->{_markup} = "Q<$section>";
 414     }
 415     else {
 416         $self->{_markup} = (!$section ? '' :
 417             $type eq 'item' ? "the Q<$section> entry" :
 418                 "the section on Q<$section>" ) .
 419             ($page ? ($section ? ' in ':'') . "the P<$page>$page_ext manpage" :
 420                 ' elsewhere in this document');
 421     }
 422 }
 423
 424 =item markup($string)
 425
 426 Set/retrieve the textual value of the link. This string contains special
 427 markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
 428 translator's interior sequence expansion engine to the
 429 formatter-specific code to highlight/activate the hyperlink. The details
 430 have to be implemented in the translator.
 431
 432 =cut
 433
 434 #' retrieve/set markuped text
 435 sub markup {
 436     return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
 437 }
 438
 439 =item text()
 440
 441 This method returns the textual representation of the hyperlink as above,
 442 but without markers (read only). Depending on the link type this is one of
 443 the following alternatives (the + and * denote the portions of the text
 444 that are marked up):
 445
 446   the +perl+ manpage
 447   the *$|* entry in the +perlvar+ manpage
 448   the section on *OPTIONS* in the +perldoc+ manpage
 449   the section on *DESCRIPTION* elsewhere in this document
 450
 451 =cut
 452
 453 # The complete link's text
 454 sub text {
 455     $_[0]->{_text};
 456 }
 457
 458 =item warning()
 459
 460 After parsing, this method returns any warnings encountered during the
 461 parsing process.
 462
 463 =cut
 464
 465 # Set/retrieve warnings
 466 sub warning {
 467     my $self = shift;
 468     if(@_) {
 469         push(@{$self->{_warnings}}, @_);
 470         return @_;
 471     }
 472     return @{$self->{_warnings}};
 473 }
 474
 475 =item line(), file()
 476
 477 Just simple slots for storing information about the line and the file
 478 the link was encountered in. Has to be filled in manually.
 479
 480 =cut
 481
 482 # The line in the file the link appears
 483 sub line {
 484     return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
 485 }
 486
 487 # The POD file name the link appears in
 488 sub file {
 489     return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
 490 }
 491
 492 =item page()
 493
 494 This method sets or returns the POD page this link points to.
 495
 496 =cut
 497
 498 # The POD page the link appears on
 499 sub page {
 500     if (@_ > 1) {
 501         $_[0]->{-page} = $_[1];
 502         $_[0]->_construct_text();
 503     }
 504     $_[0]->{-page};
 505 }
 506
 507 =item node()
 508
 509 As above, but the destination node text of the link.
 510
 511 =cut
 512
 513 # The link destination
 514 sub node {
 515     if (@_ > 1) {
 516         $_[0]->{-node} = $_[1];
 517         $_[0]->_construct_text();
 518     }
 519     $_[0]->{-node};
 520 }
 521
 522 =item alttext()
 523
 524 Sets or returns an alternative text specified in the link.
 525
 526 =cut
 527
 528 # Potential alternative text
 529 sub alttext {
 530     if (@_ > 1) {
 531         $_[0]->{-alttext} = $_[1];
 532         $_[0]->_construct_text();
 533     }
 534     $_[0]->{-alttext};
 535 }
 536
 537 =item type()
 538
 539 The node type, either C<section> or C<item>. As an unofficial type,
 540 there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
 541
 542 =cut
 543
 544 # The type: item or headn
 545 sub type {
 546     return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
 547 }
 548
 549 =item link()
 550
 551 Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
 552
 553 =back
 554
 555 =cut
 556
 557 # The link itself
 558 sub link {
 559     my $self = shift;
 560     my $link = $self->page() || '';
 561     if($self->node()) {
 562         if($self->type() eq 'section') {
 563             $link .= ($link ? '/' : '') . '"' . $self->node() . '"';
 564         }
 565         elsif($self->type() eq 'hyperlink') {
 566             $link = $self->node();
 567         }
 568         else { # item
 569             $link .= '/' . $self->node();
 570         }
 571     }
 572     if($self->alttext()) {
 573         $link = $self->alttext() . '|' . $link;
 574     }
 575     $link;
 576 }
 577
 578 sub _invalid_link {
 579     my ($msg) = @_;
 580     # this sets @_
 581     #eval { die "$msg\n" };
 582     #chomp $@;
 583     $@ = $msg; # this seems to work, too!
 584     undef;
 585 }
 586
 587 #-----------------------------------------------------------------------------
 588 # Pod::Cache
 589 #
 590 # class to hold POD page details
 591 #-----------------------------------------------------------------------------
 592
 593 package Pod::Cache;
 594
 595 =head2 Pod::Cache
 596
 597 B<Pod::Cache> holds information about a set of POD documents,
 598 especially the nodes for hyperlinks.
 599 The following methods are available:
 600
 601 =over 4
 602
 603 =item new()
 604
 605 Create a new cache object. This object can hold an arbitrary number of
 606 POD documents of class Pod::Cache::Item.
 607
 608 =cut
 609
 610 sub new {
 611     my $this = shift;
 612     my $class = ref($this) || $this;
 613     my $self = [];
 614     bless $self, $class;
 615     return $self;
 616 }
 617
 618 =item item()
 619
 620 Add a new item to the cache. Without arguments, this method returns a
 621 list of all cache elements.
 622
 623 =cut
 624
 625 sub item {
 626     my ($self,%param) = @_;
 627     if(%param) {
 628         my $item = Pod::Cache::Item->new(%param);
 629         push(@$self, $item);
 630         return $item;
 631     }
 632     else {
 633         return @{$self};
 634     }
 635 }
 636
 637 =item find_page($name)
 638
 639 Look for a POD document named C<$name> in the cache. Returns the
 640 reference to the corresponding Pod::Cache::Item object or undef if
 641 not found.
 642
 643 =back
 644
 645 =cut
 646
 647 sub find_page {
 648     my ($self,$page) = @_;
 649     foreach(@$self) {
 650         if($_->page() eq $page) {
 651             return $_;
 652         }
 653     }
 654     undef;
 655 }
 656
 657 package Pod::Cache::Item;
 658
 659 =head2 Pod::Cache::Item
 660
 661 B<Pod::Cache::Item> holds information about individual POD documents,
 662 that can be grouped in a Pod::Cache object.
 663 It is intended to hold information about the hyperlink nodes of POD
 664 documents.
 665 The following methods are available:
 666
 667 =over 4
 668
 669 =item new()
 670
 671 Create a new object.
 672
 673 =cut
 674
 675 sub new {
 676     my $this = shift;
 677     my $class = ref($this) || $this;
 678     my %params = @_;
 679     my $self = {%params};
 680     bless $self, $class;
 681     $self->initialize();
 682     return $self;
 683 }
 684
 685 sub initialize {
 686     my $self = shift;
 687     $self->{-nodes} = [] unless(defined $self->{-nodes});
 688 }
 689
 690 =item page()
 691
 692 Set/retrieve the POD document name (e.g. "Pod::Parser").
 693
 694 =cut
 695
 696 # The POD page
 697 sub page {
 698    return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
 699 }
 700
 701 =item description()
 702
 703 Set/retrieve the POD short description as found in the C<=head1 NAME>
 704 section.
 705
 706 =cut
 707
 708 # The POD description, taken out of NAME if present
 709 sub description {
 710    return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
 711 }
 712
 713 =item path()
 714
 715 Set/retrieve the POD file storage path.
 716
 717 =cut
 718
 719 # The file path
 720 sub path {
 721    return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
 722 }
 723
 724 =item file()
 725
 726 Set/retrieve the POD file name.
 727
 728 =cut
 729
 730 # The POD file name
 731 sub file {
 732    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
 733 }
 734
 735 =item nodes()
 736
 737 Add a node (or a list of nodes) to the document's node list. Note that
 738 the order is kept, i.e. start with the first node and end with the last.
 739 If no argument is given, the current list of nodes is returned in the
 740 same order the nodes have been added.
 741 A node can be any scalar, but usually is a pair of node string and
 742 unique id for the C<find_node> method to work correctly.
 743
 744 =cut
 745
 746 # The POD nodes
 747 sub nodes {
 748     my ($self,@nodes) = @_;
 749     if(@nodes) {
 750         push(@{$self->{-nodes}}, @nodes);
 751         return @nodes;
 752     }
 753     else {
 754         return @{$self->{-nodes}};
 755     }
 756 }
 757
 758 =item find_node($name)
 759
 760 Look for a node named C<$name> in the object's node list. Returns the
 761 unique id of the node (i.e. the second element of the array stored in
 762 the node arry) or undef if not found.
 763
 764 =back
 765
 766 =cut
 767
 768 sub find_node {
 769     my ($self,$node) = @_;
 770     foreach(@{$self->{-nodes}}) {
 771         if($_->[0] eq $node) {
 772             return $_->[1]; # id
 773         }
 774     }
 775     undef;
 776 }
 777
 778
 779 =head1 AUTHOR
 780
 781 Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing
 782 a lot of things from L<pod2man> and L<pod2roff> as well as other POD
 783 processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.
 784
 785 =head1 SEE ALSO
 786
 787 L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
 788 L<pod2html>
 789
 790 =cut
 791
 792 1;