Skip to content

Commit

Permalink
Merge branch 'parsers-serializers-as-roles' of git://github.com/kba/p…
Browse files Browse the repository at this point in the history
…erlrdf into mtmh
  • Loading branch information
tobyink committed Aug 29, 2012
2 parents 27395ee + 309e66b commit bd0d907
Show file tree
Hide file tree
Showing 7 changed files with 271 additions and 270 deletions.
278 changes: 8 additions & 270 deletions RDF-Trine/lib/RDF/Trine/Parser.pm
Expand Up @@ -38,12 +38,18 @@ package RDF::Trine::Parser;

use strict;
use warnings;
no warnings 'redefine';
#no warnings 'redefine';

use Data::Dumper;
use Encode qw(decode);
use LWP::MediaTypes;
use Module::Load::Conditional qw[can_load];

sub media_types {
RDF::Trine::FormatRegistry->instance->known_media_types_with_serializers
}


our ($VERSION);
our %file_extensions;
our %parser_names;
Expand All @@ -67,39 +73,12 @@ use RDF::Trine::Error qw(:try);
use RDF::Trine::Parser::NTriples;
use RDF::Trine::Parser::NQuads;
use RDF::Trine::Parser::Turtle;
use RDF::Trine::Parser::Turtle::Redland;
use RDF::Trine::Parser::TriG;
use RDF::Trine::Parser::RDFXML;
use RDF::Trine::Parser::RDFJSON;
use RDF::Trine::Parser::RDFa;

=item C<< media_type >>
Returns the canonical media type associated with this parser.
=cut

sub media_type {
my $self = shift;
my $class = ref($self) || $self;
return $canonical_media_types{ $class };
}

=item C<< media_types >>
Returns the media types associated with this parser.
=cut

sub media_types {
my $self = shift;
my @types;
foreach my $type (keys %media_types) {
my $class = $media_types{ $type };
push(@types, $type) if ($self->isa($class));
}
return @types;
}

=item C<< parser_by_media_type ( $media_type ) >>
Returns the parser class appropriate for parsing content of the specified media type.
Expand Down Expand Up @@ -160,253 +139,12 @@ sub new {
}
}

=item C<< parse_url_into_model ( $url, $model [, %args] ) >>
Retrieves the content from C<< $url >> and attempts to parse the resulting RDF
into C<< $model >> using a parser chosen by the associated content media type.
If C<< %args >> contains a C<< 'content_cb' >> key with a CODE reference value,
that callback function will be called after a successful response as:
$content_cb->( $url, $content, $http_response_object )
=cut

sub parse_url_into_model {
my $class = shift;
my $url = shift;
my $model = shift;
my %args = @_;

my $ua = LWP::UserAgent->new( agent => "RDF::Trine/$RDF::Trine::VERSION" );

# prefer RDF/XML or Turtle, then anything else that we've got a parser for.
my $accept = join(',', map { /(turtle|rdf[+]xml)/ ? "$_;q=1.0" : "$_;q=0.9" } keys %media_types);
$ua->default_headers->push_header( 'Accept' => $accept );

my $resp = $ua->get( $url );
if ($url =~ /^file:/) {
my $type = guess_media_type($url);
$resp->header('Content-Type', $type);
}

unless ($resp->is_success) {
throw RDF::Trine::Error::ParserError -text => $resp->status_line;
}

my $content = $resp->content;
if (my $cb = $args{content_cb}) {
$cb->( $url, $content, $resp );
}

my $type = $resp->header('content-type');
$type =~ s/^([^\s;]+).*/$1/;
my $pclass = $media_types{ $type };
if ($pclass and $pclass->can('new')) {
my $data = $content;
if (my $e = $encodings{ $pclass }) {
$data = decode( $e, $content );
}

# pass %args in here too so the constructor can take its pick
my $parser = $pclass->new(%args);
my $ok = 0;
try {
$parser->parse_into_model( $url, $data, $model, %args );
$ok = 1;
} catch RDF::Trine::Error with {};
return 1 if ($ok);
} else {
throw RDF::Trine::Error::ParserError -text => "No parser found for content type $type";
}

### FALLBACK
my %options;
if (defined $args{canonicalize}) {
$options{ canonicalize } = $args{canonicalize};
}
if ($url =~ /[.](x?rdf|owl)$/ or $content =~ m/\x{FEFF}?<[?]xml /smo) {
my $parser = RDF::Trine::Parser::RDFXML->new(%options);
$parser->parse_into_model( $url, $content, $model, %args );
return 1;
} elsif ($url =~ /[.]ttl$/ or $content =~ m/@(prefix|base)/smo) {
my $parser = RDF::Trine::Parser::Turtle->new(%options);
my $data = decode('utf8', $content);
$parser->parse_into_model( $url, $data, $model, %args );
return 1;
} elsif ($url =~ /[.]trig$/) {
my $parser = RDF::Trine::Parser::Trig->new(%options);
my $data = decode('utf8', $content);
$parser->parse_into_model( $url, $data, $model, %args );
return 1;
} elsif ($url =~ /[.]nt$/) {
my $parser = RDF::Trine::Parser::NTriples->new(%options);
$parser->parse_into_model( $url, $content, $model, %args );
return 1;
} elsif ($url =~ /[.]nq$/) {
my $parser = RDF::Trine::Parser::NQuads->new(%options);
$parser->parse_into_model( $url, $content, $model, %args );
return 1;
} elsif ($url =~ /[.]js(?:on)?$/) {
my $parser = RDF::Trine::Parser::RDFJSON->new(%options);
$parser->parse_into_model( $url, $content, $model, %args );
return 1;
} elsif ($url =~ /[.]x?html?$/) {
my $parser = RDF::Trine::Parser::RDFa->new(%options);
$parser->parse_into_model( $url, $content, $model, %args );
return 1;
} else {
my @types = keys %{ { map { $_ => 1 } values %media_types } };
foreach my $pclass (@types) {
my $data = $content;
if (my $e = $encodings{ $pclass }) {
$data = decode( $e, $content );
}
my $parser = $pclass->new(%options);
my $ok = 0;
try {
$parser->parse_into_model( $url, $data, $model, %args );
$ok = 1;
} catch RDF::Trine::Error::ParserError with {};
return 1 if ($ok);
}
}
throw RDF::Trine::Error::ParserError -text => "Failed to parse data from $url";
}

=item C<< parse_into_model ( $base_uri, $data, $model [, context => $context] ) >>
Parses the C<< $data >>, using the given C<< $base_uri >>. For each RDF
statement parsed, will call C<< $model->add_statement( $statement ) >>.
=cut

sub parse_into_model {
my $proto = shift;
my $self = blessed($proto) ? $proto : $proto->new();
my $uri = shift;
if (blessed($uri) and $uri->isa('RDF::Trine::Node::Resource')) {
$uri = $uri->uri_value;
}
my $input = shift;
my $model = shift;
my %args = @_;
my $context = $args{'context'};

my $handler = sub {
my $st = shift;
if ($context) {
my $quad = RDF::Trine::Statement::Quad->new( $st->nodes, $context );
$model->add_statement( $quad );
} else {
$model->add_statement( $st );
}
};

$model->begin_bulk_ops();
my $s = $self->parse( $uri, $input, $handler );
$model->end_bulk_ops();
return $s;
}

=item C<< parse_file_into_model ( $base_uri, $fh, $model [, context => $context] ) >>
Parses all data read from the filehandle or file C<< $fh >>, using the
given C<< $base_uri >>. For each RDF statement parsed, will call
C<< $model->add_statement( $statement ) >>.
=cut

sub parse_file_into_model {
my $proto = shift;
my $self = (blessed($proto) or $proto eq __PACKAGE__)
? $proto : $proto->new();
my $uri = shift;
if (blessed($uri) and $uri->isa('RDF::Trine::Node::Resource')) {
$uri = $uri->uri_value;
}
my $fh = shift;
my $model = shift;
my %args = @_;
my $context = $args{'context'};

my $handler = sub {
my $st = shift;
if ($context) {
my $quad = RDF::Trine::Statement::Quad->new( $st->nodes, $context );
$model->add_statement( $quad );
} else {
$model->add_statement( $st );
}
};

$model->begin_bulk_ops();
my $s = $self->parse_file( $uri, $fh, $handler );
$model->end_bulk_ops();
return $s;
}

=item C<< parse_file ( $base_uri, $fh, $handler ) >>
Parses all data read from the filehandle or file C<< $fh >>, using the given
C<< $base_uri >>. If C<< $fh >> is a filename, this method can guess the
associated parse. For each RDF statement parses C<< $handler >> is called.
=cut

sub parse_file {
my $self = shift;
my $base = shift;
my $fh = shift;
my $handler = shift;

unless (ref($fh)) {
my $filename = $fh;
undef $fh;
unless ($self->can('parse')) {
my $pclass = $self->guess_parser_by_filename( $filename );
$self = $pclass->new() if ($pclass and $pclass->can('new'));
}
open( $fh, '<:utf8', $filename ) or throw RDF::Trine::Error::ParserError -text => $!;
}

if ($self and $self->can('parse')) {
my $content = do { local($/) = undef; <$fh> };
return $self->parse( $base, $content, $handler, @_ );
} else {
throw RDF::Trine::Error::ParserError -text => "Cannot parse unknown serialization";
}
}

=item C<< parse ( $base_uri, $rdf, \&handler ) >>
=cut


=item C<< new_bnode_prefix () >>
Returns a new prefix to be used in the construction of blank node identifiers.
If either Data::UUID or UUID::Tiny are available, they are used to construct
a globally unique bnode prefix. Otherwise, an empty string is returned.
=cut

sub new_bnode_prefix {
my $class = shift;
if (defined($Data::UUID::VERSION)) {
my $ug = new Data::UUID;
my $uuid = $ug->to_string( $ug->create() );
$uuid =~ s/-//g;
return 'b' . $uuid;
} elsif (defined($UUID::Tiny::VERSION) && ($] < 5.014000)) { # UUID::Tiny 1.03 isn't working nice with thread support in Perl 5.14. When this is fixed, this may be removed and dep added.
no strict 'subs';
my $uuid = UUID::Tiny::create_UUID_as_string(UUID::Tiny::UUID_V1);
$uuid =~ s/-//g;
return 'b' . $uuid;
} else {
return '';
}
}


1;
Expand Down
11 changes: 11 additions & 0 deletions RDF-Trine/lib/RDF/Trine/Parser/API.pm
Expand Up @@ -59,7 +59,14 @@ has bindings => (

sub _build_bindings { {} }

has namespaces => (
is => 'ro',
isa => 'HashRef',
lazy => 1,
builder => '_build_namespace',
);

sub _build_namespace { {} }

sub _ensure_fh
{
Expand Down Expand Up @@ -357,4 +364,8 @@ structure, optionally using base URI $base.
=back
=head1 AUTHOR
Konstantin Baierer C<< kba@cpan.org >>
=cut

0 comments on commit bd0d907

Please sign in to comment.