Learning Perl

Learning Perl Programming ##

##

  
    Learning Perl
    Programming,Learning,Perl
  

##

##

use warnings;
use strict;

use XML::SAX::Machines qw(Pipeline);

my $m = Pipeline(
  'XML::Filter::BufferText' =>
  'XML::Filter::Category'   =>
  \*STDOUT
);

$m->parse_file( *DATA );

package XML::Filter::Category;
use base qw(XML::SAX::Base);

# 
# $el->{Name} == 'marker'
# $el->{Attributes}{'{}language'} == language attribute
# $el->{Attributes}{'{}language'}{Value} == 'foo'

sub start_element {
  my($self, $el) = @_;
  if ( $el->{Name} eq 'title' ) {
    $self->{record}{title}{start_element} = $el;
    $self->{in_title} = 1;
  } elsif ( $el->{Name} eq 'category' ) {
    $self->{record}{category}{start_element} = $el;
    $self->{in_category} = 1;
  } else { # go ahead and forward upstream
    $self->SUPER::start_element( $el );
  }
}

sub characters {
  my ($self, $chars) = @_;
  if ( $self->{in_title} ) {
    $self->{record}{title}{characters} = $chars;
  } elsif ( $self->{in_category} ) {
    $self->{record}{category}{characters} = $chars;
  } else { # go ahead and forward upstream
    $self->SUPER::characters( $chars );
  }
}

sub end_element {
  my($self, $el) = @_;

  if ( $el->{Name} eq 'title' ) {
    $self->{record}{title}{end_element} = $el;
    $self->{in_title} = 0;
  } elsif ( $el->{Name} eq 'category' ) {
    $self->{record}{category}{end_element} = $el;
    $self->{in_category} = 0;
  } elsif ( $el->{Name} eq 'record' ) { # transform category
    my $r = $self->{record};

    my @extra_cats = split(' ', $r->{title}{characters}{Data});
    $r->{category}{characters}{Data} .= ',' . join(',', @extra_cats);

    while( my( $node, $data ) = each( %{$self->{record}} ) ) {
      $self->SUPER::start_element( $data->{start_element} );
      $self->SUPER::characters( $data->{characters} );
      $self->SUPER::end_element( $data->{end_element} );
    }

    $self->SUPER::end_element( $el );
  } else { # go ahead and forward upstream
    $self->SUPER::end_element( $el );
  }
}

package main;

__DATA__

  
    Learning Perl
    Programming
    O'Reilly
    http://www.oreilly.com/catalog/learnperl4/
  
  
    O'Reilly
    Programming
    Learning Ruby
    http://www.oreilly.com/catalog/9780596529864/index.html
  
  
    Learning Python
    O'Reilly
    Programming
    http://www.oreilly.com/catalog/lpython2/index.html
  


##

##

$ perl modify_category.pl


  
    O'Reilly
    http://www.oreilly.com/catalog/learnperl4/
    Programming,Learning,Perl
    Learning Perl
  
    O'Reilly
    http://www.oreilly.com/catalog/9780596529864/index.html
    Programming,Learning,Ruby
    Learning Ruby
  
    O'Reilly
    http://www.oreilly.com/catalog/lpython2/index.html
    Programming,Learning,Python
    Learning Python