WebService::Lucene::XOXOParser - Simple XOXO Parser

WebService-Lucene documentation Contained in the WebService-Lucene distribution.

Index

Code Index:

NAME

Top

WebService::Lucene::XOXOParser - Simple XOXO Parser

SYNOPSIS

Top

    use WebService::Lucene::XOXOParser;

    my $parser     = WebService::Lucene::XOXOParser->new;
    my @properties = $parser->parse( $xml );

DESCRIPTION

Top

This module provides simple XOXO parsing for Lucene documents.

METHODS

Top

new( )

Creates a new parser instance.

parse( $xml )

Parses XML and returns an array of hashrefs decribing each property.

construct( @properties )

Takes an array of properties and constructs an XOXO XML structure.

encode_entities( $value )

Escapes some chars to their entities.

dl

Shortcut to create a definition list

dt

Shortcut to create a definition term

dd

Shortcut to create a definition description

AUTHORS

Top

* Brian Cassidy <brian.cassidy@nald.ca>
* Adam Paynter <adam.paynter@nald.ca>

COPYRIGHT AND LICENSE

Top

Copyright 2006-2009 National Adult Literacy Database

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

WebService-Lucene documentation Contained in the WebService-Lucene distribution. 
package WebService::Lucene::XOXOParser;

use strict;
use warnings;

use XML::LibXML;

BEGIN {
    for my $name ( qw( dl dd dt ) ) {
        no strict 'refs';
        *$name = sub { _make_element( $name, @_ ) }
    }
}

my %pattern_lut = (
    '&' => 'amp',
    '<' => 'lt',
    '>' => 'gt',
    '"' => 'quot',
    "'" => 'apos',
);
my $pattern = join( '|', keys %pattern_lut );


sub new {
    my ( $class ) = @_;
    return bless {}, $class;
}


sub parse {
    my ( $self, $xml ) = @_;

    my $parser = XML::LibXML->new;
    my $root   = $parser->parse_string( $xml )->documentElement;
    my @nodes  = $root->findnodes( '//dt | //dd' );

    my @properties;
    while ( @nodes ) {
        my ( $term, $value ) = ( shift( @nodes ), shift( @nodes ) );

        my $property = {
            name  => $term->textContent,
            value => $value->textContent,
            map { $_->name => $_->value } $term->attributes
        };

        push @properties, $property;
    }

    return @properties;
}


sub construct {
    my ( $self, @properties ) = @_;

    return dl(
        { class => 'xoxo' },
        map {
            my $node = $_;
            dt( {   map { $_ => $node->{ $_ } }
                        grep { $_ !~ /^(name|value)$/ } keys %$_
                },
                $self->encode_entities( $_->{ name } )
                ),
                dd( $self->encode_entities( $_->{ value } ) )
            } @properties
    );
}

sub _make_element {
    my $element = shift;
    my $output  = "<$element";
    if ( ref $_[ 0 ] ) {
        my $attrs = shift;
        $output .= ' ';
        $output .= join( ' ',
            map { qq($_=") . $attrs->{ $_ } . '"' } keys %$attrs );
    }
    $output .= join( '', '>', @_, "</$element>" );
    return $output;
}


sub encode_entities {
    my $self  = shift;
    my $value = shift;
    $value =~ s/($pattern)/&$pattern_lut{$1};/gso;

    return $value;
}


1;