File Coverage

blib/lib/WWW/Mechanize/XML.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package WWW::Mechanize::XML;

use vars qw( $VERSION );
$VERSION = '0.02';

use strict;
use warnings;

use base qw( WWW::Mechanize );

use XML::LibXML;
use File::Temp qw( tempfile );

=head1 NAME

WWW::Mechanize::XML - adds an XML DOM accessor to L.

=head1 VERSION

This document describes WWW::Mechanize::XML version 0.02

=head1 SYNOPSIS

    use WWW::Mechanize::XML;
    use Test::More;
    my $mech = WWW::Mechanize::XML->new();

    ok($mech->get('http://flickr.com/service/?method=getPhotos'), 'got photo list');
    lives_ok {
        $dom = $mech->xml();
    } 'got xml dom object';
    $root = $dom->domumentElement();
    my @photos = $root->findnodes('/rsp/photos/photo');
    is(scalar @photos, 23, 'got 23 photos');

=head1 DESCRIPTION

This is a subclass of L that provides an XML DOM accessor which
parses the contents of the response and returns it as a
L. The motivation for developing this module was to
facilitate testing of XML APIs and XHTML web pages.

=head1 METHODS

=head2 new( %options )

Creates a new C object with the specified options. This
constructor method accepts all of the arguments accepted by L -
see L for further details. Other optional arguments accepted by
this method are C and C:

=head3 xml_parser_options

This argument, if specified, must be a hashref of valid L
options which will be used to instantiate the XML parser. If no parser options
are specified defaults are used. Please see the documentation for
L for option descriptions and default values. Valid parser
options accepted are:

=over

=item validation

=item recover

=item recover_silently

=item expand_entities

=item keep_blanks

=item pedantic_parser

=item line_numbers

=item load_ext_dtd

=item complete_attributes

=item expand_xinclude

=item clean_namespaces

=back

=head3 xml_error_options

This argument, if specified, must be a hashref containing at least the
C key. If there is a value for the given xpath expression it will
cause the call to C to die with that value. If a C key is
specified the call will only die if the value at C equals
C. If a C key is specified the call to C
will die with the value at that path.

=cut

my @valid_parser_options = qw(
    validation
    recover
    recover_silently
    expand_entities
    keep_blanks
    pedantic_parser
    line_numbers
    load_ext_dtd
    complete_attributes
    expand_xinclude
    clean_namespaces
);

sub new {
  my ( $class, %args ) = @_;

  # check for 'parser_options' for backwards compatability
  my $parser_options =
    delete $args{xml_parser_options} || delete $args{parser_options} || {};
  unless (ref $parser_options eq 'HASH') {
    die "'xml_parser_options' must be a hash-ref" ;
  }

  my $error_options = delete $args{xml_error_options} || {};
  unless (ref $error_options eq 'HASH') {
    die "'xml_error_options' must be a hash-ref" ;
  }

  # use catalog to speed up parsing if DTD is loaded
  my ( $catalog_fh, $catalog_file ) = tempfile();
  my $parser = XML::LibXML->new();
  $parser->load_catalog( $catalog_file );

  # set each parser option is valid
  foreach my $option (keys %$parser_options) {
    if (grep { $_ =~ $option } @valid_parser_options) {
      $parser->$option( $parser_options->{$option} );
    } else {
      die "Invalid parser option: $option";
    }
  }

  my $self = bless WWW::Mechanize->SUPER::new( %args ), $class;
  $self->{xml_parser} = $parser;
  $self->{xml_error_options} = $error_options;
  return $self;
}

=head2 xml( )

Returns a L object created from the response content by
calling the L parse_string() method. Any parsing errors
will propogate up. If C were specified for this instance
the response document is check for errors accordingly - this method will die
if errors are found in the document as specified by the options.

=cut

sub xml {
  my $self = shift;

  my $dom = $self->{xml_parser}->parse_string( $self->content() );
  $dom->indexElements(); # speed up XPath queries for static documents

  # if a trigger_xpath is set check for error
  if ($self->{xml_error_options}->{trigger_xpath}) {
    my $root = $dom->documentElement();
    my $error = $root->findvalue($self->{xml_error_options}->{trigger_xpath});

    # if error found at trigger_xpath...
    if ($error) {

      # if trigger_value is specified only die if the error has that value
      my $tv = $self->{xml_error_options}->{trigger_value};
      return $dom if ($tv && $tv ne $error);

      # if message_xpath is specified die with the value at that location
      if ($self->{xml_error_options}->{message_xpath}) {
        die $root->findvalue($self->{xml_error_options}->{message_xpath});
      }

      die $error;
    }
  }

  return $dom;
}

=head1 DEPENDENCIES

L
L
L

=head1 BUGS

Please report any bugs you find via the CPAN RT system.

=head1 COPYRIGHT

Copyright Fotango 2006. All rights reserved.

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

=head1 AUTHOR

Barry White

=cut

1;

__END__