view release on metacpan or  search on metacpan

Laces.pm  view on Meta::CPAN

	# it's a statement!
	printf "<%s> <%s>", $self, $self->{prefix} . $meth;
	my $i = 0;
	for my $obj (@_) {
	    printf "," if $i++;
	    if(ref $obj and $obj->isa(__PACKAGE__)) {
		printf " <%s>", $obj;
	    } else {
		printf ' "%s"', $obj;
	    }
	}
	printf " .\n";
	return $self;   # allow more statements!
    }


    # if in list context, it's a query!

    # if in void context, SET the prefix inplace
    unless(defined wantarray) {
	$self->{prefix} = $self->{prefixes}{$meth} || '';
	return;
    }
    
    unless(wantarray) {
	# scalar context!
	return $self->new(
	    %$self,
	    prefix => $self->{prefixes}{$meth},
	    root => $self->{prefixes}{$meth}
	);
    }

    return;
}

package RDF::Laces::Impl;

sub cat {
    my($self, $path, $reverse) = @_;
    $path = URI::Escape::uri_escape($path);
    return $self->new(
	%$self,
	path => $reverse ? "$path" . "$self" : "$self" . "$path"
    );
}

sub catdir {
    my($self, $path, $reverse) = @_;
    my $newpath = $self->{path};
    # I wanna support reverse?
    $newpath =~ s#/*$#'/' . URI::Escape::uri_escape($path)#e;
    return $self->new(
	%$self,
	path => $newpath
    );
}

sub get {
    my $self = shift;
    my $caller = (caller)[0];
    return $self if $caller->isa(__PACKAGE__) || $caller->isa('RDF::Laces');

    # return a tied hash which does.... things
    my %hash;
    tie %hash, 'RDF::Laces::Tie', $self;
    return \%hash;
}

my $anonidx = 0;
sub resource {
    my $self = shift;
    return sub {
        my $path = shift || ("_:anon" . ++$anonidx);
	return $self->new(%$self, path => $path);
    }
}

sub uri {
    return shift->{path};
}

sub addprefix {
    my($self, $prefix, $uri) = @_;
    $self->{prefixes}{$prefix} = $uri;
}

sub withfragment {
    my $self = shift;
    my $frag = shift;
    my $base = $self->{root} || $self->{path};

    return $self->new(
	%$self,
	root => $base,
	path => $base . $frag
    );
}

package RDF::Laces::Tie;
use base qw(Tie::Hash);

sub TIEHASH {
    my $class = shift;
    my $inst = shift;
    my $self = bless { inst => $inst }, ref $class || $class;
    return $self;
}

sub FETCH {
    my $self = shift;
    my $key = shift;
    RDF::Laces::Impl::withfragment($self->{inst}, $key);
}

sub STORE {
    my $self = shift;
    my $key = shift;
    my $value = shift;
    RDF::Laces::Impl::addprefix($self->{inst}, $key, $value);
}