home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Nodes.pm < prev    next >
Encoding:
Perl POD Document  |  2002-01-31  |  6.9 KB  |  301 lines
  1. #============================================================= -*-Perl-*-
  2. #
  3. # Pod::POM::Nodes
  4. #
  5. # DESCRIPTION
  6. #   Module implementing specific nodes in a Pod::POM, subclassed from
  7. #   Pod::POM::Node.
  8. #
  9. # AUTHOR
  10. #   Andy Wardley   <abw@kfs.org>
  11. #
  12. # COPYRIGHT
  13. #   Copyright (C) 2000, 2001 Andy Wardley.  All Rights Reserved.
  14. #
  15. #   This module is free software; you can redistribute it and/or
  16. #   modify it under the same terms as Perl itself.
  17. #
  18. # REVISION
  19. #   $Id: Nodes.pm,v 1.2 2002/01/31 09:04:40 abw Exp $
  20. #
  21. #========================================================================
  22.  
  23. package Pod::POM::Nodes;
  24.  
  25. require 5.004;
  26. require Exporter;
  27.  
  28. use strict;
  29. use Pod::POM::Node;
  30. use vars qw( $VERSION $DEBUG $ERROR @EXPORT_OK @EXPORT_FAIL );
  31. use base qw( Exporter );
  32.  
  33. $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  34. $DEBUG   = 0 unless defined $DEBUG;
  35.  
  36.  
  37. #------------------------------------------------------------------------
  38. package Pod::POM::Node::Pod;
  39. use base qw( Pod::POM::Node );
  40. use vars qw( @ACCEPT $ERROR );
  41.  
  42. @ACCEPT = qw( head1 head2 head3 head4 over begin for text verbatim code );
  43.  
  44.  
  45. #------------------------------------------------------------------------
  46. package Pod::POM::Node::Head1;
  47. use base qw( Pod::POM::Node );
  48. use vars qw( %ATTRIBS @ACCEPT $ERROR );
  49.  
  50. %ATTRIBS =   ( title => undef );
  51. @ACCEPT  = qw( head2 head3 head4 over begin for text verbatim code );
  52.  
  53. sub new {
  54.     my ($class, $pom, $title) = @_;
  55.     $title = $pom->parse_sequence($title)
  56.     || return $class->error($pom->error())
  57.         if length $title;
  58.     $class->SUPER::new($pom, $title);
  59. }
  60.  
  61.  
  62. #------------------------------------------------------------------------
  63. package Pod::POM::Node::Head2;
  64. use base qw( Pod::POM::Node );
  65. use vars qw( %ATTRIBS @ACCEPT $ERROR );
  66.  
  67. %ATTRIBS =   ( title => undef );
  68. @ACCEPT  = qw( head3 head4 over begin for text verbatim code );
  69.  
  70. sub new {
  71.     my ($class, $pom, $title) = @_;
  72.     $title = $pom->parse_sequence($title)
  73.     || return $class->error($pom->error())
  74.         if length $title;
  75.     $class->SUPER::new($pom, $title);
  76. }
  77.  
  78.  
  79. #------------------------------------------------------------------------
  80. package Pod::POM::Node::Head3;
  81. use base qw( Pod::POM::Node );
  82. use vars qw( %ATTRIBS @ACCEPT $ERROR );
  83.  
  84. %ATTRIBS =   ( title => undef );
  85. @ACCEPT  = qw( head4 over begin for text verbatim code );
  86.  
  87. sub new {
  88.     my ($class, $pom, $title) = @_;
  89.     $title = $pom->parse_sequence($title)
  90.     || return $class->error($pom->error())
  91.         if length $title;
  92.     $class->SUPER::new($pom, $title);
  93. }
  94.  
  95.  
  96. #------------------------------------------------------------------------
  97. package Pod::POM::Node::Head4;
  98. use base qw( Pod::POM::Node );
  99. use vars qw( %ATTRIBS @ACCEPT $ERROR );
  100.  
  101. %ATTRIBS =   ( title => undef );
  102. @ACCEPT  = qw( over begin for text verbatim code );
  103.  
  104. sub new {
  105.     my ($class, $pom, $title) = @_;
  106.     $title = $pom->parse_sequence($title)
  107.     || return $class->error($pom->error())
  108.         if length $title;
  109.     $class->SUPER::new($pom, $title);
  110. }
  111.  
  112.  
  113. #------------------------------------------------------------------------
  114. package Pod::POM::Node::Over;
  115. use base qw( Pod::POM::Node );
  116. use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR );
  117.  
  118. %ATTRIBS =   ( indent => 4 );
  119. @ACCEPT  = qw( over item begin for text verbatim code );
  120. $EXPECT  = 'back';
  121.  
  122.  
  123. #------------------------------------------------------------------------
  124. package Pod::POM::Node::Item;
  125. use base qw( Pod::POM::Node );
  126. use vars qw( %ATTRIBS @ACCEPT $ERROR );
  127.  
  128. %ATTRIBS =   ( title => '*' );
  129. @ACCEPT  = qw( over begin for text verbatim code );
  130.  
  131. sub new {
  132.     my ($class, $pom, $title) = @_;
  133.     $title = $pom->parse_sequence($title)
  134.     || return $class->error($pom->error())
  135.         if length $title;
  136.     $class->SUPER::new($pom, $title);
  137. }
  138.  
  139.  
  140. #------------------------------------------------------------------------
  141. package Pod::POM::Node::Begin;
  142. use base qw( Pod::POM::Node );
  143. use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR );
  144.  
  145. %ATTRIBS =   ( format => undef );
  146. @ACCEPT  = qw( text verbatim code );
  147. $EXPECT  = 'end';
  148.  
  149.  
  150. #------------------------------------------------------------------------
  151. package Pod::POM::Node::For;
  152. use base qw( Pod::POM::Node );
  153. use vars qw( %ATTRIBS $ERROR );
  154.  
  155. %ATTRIBS = ( format => undef, text => '' );
  156.  
  157. sub new {
  158.     my $class = shift;
  159.     my $pom   = shift;
  160.     my $text  = shift;
  161.     $class->SUPER::new($pom, split(/\s+/, $text, 2));
  162. }
  163.  
  164.  
  165. #------------------------------------------------------------------------
  166. package Pod::POM::Node::Verbatim;
  167. use base qw( Pod::POM::Node );
  168. use vars qw( %ATTRIBS $ERROR );
  169.  
  170. %ATTRIBS = ( text => '' );
  171.  
  172. sub present {
  173.     my ($self, $view) = @_;
  174.     $view ||= $Pod::POM::DEFAULT_VIEW;
  175.     $view->view_verbatim($self->{ text });
  176. }
  177.  
  178.  
  179. #------------------------------------------------------------------------
  180. package Pod::POM::Node::Code;
  181. use base qw( Pod::POM::Node );
  182. use vars qw( %ATTRIBS $ERROR );
  183.  
  184. %ATTRIBS = ( text => '' );
  185.  
  186. sub present {
  187.     my ($self, $view) = @_;
  188.     $view ||= $Pod::POM::DEFAULT_VIEW;
  189.     $view->view_code($self->{ text });
  190. }
  191.  
  192.  
  193. #------------------------------------------------------------------------
  194. package Pod::POM::Node::Text;
  195. use Pod::POM::Constants qw( :all );
  196. use base qw( Pod::POM::Node );
  197. use vars qw( %ATTRIBS $ERROR );
  198.  
  199. %ATTRIBS = ( text => '' );
  200.  
  201. sub new {
  202.     my $class = shift;
  203.     my $pom   = shift;
  204.     my $text  = shift;
  205.     $text = $pom->parse_sequence($text)
  206.     || return $class->error($pom->error())
  207.         if length $text;
  208.     $class->SUPER::new($pom, $text);
  209. }
  210.  
  211. sub add {
  212.     return IGNORE;
  213. }
  214.  
  215. sub present {
  216.     my ($self, $view) = @_;
  217.     my $text = $self->{ text };
  218.     $view ||= $Pod::POM::DEFAULT_VIEW;
  219.  
  220.     $text = $text->present($view) 
  221.     if ref $text && length $text;
  222.  
  223.     $view->view_textblock($text);
  224. }
  225.  
  226.  
  227. #------------------------------------------------------------------------
  228. package Pod::POM::Node::Sequence;
  229.  
  230. use Pod::POM::Constants qw( :all );
  231. use base qw( Pod::POM::Node );
  232. use vars qw( %NAME );
  233.  
  234. %NAME = (
  235.     C => 'code',
  236.     B => 'bold',
  237.     I => 'italic',
  238.     L => 'link',
  239.     S => 'space',
  240.     F => 'file',
  241.     X => 'index',
  242.     Z => 'zero',
  243.     E => 'entity',
  244. );
  245.     
  246. sub new {
  247.     my ($class, $self) = @_;
  248.     local $" = '][';
  249.     bless \$self, $class;
  250. }
  251.  
  252. sub add {
  253.     return IGNORE;
  254. }
  255.  
  256. sub present {
  257.     my ($self, $view) = @_;
  258.     my ($cmd, $method, $result);
  259.     $view ||= $Pod::POM::DEFAULT_VIEW;
  260.  
  261.     if (ref $$self eq 'ARRAY') {
  262.     $self = $$self;
  263.     my $text = join('', 
  264.             map { ref $_ ? $_->present($view) 
  265.                      : $view->view_seq_text($_) } 
  266.             @{ $self->[CONTENT] });
  267.  
  268.     if ($cmd = $self->[CMD]) {
  269.         my $method = $NAME{ $cmd } || $cmd;
  270.         $method = "view_seq_$method";
  271.         return $view->$method($text);
  272.     }
  273.     else {
  274.         return $text;
  275.     }
  276.     }
  277.     return $$self;
  278. }
  279.  
  280.  
  281. #------------------------------------------------------------------------
  282. package Pod::POM::Node::Content;
  283.  
  284. use Pod::POM::Constants qw( :all );
  285. use base qw( Pod::POM::Node );
  286.  
  287. sub new {
  288.     my $class = shift;
  289.     bless [ @_ ], $class;
  290. }
  291.  
  292. sub present {
  293.     my ($self, $view) = @_;
  294.     $view ||= $Pod::POM::DEFAULT_VIEW;
  295.     join('', map { ref $_ ? $_->present($view) : $_ } @$self);
  296. }
  297.  
  298.  
  299. 1;
  300.  
  301.