File Coverage

blib/lib/Turtle/Writer.pm

Criterion	Covered	Total	%
statement	56	60	93.3
branch	29	34	85.2
condition	13	15	86.6
subroutine	8	9	88.8
pod	4	4	100.0
total	110	122	90.1

package Turtle::Writer;
{
  $Turtle::Writer::VERSION = '0.004';
}
#ABSTRACT: Write RDF/Turtle documents without non-core package dependencies

use strict;
use warnings;


use Carp;
use Scalar::Util qw(reftype);
use base 'Exporter';

our @EXPORT = qw(turtle_literal turtle_literal_list turtle_statement turtle_uri);


sub turtle_statement {
    my ($subject, %statements) = @_;

    my @s = grep { defined $_ } map {
        my ($p,$o) = ($_,$statements{$_});
        if ( ref($o) ) {
           if (reftype($o) eq 'HASH') {
               $o = [ map { turtle_literal($o->{$_},$_) } keys %$o ];
           }
           if (reftype($o) eq 'ARRAY') {
               $o = join(", ", @$o) if ref($o);
           } else {
               $o = undef;
           }
        }
        (defined $o and $o ne '') ? "$p $o" : undef;
    } keys %statements;

	return "" unless @s;

	my $ttl = join(" ;\n" , shift @s, map { "    $_" } @s);
	if (defined $subject) {
	    return "$subject $ttl .\n";
	} else {
	    return "[ $ttl ] .\n";
	}
}


sub turtle_literal {
    my $value = shift;
    my %opt;

    if ( ref( $value ) and ref($value) eq 'ARRAY') {
        return join( ", ", map { turtle_literal( $_, @_ ) } @$value );
    }

    if ( @_ % 2 ) {
        my $v = shift;
        %opt = ($v =~ /^[a-zA-Z0-9-]+$/) ? ( lang => $v ) : ( type => $v );
    } else {

        %opt = @_;
        croak "Literal values cannot have both language and datatype"
            if ($opt{lang} and $opt{type});
    }

    return "" if not defined $value or $value eq '';

    my %ESCAPED = ( "\t" => 't', "\n" => 'n',
        "\r" => 'r', "\"" => '"', "\\" => '\\' );
    $value =~ s/([\t\n\r\"\\])/\\$ESCAPED{$1}/sg;

    $value = qq("$value");

    if ($opt{lang}) {
        return $value.'@'.$opt{lang};
    } elsif ($opt{type}) {
        return $value.'^^<'.$opt{type} .'>';
    }

    return $value;
}


sub turtle_literal_list {
    if ( ref($_[0]) and ref($_[0]) eq 'HASH') {
        my $hash = $_[0];
        return join( ", ",
            map { turtle_literal( $hash->{$_}, lang => $_ ) }
            keys %$hash
        );
    } elsif ( @_ > 1 ) {
        return turtle_literal( \@_ );
    } else {
        return turtle_literal( $_[0] );
    }
}


sub turtle_uri {
    my $value = shift;
    return "" unless defined $value;
    # my $value = URI->new( encode_utf8( $value ) )->canonical;
    return "<$value>";
}


1;

__END__