no warnings 'redefine';
no warnings 'once';
our ($VERSION, $rdf, $xsd);
our ($r_boolean, $r_comment, $r_decimal, $r_double, $r_integer, $r_language, $r_lcharacters, $r_line, $r_nameChar_extra, $r_nameStartChar_minus_underscore, $r_scharacters, $r_ucharacters, $r_booltest, $r_nameStartChar, $r_nameChar, $r_prefixName, $r_qname, $r_resource_test, $r_nameChar_test);
BEGIN {
$VERSION = '0.127_02';
$RDF::Trine::Parser::parser_names{ 'turtle' } = __PACKAGE__;
my $class = __PACKAGE__;
$RDF::Trine::Parser::encodings{ $class } = 'utf8';
foreach my $type (qw(application/x-turtle application/turtle text/turtle)) {
$RDF::Trine::Parser::media_types{ $type } = __PACKAGE__;
}
$r_boolean = qr'(?:true|false)';
$r_comment = qr'#[^\r\n]*';
$r_decimal = qr'[+-]?([0-9]+\.[0-9]*|\.([0-9])+)';
$r_double = qr'[+-]?([0-9]+\.[0-9]*[eE][+-]?[0-9]+|\.[0-9]+[eE][+-]?[0-9]+|[0-9]+[eE][+-]?[0-9]+)';
$r_integer = qr'[+-]?[0-9]+';
$r_language = qr'[a-z]+(-[a-z0-9]+)*'i;
$r_lcharacters = qr'(?s)[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*';
$r_line = qr'(?:[^\r\n]+[\r\n]+)(?=[^\r\n])';
$r_nameChar_extra = qr'[-0-9\x{B7}\x{0300}-\x{036F}\x{203F}-\x{2040}]';
$r_nameStartChar_minus_underscore = qr'[A-Za-z\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{00010000}-\x{000EFFFF}]';
$r_scharacters = qr'[^"\\]*(?:\\.[^"\\]*)*';
$r_ucharacters = qr'[^>\\]*(?:\\.[^>\\]*)*';
$r_booltest = qr'(?:true|false)\b';
$r_nameStartChar = qr/[A-Za-z_\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}\x{00F8}-\x{02FF}\x{0370}-\x{037D}\x{037F}-\x{1FFF}\x{200C}-\x{200D}\x{2070}-\x{218F}\x{2C00}-\x{2FEF}\x{3001}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/;
$r_nameChar = qr/${r_nameStartChar}|[-0-9\x{b7}\x{0300}-\x{036f}\x{203F}-\x{2040}]/;
$r_prefixName = qr/(?:(?!_)${r_nameStartChar})($r_nameChar)*/;
$r_qname = qr/(?:${r_prefixName})?:/;
$r_resource_test = qr/<|$r_qname/;
$r_nameChar_test = qr"(?:$r_nameStartChar|$r_nameChar_extra)";
}
sub new {
my $class = shift;
my $ug = new Data::UUID;
my $uuid = $ug->to_string( $ug->create() );
$uuid =~ s/-//g;
my $self = bless({
bindings => {},
bnode_id => 0,
bnode_prefix => $uuid,
@_
}, $class);
return $self;
}
sub parse {
my $self = shift;
my $uri = shift;
my $input = shift;
my $handler = shift;
local($self->{handle_triple});
if ($handler) {
$self->{handle_triple} = $handler;
}
local($self->{baseURI}) = $uri;
local($self->{tokens}) = $input;
$self->_Document();
return;
}
sub _eat_re {
my $self = shift;
my $thing = shift;
my $l = Log::Log4perl->get_logger("rdf.trine.parser.turtle");
if (not(length($self->{tokens}))) {
$l->error("no tokens left ($thing)");
throw RDF::Trine::Error::ParserError -text => "No tokens";
}
if ($self->{tokens} =~ m/^($thing)/) {
my $match = $1;
substr($self->{tokens}, 0, length($match)) = '';
return;
}
$l->error("Expected ($thing) with remaining: $self->{tokens}");
throw RDF::Trine::Error::ParserError -text => "Expected: $thing";
}
sub _eat_re_save {
my $self = shift;
my $thing = shift;
my $l = Log::Log4perl->get_logger("rdf.trine.parser.turtle");
if (not(length($self->{tokens}))) {
$l->error("no tokens left ($thing)");
throw RDF::Trine::Error::ParserError -text => "No tokens";
}
if ($self->{tokens} =~ m/^($thing)/) {
my $match = $1;
substr($self->{tokens}, 0, length($match)) = '';
return $match;
}
$l->error("Expected ($thing) with remaining: $self->{tokens}");
throw RDF::Trine::Error::ParserError -text => "Expected: $thing";
}
sub _eat {
my $self = shift;
my $thing = shift;
my $l = Log::Log4perl->get_logger("rdf.trine.parser.turtle");
if (not(length($self->{tokens}))) {
$l->error("no tokens left ($thing)");
throw RDF::Trine::Error::ParserError -text => "No tokens";
}
if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
substr($self->{tokens}, 0, length($thing)) = '';
return;
} else {
$l->logcluck("expected: $thing, got: $self->{tokens}");
throw RDF::Trine::Error::ParserError -text => "Expected: $thing";
}
}
sub _test {
my $self = shift;
my $thing = shift;
if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
return 1;
} else {
return 0;
}
}
sub _triple {
my $self = shift;
my $s = shift;
my $p = shift;
my $o = shift;
foreach my $n ($s, $p, $o) {
unless ($n->isa('RDF::Trine::Node')) {
throw RDF::Trine::Error::ParserError;
}
}
if ($self->{canonicalize}) {
if ($o->isa('RDF::Trine::Node::Literal') and $o->has_datatype) {
my $value = $o->literal_value;
my $dt = $o->literal_datatype;
my $canon = $self->canonicalize_literal_value( $value, $dt );
$o = literal( $canon, undef, $dt );
}
}
my $st = RDF::Trine::Statement->new( $s, $p, $o );
if (my $code = $self->{handle_triple}) {
$code->( $st );
}
my $count = ++$self->{triple_count};
}
sub _Document {
my $self = shift;
while ($self->_statement_test()) {
$self->_statement();
}
}
sub _statement_test {
my $self = shift;
if (length($self->{tokens})) {
return 1;
} else {
return 0;
}
}
sub _statement {
my $self = shift;
if ($self->_directive_test()) {
$self->_directive();
$self->__consume_ws();
$self->_eat('.');
$self->__consume_ws();
} elsif ($self->_triples_test()) {
$self->_triples();
$self->__consume_ws();
$self->_eat('.');
$self->__consume_ws();
} else {
$self->_ws();
$self->__consume_ws();
}
}
sub _directive_test {
my $self = shift;
if ($self->__startswith('@')) {
return 1;
} else {
return 0;
}
}
sub _directive {
my $self = shift;
if ($self->_prefixID_test()) {
$self->_prefixID();
} else {
$self->_base();
}
}
sub _prefixID_test {
my $self = shift;
if ($self->__startswith('@prefix')) {
return 1;
} else {
return 0;
}
}
sub _prefixID {
my $self = shift;
$self->_eat('@prefix');
$self->_ws();
$self->__consume_ws();
my $prefix;
if ($self->_prefixName_test()) {
$prefix = $self->_prefixName();
} else {
$prefix = '';
}
$self->_eat(':');
$self->_ws();
$self->__consume_ws();
my $uri = $self->_uriref();
$self->{bindings}{$prefix} = $uri;
}
sub _base {
my $self = shift;
$self->_eat('@base');
$self->_ws();
$self->__consume_ws();
my $uri = $self->_uriref();
if (ref($uri)) {
$uri = $uri->uri_value;
}
$self->{baseURI} = $self->_join_uri($self->{baseURI}, $uri);
}
sub _triples_test {
my $self = shift;
return 1 if $self->_resource_test;
return $self->_blank_test;
}
sub _triples {
my $self = shift;
my $subj = $self->_subject();
$self->_ws();
$self->__consume_ws;
foreach my $data ($self->_predicateObjectList()) {
my ($pred, $objt) = @$data;
$self->_triple( $subj, $pred, $objt );
}
}
sub _predicateObjectList {
my $self = shift;
my $pred = $self->_verb();
$self->_ws();
$self->__consume_ws();
my @list;
foreach my $objt ($self->_objectList()) {
push(@list, [$pred, $objt]);
}
while ($self->{tokens} =~ m/^[\t\r\n
$self->__consume_ws();
$self->_eat(';');
$self->__consume_ws();
if ($self->_verb_test()) {
$pred = $self->_verb();
$self->_ws();
$self->__consume_ws();
foreach my $objt ($self->_objectList()) {
push(@list, [$pred, $objt]);
}
} else {
last
}
}
return @list;
}
sub _objectList {
my $self = shift;
my @list;
push(@list, $self->_object());
$self->__consume_ws();
while ($self->_test(',')) {
$self->__consume_ws();
$self->_eat(',');
$self->__consume_ws();
push(@list, $self->_object());
$self->__consume_ws();
}
return @list;
}
sub _verb_test {
my $self = shift;
return 0 unless (length($self->{tokens}));
return 1 if ($self->{tokens} =~ /^a\b/);
return $self->_predicate_test();
}
sub _verb {
my $self = shift;
if ($self->_predicate_test()) {
return $self->_predicate();
} else {
$self->_eat('a');
return $rdf->type;
}
}
sub _comment {
my $self = shift;
$self->_eat_re($r_comment);
return 1;
}
sub _subject {
my $self = shift;
if (length($self->{tokens}) and $self->{tokens} =~ /^$r_resource_test/) {
return $self->_resource();
} else {
return $self->_blank();
}
}
sub _predicate_test {
my $self = shift;
return 0 unless (length($self->{tokens}));
return $self->_resource_test;
}
sub _predicate {
my $self = shift;
return $self->_resource();
}
sub _object {
my $self = shift;
if (length($self->{tokens}) and $self->{tokens} =~ /^$r_resource_test/) {
return $self->_resource();
} elsif ($self->_blank_test()) {
return $self->_blank();
} else {
return $self->_literal();
}
}
sub _literal {
my $self = shift;
if ($self->_quotedString_test()) {
my $value = $self->_quotedString();
if ($self->_test('@')) {
$self->_eat('@');
my $lang = $self->_language();
return $self->__Literal($value, $lang);
} elsif ($self->_test('^^')) {
$self->_eat('^^');
my $dtype = $self->_resource();
return $self->_typed($value, $dtype);
} else {
return $self->__Literal($value);
}
} elsif ($self->_double_test()) {
return $self->_double();
} elsif ($self->_decimal_test()) {
return $self->_decimal();
} elsif ($self->_integer_test()) {
return $self->_integer();
} else {
return $self->_boolean();
}
}
sub _double_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_double/) {
return 1;
} else {
return 0;
}
}
sub _double {
my $self = shift;
my $token = $self->_eat_re_save( $r_double );
return $self->_typed( $token, $xsd->double );
}
sub _decimal_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_decimal/) {
return 1;
} else {
return 0;
}
}
sub _decimal {
my $self = shift;
my $token = $self->_eat_re_save( $r_decimal );
return $self->_typed( $token, $xsd->decimal );
}
sub _integer_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_integer/) {
return 1;
} else {
return 0;
}
}
sub _integer {
my $self = shift;
my $token = $self->_eat_re_save( $r_integer );
return $self->_typed( $token, $xsd->integer );
}
sub _boolean {
my $self = shift;
my $token = $self->_eat_re_save( $r_boolean );
return $self->_typed( $token, $xsd->boolean );
}
sub _blank_test {
my $self = shift;
if ($self->{tokens} =~ m/^[_[(]/) {
return 1;
} else {
return 0;
}
}
sub _blank {
my $self = shift;
if ($self->_nodeID_test) {
return $self->__bNode( $self->__anonimize_bnode_id( $self->_nodeID() ) );
} elsif ($self->_test('[]')) {
$self->_eat('[]');
return $self->__bNode( $self->__generate_bnode_id() );
} elsif ($self->_test('[')) {
$self->_eat('[');
my $subj = $self->__bNode( $self->__generate_bnode_id() );
$self->__consume_ws();
foreach my $data ($self->_predicateObjectList()) {
my ($pred, $objt) = @$data;
$self->_triple( $subj, $pred, $objt );
}
$self->__consume_ws();
$self->_eat(']');
return $subj;
} else {
return $self->_collection();
}
}
sub _itemList_test {
my $self = shift;
return 0 unless (length($self->{tokens}));
if ($self->{tokens} !~ m/^[\r\n\t
return 1;
} else {
return 0;
}
}
sub _itemList {
my $self = shift;
my @list;
push(@list, $self->_object());
while ($self->_ws_test()) {
$self->__consume_ws();
if (not $self->_test(')')) {
push(@list, $self->_object());
}
}
return @list;
}
sub _collection {
my $self = shift;
my $b = $self->__bNode( $self->__generate_bnode_id() );
my ($this, $rest) = ($b, undef);
$self->_eat('(');
$self->__consume_ws();
if ($self->_itemList_test()) {
foreach my $objt ($self->_itemList()) {
if (defined($rest)) {
$this = $self->__bNode( $self->__generate_bnode_id() );
$self->_triple( $rest, $rdf->rest, $this)
}
$self->_triple( $this, $rdf->first, $objt );
$rest = $this;
}
}
if (defined($rest)) {
$self->_triple( $rest, $rdf->rest, $rdf->nil );
} else {
$b = $rdf->nil;
}
$self->__consume_ws();
$self->_eat(')');
return $b;
}
sub _ws_test {
my $self = shift;
unless (length($self->{tokens})) {
return 0;
}
if ($self->{tokens} =~ m/^[\t\r\n
return 1;
} else {
return 0;
}
}
sub _ws {
my $self = shift;
if ($self->_test('#')) {
$self->_comment();
} else {
my $ws = $self->_eat_re_save( qr/[\n\r\t ]+/ );
unless ($ws =~ /^[\n\r\t ]/) {
throw RDF::Trine::Error::ParserError -text => 'Not whitespace';
}
}
}
sub _resource_test {
my $self = shift;
return 0 unless (length($self->{tokens}));
if ($self->{tokens} =~ m/^$r_resource_test/) {
return 1;
} else {
return 0;
}
}
sub _resource {
my $self = shift;
if ($self->_uriref_test()) {
return $self->__URI($self->_uriref(), $self->{baseURI});
} else {
my $qname = $self->_qname();
my $base = $self->{baseURI};
return $self->__URI($qname, $base);
}
}
sub _nodeID_test {
my $self = shift;
if (substr($self->{tokens}, 0, 1) eq '_') {
return 1;
} else {
return 0;
}
}
sub _nodeID {
my $self = shift;
$self->_eat('_:');
return $self->_name();
}
sub _qname {
my $self = shift;
my $prefix = ($self->{tokens} =~ /^$r_nameStartChar_minus_underscore/) ? $self->_prefixName() : '';
$self->_eat(':');
my $name = ($self->{tokens} =~ /^$r_nameStartChar/) ? $self->_name() : '';
unless (exists $self->{bindings}{$prefix}) {
throw RDF::Trine::Error::ParserError -text => "Undeclared prefix $prefix";
}
my $uri = $self->{bindings}{$prefix};
return $uri . $name
}
sub _uriref_test {
my $self = shift;
if ($self->__startswith('<')) {
return 1;
} else {
return 0;
}
}
sub _uriref {
my $self = shift;
$self->_eat('<');
my $value = $self->_relativeURI();
$self->_eat('>');
return $value;
}
sub _language {
my $self = shift;
my $token = $self->_eat_re_save( $r_language );
return $token;
}
sub _nameStartChar_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_nameStartChar/) {
return 1;
} else {
return 0;
}
}
sub _nameStartChar {
my $self = shift;
my $nc = $self->_eat_re_save( $r_nameStartChar );
return $nc;
}
sub _nameChar_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_nameStartChar/) {
return 1;
} elsif ($self->{tokens} =~ /^$r_nameChar_extra/) {
return 1;
} else {
return 0;
}
}
sub _nameChar {
my $self = shift;
if ($self->{tokens} =~ /^$r_nameStartChar/) {
my $nc = $self->_nameStartChar();
return $nc;
} else {
my $nce = $self->_eat_re_save( $r_nameChar_extra );
return $nce;
}
}
sub _name {
my $self = shift;
my $name = $self->_eat_re_save( qr/^${r_nameStartChar}(${r_nameStartChar}|${r_nameChar_extra})*/ );
return $name;
}
sub _prefixName_test {
my $self = shift;
if ($self->{tokens} =~ /^$r_nameStartChar_minus_underscore/) {
return 1;
} else {
return 0;
}
}
sub _prefixName {
my $self = shift;
my @parts;
my $nsc = $self->_eat_re_save( $r_nameStartChar_minus_underscore );
push(@parts, $nsc);
while ($self->{tokens} =~ /^$r_nameChar_test/) {
my $nc = $self->_nameChar();
push(@parts, $nc);
}
return join('', @parts);
}
sub _relativeURI {
my $self = shift;
my $token = $self->_eat_re_save( $r_ucharacters );
return $token;
}
sub _quotedString_test {
my $self = shift;
if (substr($self->{tokens}, 0, 1) eq '"') {
return 1;
} else {
return 0;
}
}
sub _quotedString {
my $self = shift;
if ($self->_longString_test()) {
return $self->_longString();
} else {
return $self->_string();
}
}
sub _string {
my $self = shift;
$self->_eat('"');
my $value = $self->_eat_re_save( $r_scharacters );
$self->_eat('"');
return $self->_parse_short( $value );
}
sub _longString_test {
my $self = shift;
if ($self->__startswith( '"""' )) {
return 1;
} else {
return 0;
}
}
sub _longString {
my $self = shift;
$self->_eat('"""');
my $value = $self->_eat_re_save( $r_lcharacters );
$self->_eat('"""');
return $self->_parse_long( $value );
}
sub _parse_short {
my $self = shift;
my $s = shift;
for ($s) {
s/\\"/"/g;
s/\\t/\t/g;
s/\\r/\r/g;
s/\\n/\n/g;
}
return '' unless length($s);
return Unicode::Escape::unescape( $s );
}
sub _parse_long {
my $self = shift;
my $s = shift;
for ($s) {
s/\\"/"/g;
s/\\t/\t/g;
s/\\r/\r/g;
s/\\n/\n/g;
}
return '' unless length($s);
return Unicode::Escape::unescape( $s );
}
sub _join_uri {
my $self = shift;
my $base = shift;
my $uri = shift;
if ($base eq $uri) {
return $uri;
}
return URI->new_abs( $uri, $base );
}
sub _typed {
my $self = shift;
my $value = shift;
my $type = shift;
my $datatype = $type->uri_value;
if ($datatype eq "${xsd}decimal") {
$value =~ s/[.]0+$//;
if ($value !~ /[.]/) {
$value = $value . '.0';
}
}
return RDF::Trine::Node::Literal->new($value, undef, $datatype)
}
sub __anonimize_bnode_id {
my $self = shift;
my $id = shift;
if (my $aid = $self->{ bnode_map }{ $id }) {
return $aid;
} else {
my $aid = $self->__generate_bnode_id;
$self->{ bnode_map }{ $id } = $aid;
return $aid;
}
}
sub __generate_bnode_id {
my $self = shift;
my $id = $self->{ bnode_id }++;
return 'r' . $self->{bnode_prefix} . 'r' . $id;
}
sub __consume_ws {
my $self = shift;
while ($self->{tokens} =~ m/^[\t\r\n
$self->_ws()
}
}
sub __URI {
my $self = shift;
my $uri = shift;
my $base = shift;
return RDF::Trine::Node::Resource->new( $uri, $base )
}
sub __bNode {
my $self = shift;
return RDF::Trine::Node::Blank->new( @_ )
}
sub __Literal {
my $self = shift;
return RDF::Trine::Node::Literal->new( @_ )
}
sub __DatatypedLiteral {
my $self = shift;
return RDF::Trine::Node::Literal->new( $_[0], undef, $_[1] )
}
sub __startswith {
my $self = shift;
my $thing = shift;
if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
return 1;
} else {
return 0;
}
}
1;