view release on metacpan or  search on metacpan

lib/XML/DOMBacked.pm  view on Meta::CPAN

package XML::DOMBacked;

use strict;
use warnings;
use XML::LibXML;
use LWP::UserAgent;

no warnings 'redefine';

our $VERSION = '1.00';
our $NSMAP  = {};

use overload
  'eq' => 'check_equality',
  '==' => 'check_equality',
  fallback => 1;

sub check_equality {
  my $lhs = shift;
  my $rhs = shift;
  $lhs->dom->isSameNode( $rhs->dom );
}

sub new {
  my $class = shift;
  my $self  = {};
  bless $self => $class;
  my $init  = eval { $self->init( @_ ) };
  if (!$init) {
    my $mesg = "could not initialise object";
    if ( $@ ) { $mesg .= ': ' . $@ }
    die $mesg;
  }
  return $self;
}

sub from_uri {
  my $class = shift;
  my $uri   = shift;
  if (!$uri) {
    die "need to have URI to load";
  }
  my $ua    = LWP::UserAgent->new;
  my $r = $ua->get( $uri );
  if ( !$r->is_success ) {
    die "load failed: " . $r->status_line;
  }
  my $doc = XML::LibXML->new->parse_string( $r->content );
  $class->new->dom( $doc->documentElement );
}


sub init {
  my $self = shift;
  $self->dom( XML::LibXML::Element->new( $self->nodename ) );
  XML::LibXML::Document->new('1.0','UTF-8')->addChild( $self->dom );
  return "init_call_passed";
}

sub nodename {
  my $self = shift;
  my $class = ref( $self ) || $self;
  if ( $class =~ /:/ ) {
    ## we just want to xmlify the last bit
    return lc( substr($class, rindex( $class, ':') + 1 ) );
  }
  return lc( $class );
}

sub dom {
  my $self = shift;
  if ( @_ ) {
    $self->{ dom } = shift;
    return $self;
  }
  return $self->{ dom };
}

sub has_many {
  my $class = shift;
  my $pairs = { @_ };
  foreach my $key ( keys %$pairs ) {
    if ( ref( $pairs->{ $key } ) ) {
      ## this is a complicated multivalue thing
      $class->setup_has_many_complex( $key, $pairs->{ $key }->{class} );
    } else {
      ## this is a simple multivalue thing.