home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / XML / PatAct / Amsterdam.pm < prev    next >
Encoding:
Text File  |  2003-10-21  |  5.4 KB  |  235 lines

  1. #
  2. # Copyright (C) 1999 Ken MacLeod
  3. # XML::PatAct::Amsterdam is free software; you can redistribute it and/or
  4. # modify it under the same terms as Perl itself.
  5. #
  6. # $Id: Amsterdam.pm,v 1.4 1999/12/22 21:15:00 kmacleod Exp $
  7. #
  8.  
  9. use strict;
  10.  
  11. use UNIVERSAL;
  12.  
  13. package XML::PatAct::Amsterdam;
  14.  
  15. use vars qw{ $VERSION };
  16.  
  17. # will be substituted by make-rel script
  18. $VERSION = "0.08";
  19.  
  20. sub new {
  21.     my $type = shift;
  22.     my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
  23.  
  24.     bless $self, $type;
  25.  
  26.     my $usage = <<'EOF';
  27. usage: XML::PatAct::Amsterdam->new( Matcher => $matcher,
  28.                  Patterns => $patterns );
  29. EOF
  30.  
  31.     die "No Matcher specified\n$usage\n"
  32.     if !defined $self->{Matcher};
  33.     die "No Patterns specified\n$usage\n"
  34.     if !defined $self->{Patterns};
  35.  
  36.     # perform additional initialization here
  37.  
  38.     return $self;
  39. }
  40.  
  41. sub start_document {
  42.     my ($self, $document) = @_;
  43.  
  44.     # initialize the pattern module at the start of a document
  45.     $self->{Matcher}->initialize($self);
  46.  
  47.     # create empty name and node lists for passing to `match()'
  48.     $self->{Names} = [ ];
  49.     $self->{Nodes} = [ ];
  50.  
  51.     $self->{ActionStack} = [ ];
  52.  
  53.     # create a temporary Output_ in case we're creating a standard
  54.     # output file that we'll delete later.
  55.     if (!$self->{AsString} && !defined($self->{Output})) {
  56.     require IO::File;
  57.     import IO::File;
  58.     $self->{Output_} = new IO::File(">-");
  59.     } elsif (defined($self->{Output})) {
  60.     $self->{Output_} = $self->{Output};
  61.     }
  62.  
  63.     if ($self->{AsString}) {
  64.     $self->{Strings} = [];
  65.     }
  66. }
  67.  
  68. sub end_document {
  69.     my ($self, $document) = @_;
  70.  
  71.     # notify the pattern module that we're done
  72.     $self->{Matcher}->finalize();
  73.  
  74.     if (defined($self->{Output_})) {
  75.     delete $self->{Output_};
  76.     }
  77.  
  78.     my $string = undef;
  79.     if (defined($self->{AsString})) {
  80.     $string = join('', @{$self->{Strings}});
  81.     delete $self->{Strings};
  82.     }
  83.  
  84.     # release all the info that is just used during event handling
  85.     $self->{Matcher} = $self->{Names} = $self->{Nodes} = undef;
  86.     $self->{ActionStack} = undef;
  87.  
  88.     return($string);
  89. }
  90.  
  91. sub start_element {
  92.     my ($self, $element) = @_;
  93.  
  94.     push @{$self->{Names}}, $element->{Name};
  95.     push @{$self->{Nodes}}, $element;
  96.  
  97.     my $index = $self->{Matcher}->match($element,
  98.                     $self->{Names},
  99.                     $self->{Nodes});
  100.  
  101.     my $action;
  102.     if (!defined $index) {
  103.     $action = undef;
  104.     } else {
  105.     $action = $self->{Patterns}[$index * 2 + 1];
  106.     }
  107.  
  108.     push @{$self->{ActionStack}}, $action;
  109.  
  110.     if (defined($action)) {
  111.     my $before = $action->{Before};
  112.     if (defined $before) {
  113.         my $atts = $element->{Attributes};
  114.         $before =~ s/\[([\w.:]+)\]/
  115.         ($1 eq '_element') ? $element->{Name} : $atts->{$1}
  116.         /eg;
  117.         $self->print($before);
  118.     }
  119.     }
  120. }
  121.  
  122. sub end_element {
  123.     my ($self, $end_element) = @_;
  124.  
  125.     my $name = pop @{$self->{Names}};
  126.     my $element = pop @{$self->{Nodes}};
  127.  
  128.     my $action = pop @{$self->{ActionStack}};
  129.  
  130.     if (defined($action)) {
  131.     my $after = $action->{After};
  132.     if (defined $after) {
  133.         my $atts = $element->{Attributes};
  134.         $after =~ s/\[([\w.:]+)\]/
  135.         ($1 eq '_element') ? $element->{Name} : $atts->{$1}
  136.         /eg;
  137.         $self->print($after);
  138.     }
  139.     }
  140. }
  141.  
  142. sub characters {
  143.     my ($self, $characters) = @_;
  144.  
  145.     $self->print($characters->{Data});
  146. }
  147.  
  148. sub print {
  149.     my ($self, $output) = @_;
  150.  
  151.     $self->{Output_}->print($output)
  152.     if (defined($self->{Output_}));
  153.  
  154.     push(@{$self->{Strings}}, $output)
  155.     if (defined($self->{AsString}));
  156. }
  157.  
  158. 1;
  159.  
  160. __END__
  161.  
  162. =head1 NAME
  163.  
  164. XML::PatAct::Amsterdam - An action module for simplistic style-sheets
  165.  
  166. =head1 SYNOPSIS
  167.  
  168.  use XML::PatAct::Amsterdam;
  169.  
  170.  my $patterns = [ PATTERN => { Before => 'before',
  171.                    After => 'after' },
  172.           ... ];
  173.  
  174.  my $matcher = XML::PatAct::Amsterdam->new( I<OPTIONS> );
  175.  
  176.  
  177. =head1 DESCRIPTION
  178.  
  179. XML::PatAct::Amsterdam is a PerlSAX handler for applying
  180. pattern-action lists to XML parses or trees.  XML::PatAct::Amsterdam
  181. applies a very simple style sheet to an instance and outputs the
  182. result.  Amsterdam gets it's name from the Amsterdam SGML Parser (ASP)
  183. which inspired this module.
  184.  
  185. CAUTION: Amsterdam is a very simple style module, you will run into
  186. it's limitations quickly with even moderately complex XML instances,
  187. be aware of and prepared to switch to more complete style modules.
  188.  
  189. New XML::PatAct::Amsterdam instances are creating by calling `new()'.
  190. Parameters can be passed as a list of key, value pairs or a hash.  A
  191. Patterns and Matcher options are required.  The following I<OPTIONS>
  192. are supported:
  193.  
  194. =over 4
  195.  
  196. =item Patterns
  197.  
  198. The pattern-action list to apply.  The list is an anonymous array of
  199. pattern, action pairs.  Each action in the list contains either or
  200. both a Before and an After string to copy to the output before and
  201. after processing an XML element.  The Before and After strings may
  202. contain attribute names enclosed in square brackets (`C<[>' I<NAME>
  203. `C<]>'), these are replaced with the value of the attribute with that
  204. name.  The special I<NAME> `C<_element>' will be replaced with the
  205. element's name.
  206.  
  207. =item Matcher
  208.  
  209. An instance of the pattern or query matching module.
  210.  
  211. =item Output
  212.  
  213. An IO::Handle or one of it's subclasses (such as IO::File), if this
  214. parameter is not present and the AsString option is not used, the
  215. module will write to standard output.
  216.  
  217. =item AsString
  218.  
  219. Return the generated output as a string from the `C<parse()>' method
  220. of the PerlSAX event generator.
  221.  
  222. =back
  223.  
  224. =head1 AUTHOR
  225.  
  226. Ken MacLeod, ken@bitsko.slc.ut.us
  227.  
  228. =head1 SEE ALSO
  229.  
  230. perl(1)
  231.  
  232. ``Using PatAct Modules'' and ``Creating PatAct Modules'' in libxml-perl.
  233.  
  234. =cut
  235.