view release on metacpan or  search on metacpan

lib/Treex/PML/Schema/Reader.pm  view on Meta::CPAN

package Treex::PML::Schema::Reader;

use strict;
use warnings;

use vars qw($VERSION);
BEGIN {
  $VERSION='2.29'; # version template
}
no warnings 'uninitialized';
use Carp;

use Scalar::Util qw(weaken blessed);
use XML::LibXML::Reader;

sub new {
  my ($class,$opts)=@_;
  my $URL = $opts->{URL};
  my @common = (
     no_xinclude_nodes => 1,
     no_cdata => 1,
     expand_xinclude => 1,
     no_blanks => 1,
     expand_entities => 1,
     suppress_errors => 0,
     suppress_warnings => 0,
  );
  if ($opts->{validate}) {
    my $rng = $opts->{relaxng_schema} || Treex::PML::FindInResources('pml_schema_inline.rng');
    if (defined $rng) {
      push @common, (RelaxNG => $rng);
    } else {
      warn __PACKAGE__.": Validation requested, but 'pml_schema_inline.rng' was not found in the ResourcePath: ".Treex::PML::ResourcePath()."\n";
    }
  }
  my ($reader,$fh);
  # print "loading schema $opts->{URL}\n";
  if ($opts->{string}) {
    $URL ||=  'string://';
    $reader = XML::LibXML::Reader->new(string => $opts->{string},
				       @common,
				       URI => $URL,
				      )
      or die "Error reading string ($URL)";
  } elsif ($opts->{fh}) {
    $URL ||=  'fh://';
    $reader = XML::LibXML::Reader->new(IO => $opts->{string}, @common )
      or die "Error reading file-handle $fh ($URL)";
  } elsif (blessed($opts->{reader}) and $opts->{reader}->isa('XML::LibXML::Reader')) {
    $reader = $opts->{reader};
    $URL ||= $reader->document->URI;
  } else {
    my $file = $opts->{URL};
    print STDERR "parsing schema $file\n" if $Treex::PML::Debug;
    $fh = eval { Treex::PML::IO::open_uri($file) };
    croak "Couldn't open PML schema file '$file'\n".$@ if (!$fh || $@);
    $reader = XML::LibXML::Reader->new(FD => $fh, @common, URI => $URL )
      or die "Error reading $file";
  }
  return bless [$reader,$opts,$fh], $class;
}
sub DESTROY {
  my ($self)=@_;
  my $fh = $self->file_handle;
  Treex::PML::IO::close_uri($fh) if $fh;
}
sub reader {
  return ref($_[0]) && $_[0][0];
}
sub options {
  return ref($_[0]) && $_[0][1];
}
sub file_handle {
  return ref($_[0]) && $_[0][2];
}

sub parse_element {
  my ($self,$parent)=@_;
  my $reader = $self->reader;
  my $opts = $self->options;
  my (@children,@attrs);