File Coverage

blib/lib/AtteanX/Parser/Trig.pm

Criterion	Covered	Total	%
statement	43	132	32.5
branch	0	36	0.0
condition	0	21	0.0
subroutine	16	23	69.5
pod	3	3	100.0
total	62	215	28.8

use v5.14;
use warnings;

# AtteanX::Parser::Trig
# -----------------------------------------------------------------------------

=head1 NAME

AtteanX::Parser::Trig - Trig RDF Parser

=head1 VERSION

This document describes AtteanX::Parser::Trig version 0.033

=head1 SYNOPSIS

 use Attean;
 my $parser	= AtteanX::Parser::Trig->new( handler => sub {...}, base => $base_iri );

 # Parse data from a file-handle and handle triples in the 'handler' callback
 $parser->parse_cb_from_io( $fh );

 # Parse the given byte-string, and return an iterator of triples
 my $iter = $parser->parse_iter_from_bytes('<s> <p> 1, 2, 3 .');
 while (my $triple = $iter->next) {
   print $triple->as_string;
 }

=head1 DESCRIPTION

This module implements a parser for the Trig RDF format.

=head1 ROLES

This class consumes L<Attean::API::Parser>, L<Attean::API::PushParser>,
<Attean::API::AbbreviatingParser>, and <Attean::API::TripleParser>.

=head1 ATTRIBUTES

=over 4

=item C<< canonical_media_type >>

=item C<< media_types >>

=item C<< file_extensions >>

=item C<< canonicalize >>

A boolean indicating whether term values should be canonicalized during parsing.

=back

=head1 METHODS

=over 4

=cut

	use Moo;
	use Types::Standard qw(Bool ArrayRef HashRef Str Maybe InstanceOf);
	use Types::Namespace qw( NamespaceMap );
	use utf8;
	use Carp qw(carp);
	use Encode qw(encode);
	use Scalar::Util qw(blessed);
	use Attean::API::Parser;
	use AtteanX::Parser::Turtle;
	use AtteanX::Parser::Turtle::Constants;
	use namespace::clean;

	my $RDF	= 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
	my $XSD	= 'http://www.w3.org/2001/XMLSchema#';

	extends 'AtteanX::Parser::Turtle';


		return [qw(text/trig)];
	}


	has 'canonicalize'	=> (is => 'rw', isa => Bool, default => 0);
	has '_map' => (is => 'ro', isa => HashRef[Str], default => sub { +{} });

	with 'Attean::API::MixedStatementParser';

	################################################################################

	# this is the entry point where we change the rules from Turtle to Trig
		my $self	= shift;
		my $l		= shift;
		$l->check_for_bom;
		while (my $t = $self->_next_nonws($l)) {
			$self->_trigDoc($l, $t);
		}
	}

		my $self	= shift;
		my $l		= shift;
		my $t		= shift;
		my $type	= $t->type;
		if ($type == TURTLEPREFIX or $type == PREFIX) {
			$t	= $self->_get_token_type($l, PREFIXNAME);
			use Data::Dumper;
			unless (defined($t->value)) {
				my $tname	= AtteanX::Parser::Turtle::Constants::decrypt_constant($t->type);
				Carp::confess "undefined $tname token value: " . Dumper($t);
			}
			my $name	= $t->value;
			chop($name) if (substr($name, -1) eq ':');
# 			$name		=~ s/:$//;
			$t	= $self->_get_token_type($l, IRI);
			my %args	= (value => $t->value);
			if ($self->has_base) {
				$args{base}	= $self->base;
			}
			my $r	= $self->new_iri(%args);
			my $iri	= $r->as_string;
			if ($type == TURTLEPREFIX) {
				$t	= $self->_get_token_type($l, DOT);
	# 			$t	= $self->_next_nonws($l);
	# 			if ($t and $t->type != DOT) {
	# 				$self->_unget_token($t);
	# 			}
			}
			$self->_map->{$name}	= $iri;
			if ($self->has_namespaces) {
				my $ns	= $self->namespaces;
				unless ($ns->namespace_uri($name)) {
					$ns->add_mapping($name, $iri);
				}
			}
		}
		elsif ($type == TURTLEBASE or $type == BASE) {
			$t	= $self->_get_token_type($l, IRI);
			my %args	= (value => $t->value);
			if ($self->has_base) {
				$args{base}	= $self->base;
			}
			my $r	= $self->new_iri(%args);
			my $iri	= $r->as_string;
			if ($type == TURTLEBASE) {
				$t	= $self->_get_token_type($l, DOT);
	# 			$t	= $self->_next_nonws($l);
	# 			if ($t and $t->type != DOT) {
	# 				$self->_unget_token($t);
	# 			}
			}
			$self->base($iri);
		}
		else {
			$self->_block( $l, $t );
		}
	# 	}
	}

		my $self	= shift;
		my $l		= shift;
		my $t		= shift;
		my $type	= $t->type;
		if ($type == GRAPH) {
			# "GRAPH" labelOrSubject wrappedGraph
			my $graph	= $self->_labelOrSubject($l);
			local($self->{graph})	= $graph;
			$t	= $self->_get_token_type($l, LBRACE);
			$self->_block($l, $t);
		} elsif ($type == LBRACE) {
			$t		= $self->_next_nonws($l);
			$type	= $t->type;
			while ($type != RBRACE) {
				$self->_triple($l, $t);
				$t		= $self->_next_nonws($l);
				$type	= $t->type;
				unless ($type == RBRACE or $type == DOT) {
					carp "Expected DOT or closing brace";
				}
				if ($type == DOT) {
					$t		= $self->_next_nonws($l);
					$type	= $t->type;
				}
			}
		} else {
			$self->_triple($l, $t);
			$t	= $self->_get_token_type($l, DOT);
		}
	}

		my $self	= shift;
		my $l		= shift;
		my $t		= $self->_next_nonws($l);
		if ($t->type == IRI or $t->type == PREFIXNAME or $t->type == BNODE) {
			return $self->_token_to_node($t);
		} else {
			$self->_throw_error(sprintf("Expecting graph name but got %s", decrypt_constant($t->type)), $t, $l);
		}
	}

		my $self	= shift;
		my $subj	= shift;
		my $pred	= shift;
		my $obj		= shift;
		if ($self->canonicalize and blessed($obj) and $obj->does('Attean::API::Literal')) {
			$obj	= $obj->canonicalize;
		}

		my $graph = $self->{graph};
		my $t		= (defined($graph))
					? Attean::Quad->new($subj, $pred, $obj, $graph)
					: Attean::Triple->new($subj, $pred, $obj);
		$self->handler->($t);
		return $t;
	}

		my $self	= shift;
		my $message	= shift;
		my $t		= shift;
		my $l		= shift;
		my $line	= $t->start_line;
		my $col		= $t->start_column;
	# 	Carp::cluck "$message at $line:$col";
		my $text	= "$message at $line:$col";
		if (defined($t->value)) {
			$text	.= " (near '" . $t->value . "')";
		}
		Carp::cluck "TriG parser error";
		die $text;
	}
}

1;


=back

=head1 BUGS

Please report any bugs or feature requests to through the GitHub web interface
at L<https://github.com/kasei/perlrdf/issues>.

=head1 AUTHOR

Gregory Todd Williams  C<< <[e-mail]> >>

=head1 COPYRIGHT

Copyright (c) 2014--2022 Gregory Todd Williams. This
program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut