File Coverage

blib/lib/RDF/Sesame/Repository.pm

Criterion	Covered	Total	%
statement	9	185	4.8
branch	0	102	0.0
condition	0	3	0.0
subroutine	3	23	13.0
pod	10	11	90.9
total	22	324	6.7

# vim modeline vim600: set foldmethod=marker :

package RDF::Sesame::Repository;

use strict;
use warnings;

use Carp;

our $VERSION = '0.17';

sub construct {
    my $self = shift;

    # establish some sensible defaults
    my %defaults = (
        language => 'SeRQL',
    );
    my %opts = ( %defaults, @_ );

    # validate arguments and install options
    croak "No serialization format specified" if !$opts{format};
    croak "No query specified"                if !$opts{query};

    # set up the output filehandle
    my $output_fh;
    my $output = q{};
    if ( !defined( $opts{output} ) ) {
        open($output_fh, '>', \$output);
    }
    elsif( ref($opts{output}) eq 'GLOB' ) {
        $output_fh = $opts{output};
    }
    else {
        open $output_fh, '>', $opts{output}
            or croak "construct can't open $opts{output} for writing: $!";
    }

    # construct RDF from Sesame
    my $r = $self->command(
        'evaluateGraphQuery',
        {
            serialization => $opts{format},
            queryLanguage => $opts{language},
            query         => $opts{query},
            ':content_cb' => sub { print $output_fh $_[0] },
        }
    );
    croak $r->errstr() if !$r->success();
    close $output_fh;

    return if defined $opts{output};
    return $output;
}

sub extract {
    my $self = shift;

    # establish some sensible defaults
    my %defaults = (
        compress => 'none',
        options  => [],
    );
    my %opts = ( %defaults, @_ );

    # validate arguments and install options
    croak "No serialization format specified" if !$opts{format};
    my %boolean_options;
    for my $option ( @{ $opts{options} } ) {
        $boolean_options{$option} = 'on';
    }

    # set up the output filehandle
    my $output_fh;
    my $output = q{};
    if ( !defined( $opts{output} ) ) {
        open($output_fh, '>', \$output);
    }
    elsif( ref($opts{output}) eq 'GLOB' ) {
        $output_fh = $opts{output};
    }
    else {
        open $output_fh, '>', $opts{output}
            or croak "extract can't open $opts{output} for writing: $!";
    }

    # find and initialize the 'compress' handlers
    my $handlers = ref $opts{compress}
                 ? $opts{compress}
                 : $self->_get_compress_handlers()->{ $opts{compress} }
                 ;
    my $context = $handlers->{init}->($output_fh);

    # extract RDF from Sesame
    my $r = $self->command(
        'extractRDF',
        {
            serialization => $opts{format},
            %boolean_options,
            ':content_cb' => sub {
                $handlers->{content}->($context, $output_fh, $_[0]);
            },
        }
    );
    croak $r->errstr() if !$r->success();

    $handlers->{finish}->($context, $output_fh);
    close $output_fh;

    return if defined $opts{output};
    return $output;
}

sub _get_compress_handlers {
    return {
        none => {
            init => sub { return },
            content => sub {
                my (undef, $fh, $content) = @_;
                print $fh $content;
            },
            finish => sub { return },
        },
        gz => {
            init => sub {
                my ($fh) = @_;
                require Compress::Zlib;
                binmode $fh;
                my $gz = Compress::Zlib::gzopen( $fh, 'wb' )
                    or die "gz compression cannot open filehandle: $Compress::Zlib::gzerrno";
                return $gz;    # our context object
            },
            content => sub {
                my ( $context, $fh, $content ) = @_;
                $context->gzwrite($content)
                    or die "gz compression couldn't write: $Compress::Zlib::gzerrno";
            },
            finish => sub {
                my ( $context, $fh ) = @_;
                $context->gzclose();
            },
        },
    };
}

sub query_language {
    my $self = shift;

    $self->{errstr} = ''; # assume no errors

    return $self->{lang} unless defined $_[0];

    unless( $_[0]=~/^RQL|RDQL|SeRQL$/ ) {
        $self->{errstr} = Carp::shortmess("query language must be RQL, RDQL or SeRQL");
        return $self->{lang};
    }

    my $old = $self->{lang};

    $self->{lang} = $_[0];

    return $old;
}

sub select {
    my $self = shift;
    $self->{errstr} = q{};   # assume no error

    # process the arguments
    my %defaults = (
        query    => @_ == 1 ? shift : q{},
        language => $self->query_language(),
        strip    => $self->{strip},
        format   => 'binary',
    );
    my %opts = ( %defaults, @_ );

    my $r = $self->command(
        'evaluateTableQuery',
        {
            query         => $opts{query},
            queryLanguage => $opts{language},
            resultFormat  => $opts{format},
        }
    );

    if( !$r->success() ) {
        $self->{errstr} = Carp::shortmess($r->errstr);
        return q{};
    }

    return RDF::Sesame::TableResult->new($r, strip => $opts{strip});
}

sub upload_data {
    my $self = shift;

    $self->{errstr} = '';  # assume no error

    # establish some sensible defaults
    my %defaults = (
        data   => '',
        format => 'ntriples',
        verify => 1,
    );

    # set the defaults for any option we weren't given
    my %opts;
    if( @_ == 1 ) {
        $opts{data} = shift;
    } else {
        %opts = @_;
    }
    while( my ($k,$v) = each %defaults ) {
        $opts{$k} = $v unless exists $opts{$k};
    }

    # verify the format parameter
    if( $opts{format} !~ /^rdfxml|ntriples|turtle$/ ) {
        $self->{errstr} = Carp::shortmess("Format must be rdfxml, ntriples or turtle");
        return 0;
    }

    my $params = {
        data         => $opts{data},
        dataFormat   => $opts{format},
        verifyData   => $opts{verify} ? 'on' : 'off',
        resultFormat => 'xml',
    };

    # add in the base URI if we got it
    $params->{baseURI} = $opts{base} if exists $opts{base};

    my $r = $self->command( 'uploadData', $params );

    unless( $r->success ) {
        $self->{errstr} = Carp::shortmess($r->errstr);
        return 0;
    }

    foreach ( @{$r->parsed_xml->{status}} ) {
        my $triple_count;
        if( $_->{msg} =~ /^Data is correct and contains ([\d,]+) statement/ ) {
            $triple_count = $1;
        }
        if( $_->{msg} =~ /^Processed ([\d,]+) statement/ ) {
            $triple_count = $1;
        }
        if (defined $triple_count) {
            $triple_count =~ s{,}{}xmsg;
            return $triple_count;
        }
    }

    $self->{errstr} = Carp::shortmess('Unknown error');
    return 0;
}

sub upload_uri {
    my $self = shift;

    $self->{errstr} = '';  # assume no error

    # set some sensible defaults
    my %defaults = (
        uri => '',
        format => 'rdfxml',
        verify => 1,
        server_file => 0,
    );

    # set the defaults for any option we weren't given
    my %opts;
    if( @_ == 1 ) {
        $opts{uri} = shift;
    } else {
        %opts = @_;
    }
    while( my ($k,$v) = each %defaults ) {
        $opts{$k} = $v unless exists $opts{$k};
    }

    # set the default for the base URI
    $opts{base} = $opts{uri} unless exists $opts{base};

    # validate the format option
    if( $opts{format} !~ /^rdfxml|ntriples|turtle$/ ) {
        $self->{errstr} = Carp::shortmess("Format must be rdfxml, ntriples or turtle");
        return 0;
    }

    # handle the "file:" URI scheme
    if( $opts{uri} =~ /^file:/ && !$opts{server_file} ) {
        require LWP::Simple;
        my $content = LWP::Simple::get($opts{uri});
        unless( defined $content ) {
            $self->{errstr} = Carp::shortmess("No data in $opts{uri}");
            return 0;
        }

        delete $opts{uri};
        return $self->upload_data(
            data   => $content,
            %opts
        );
    }

    my $params = {
        url          => $opts{uri},
        dataFormat   => $opts{format},
        verifyData   => $opts{verify} ? 'on' : 'off',
        resultFormat => 'xml',
        baseURI      => $opts{base},
    };

    my $r = $self->command( 'uploadURL', $params );

    unless( $r->success ) {
        $self->{errstr} = Carp::shortmess($r->errstr);
        return 0;
    }

    foreach ( @{$r->parsed_xml->{status}} ) {
        my $triple_count;
        if( $_->{msg} =~ /^Data is correct and contains ([\d,]+) statement/ ) {
            $triple_count = $1;
        }
        elsif( $_->{msg} =~ /^Processed ([\d,]+) statement/ ) {
            $triple_count = $1;
        }
        if (defined $triple_count) {
            $triple_count =~ s{,}{}xmsg;
            return $triple_count;
        }
    }

    $self->{errstr} = Carp::shortmess('Unknown error');
    return 0;
}

sub clear {
    my $self = shift;

    my $r = $self->command('clearRepository', { resultFormat => 'xml' });

    return '' unless $r->success;

    foreach ( @{ $r->parsed_xml->{status} } ) {
        if( $_->{msg} eq 'Repository cleared' ) {
            return 1;
        }
    }

    return 0;
}

sub remove {
    my $self = shift;

    # prepare the parameters for the command
    my $params = { resultFormat => 'xml' };
    $params->{subject}   = $_[0] if defined $_[0];
    $params->{predicate} = $_[1] if defined $_[1];
    $params->{object}    = $_[2] if defined $_[2];

    my $r = $self->command('removeStatements', $params);

    unless( $r->success ) {
        return 0;
    }

    foreach ( @{ $r->parsed_xml->{notification} } ) {
        if( $_->{msg} =~ /^Removed (\d+)/ ) {
            return $1;
        }
    }

    return 0;
}

sub errstr {
    my $self = shift;

    return $self->{errstr};
}

sub command {
    my $self = shift;

    $self->{conn}->command($self->{id}, $_[0], $_[1]);
}

# This method should really only be called from
# RDF::Sesame::Connection::open.
# As parameters, it takes an RDF::Sesame::Connection object and
# some named parameters
sub new {
    my $class = shift;
    my $conn  = shift;

    # prepare the options we were given
    my %opts;
    if( @_ == 1 ) {
        $opts{id} = shift;
    } else {
        %opts = @_;
    }
    return '' unless defined $opts{id};

    my $self = bless {
        id     => $opts{id}, # our repository ID
        conn   => $conn,     # a connection for accessing the server
        lang   => 'SeRQL',   # the default query language
        errstr => '',        # the most recent error string
        strip  => 'none',    # the default strip option for select()
    }, $class;

    if( exists $opts{query_language} ) {
        $self->query_language($opts{query_language});
    }

    $self->{strip} = $opts{strip} if exists $opts{strip};

    return $self;
}

1;

__END__