Toby Inkster

#!/usr/bin/perl

# Probably some pretty major insecurities here because of eval() code.

use RDF::Redland;

WoDo::FACTORY->create_from_json('Person', '
{
    "name" :
    {
        "return" : "first" ,
        "sparql" : "SELECT ?name WHERE { <!> <http://xmlns.com/foaf/0.1/name> ?name . }"
    } ,
    "homepage" :
    {
        "return" : "array" ,
        "sparql" : "SELECT ?homepage WHERE { <!> <http://xmlns.com/foaf/0.1/homepage> ?homepage . }"
    }
}');

my $storage = new RDF::Redland::Storage("hashes", "test", "new='yes',hash-type='memory'");
my $model   = new RDF::Redland::Model($storage, "");
my $parser  = new RDF::Redland::Parser("rdfxml");
my $uri     = new RDF::Redland::URI('http://tobyinkster.co.uk/');
$parser->parse_into_model($uri, $uri, $model);

my $toby = new WoDo::Person('http://tobyinkster.co.uk/#i', $model);
print $toby->name . "\n";

package WoDo::FACTORY;

use JSON;

sub create_from_json
{
    my ($class, $target_class, $json) = @_;

    my $klass;
    $klass .= sprintf("package WoDo::\%s;\n", $target_class);
    $klass .= sprintf("\@ISA = qw(WoDo::BASE);\n");

    my $methods = from_json($json);
    foreach my $method_name (keys %$methods)
    {
        my $sparql = $methods->{$method_name}->{'sparql'};
        my $return = $methods->{$method_name}->{'return'} || 'objects';

        die "Undefined return type: \"return\".\n"
            unless ($return =~ /^(first|array|objects)$/)
            ;
        die "Diallowed method name: \"$method_name\".\n"
            if $method_name =~ /[^A-Za-z0-9_]/;
        $sparql =~ s/\'/\\\'/g;

        $klass .= "sub $method_name { my (\$self) = \@_; return \$self->_sparql_$return(\'$sparql\'); }\n";
    }

    $klass .= "1;\n";

    eval($klass);
    die $@."\n" if $@;
}

1;

package WoDo::BASE;

use RDF::Redland;

sub new
{
    my ($class, $webid, $graph) = @_;
    my $self = {};

    $self->{webid} = $webid;
    $self->{graph} = $graph;

    bless $self, $class;
}

sub _sparql_first
{
    my ($self, $querystring) = @_;

    $querystring =~ s/<!>/<$self->{webid}>/g;

    my $query = RDF::Redland::Query->new($querystring,
        RDF::Redland::URI->new($self->{webid}),
        undef,
        'sparql');

    my $results = $self->{graph}->query_execute($query);
    RESULT: while (! $results->finished)
    {
        my $node = $results->binding_value(0);
        if ($node->type == $RDF::Redland::Node::Type_Resource)
            { return $node->uri->as_string; }
        elsif ($node->type == $RDF::Redland::Node::Type_Literal)
            { return $node->literal_value; }

        $results->next_result;
    }

    return undef;
}

sub _sparql_array
{
    my ($self, $querystring) = @_;

    $querystring =~ s/<!>/<$self->{webid}>/g;

    my $query = RDF::Redland::Query->new($querystring,
        RDF::Redland::URI->new($self->{webid}),
        undef,
        'sparql');

    my $rv = [];

    my $results = $self->{graph}->query_execute($query);
    RESULT: while (! $results->finished)
    {
        my $node = $results->binding_value(0);
        if ($node->type == $RDF::Redland::Node::Type_Resource)
            { push @$rv, $node->uri->as_string; }
        elsif ($node->type == $RDF::Redland::Node::Type_Literal)
            { push @$rv, $node->literal_value; }

        $results->next_result;
    }

    return $rv;
}

sub _sparql_objects
{
    my ($self, $querystring) = @_;

    $querystring =~ s/<!>/<$self->{webid}>/g;

    my $query = RDF::Redland::Query->new($querystring,
        RDF::Redland::URI->new($self->{webid}),
        undef,
        'sparql');

    my $rv = [];

    my $results = $self->{graph}->query_execute($query);
    RESULT: while (! $results->finished)
    {
        my $row = {};
        for (my $i=0; $i < $results->bindings_count(); $i++)
        {
            my $name = $results->binding_name($i);
            my $node = $results->binding_value($i);

            if ($node->type == $RDF::Redland::Node::Type_Resource)
                { $row->{$name} = $node->uri->as_string; }
            elsif ($node->type == $RDF::Redland::Node::Type_Literal)
                { $row->{$name} = $node->literal_value; }
        }
        push @$rv, $row;
    }

    return $rv;
}

1;