TM::ResourceAble::MemCached - Topic Maps, Memcached server backend

TM documentation Contained in the TM distribution.

Index

Code Index:

NAME

Top

TM::ResourceAble::MemCached - Topic Maps, Memcached server backend

SYNOPSIS

Top

    use TM::ResourceAble::MemCached;
    use Fcntl;
    # create/reset new map
    my $tm = new TM::ResourceAble::MemCached (
                baseuri => 'http://whereever/', 
		servers => [ localhost:11211 ],
		mode    => O_TRUNC | O_CREAT,
	     );

    # use TM interface

    # open existing map
    my $tm = new TM::ResourceAble::MemCached (
                 baseuri => 'http://whereever/', 
		 servers => [ localhost:11211 ],
             );

DESCRIPTION

Top

This package implements TM using a memcached server farm as backend. You should be able (without much testing, mind you, so it is EXPERIMENTAL) to perform all operations according to the TM interface.

NOTE: The implementation is using the TIE technique (perltie via Tie::StdHash), so maybe there are problems lurking.

Of course, a set of memcacheds can store any number of maps. To keep them separate, the baseuri is used, so make sure every map gets its own baseuri.

INTERFACE

Top

Constructor

The constructor expects a hash with the following keys:

servers (default: none)

The value must be a reference to an array of strings, each of the form host:port. If there is no such list, then the constructor will fail.

mode (default: O_CREAT)

The value must be a value from Fcntl to control

whether the map should be created (O_CREAT) when it does not exist, and/or

whether the map should be cleared (O_TRUNC) when it existed before.

All other options are passed to the constructor chain of traits (TM::ResourceAble) and superclasses (TM).

SEE ALSO

Top

TM, TM::ResourceAble

AUTHOR INFORMATION

Top

Copyright 2010, Robert Barta <drrho@cpan.org>, All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. http://www.perl.com/perl/misc/Artistic.html

TM documentation Contained in the TM distribution. 
package TM::ResourceAble::MemCached::mid2iid;

use Tie::Hash;
use base qw(Tie::StdHash);

sub TIEHASH {
    my $class = shift;
    my $memd = shift;

#    warn "TIEHASH toplet";
    my $self = bless { memd => $memd }, $class;
    $self->{mid2iid} = $self->{memd}->get ("mid2iid_all");
    return $self;
}

sub STORE {
    my ($self, $key, $val) = @_;
#    warn "STORE toplet $key";
    $self->{memd}->set ("mid2iid:$key", $val);
    $self->{mid2iid}->{$key}++;
}

sub FETCH {
    my ($self, $key) = @_;
#    warn "FETCH toplet $key";
    return $self->{memd}->get ("mid2iid:$key");
}

sub FIRSTKEY {
    my ($self) = @_;
#    warn "FIRSTKEY toplet";
    my $a = keys %{$self->{mid2iid}};          # reset each() iterator
    each %{$self->{mid2iid}}
}

sub NEXTKEY {
    my ($self, $key) = @_;
#    warn "NEXTKEY toplet $key";
    return each %{$self->{mid2iid}}
}

sub DESTROY {
    my ($self) = @_;
#    warn "DESTROYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY";

#    warn Dumper $self->{assertions};
    $self->{memd}->set ("mid2iid_all", $self->{mid2iid});
}

1;

package TM::ResourceAble::MemCached::assertions;

use Tie::Hash;
use base qw(Tie::StdHash);

use Data::Dumper;

sub TIEHASH {
    my $class = shift;
    my $memd = shift;

#    warn "TIEHASH assert";
    my $self = bless { memd => $memd }, $class;
    $self->{assertions} = $self->{memd}->get ("assertions_all");
#    warn "after tie ".Dumper $self->{assertions};
    return $self;
}

sub STORE {
    my ($self, $key, $val) = @_;
#    warn "STORE assert $key";
    $self->{memd}->set ("assertions:$key", $val);
    $self->{assertions}->{$key}++;
}

sub FETCH {
    my ($self, $key) = @_;
#    warn "FETCH assert $key";
    return $self->{memd}->get ("assertions:$key");
}

sub FIRSTKEY {
    my ($self) = @_;
#    warn "FIRSTKEY assert";
    my $a = keys %{$self->{assertions}};          # reset each() iterator
    each %{$self->{assertions}}
}

sub NEXTKEY {
    my ($self, $key) = @_;
#    warn "NEXTKEY assert $key";
    return each %{$self->{assertions}}
}

sub DESTROY {
    my ($self) = @_;
#    warn "DESTROYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY";
#    warn Dumper $self->{assertions};
    $self->{memd}->set ("assertions_all", $self->{assertions});
}

1;

package TM::ResourceAble::MemCached::main;

use Tie::Hash;
use base qw(Tie::StdHash);

use Data::Dumper;

sub TIEHASH {
    my $class = shift;
    my $memd = shift;

#    warn "TIEHASH main";
    return bless { memd => $memd }, $class;
}

sub FETCH {
    my ($self, $key) = @_;
#    warn "main FETCH $key";
    if ($key eq 'assertions') {
	$self->{__assertions} ||= {};
	return $self->{__assertions};

    } elsif ($key eq 'mid2iid') {
	$self->{__mid2iid} ||= {};
	return $self->{__mid2iid};

    } else {
	return $self->{memd}->get ($key);
    }
}

sub STORE {
    my ($self, $key, $val) = @_;
#    warn "main STORE $key";
    if ($key eq 'assertions') {
	$self->{__assertions} = $val;

    } elsif ($key eq 'mid2iid') {
	$self->{__mid2iid} = $val;

    } else {
	$self->{memd}->set ($key, $val);
    }
}

1;

package TM::ResourceAble::MemCached;

use strict;
use warnings;

use Data::Dumper;

use TM;
use base qw(TM);
use Class::Trait qw(TM::ResourceAble);


sub new {
    my $class = shift;
    my %options = @_;

    my $servers = delete $options{servers} || die "no servers specified";
    use Fcntl;
    my $mode    = delete $options{mode}    || O_CREAT;
    my $tmp     = bless $class->SUPER::new (%options), $class;

    use Cache::Memcached;
    my $memd = new Cache::Memcached {
	'servers'   => $servers,
	'namespace' => $tmp->baseuri,
    };

    my %self;
    tie %self,                  'TM::ResourceAble::MemCached::main',       $memd;
    tie %{ $self{assertions} }, 'TM::ResourceAble::MemCached::assertions', $memd;
    tie %{ $self{mid2iid} },    'TM::ResourceAble::MemCached::mid2iid',    $memd;

#    warn "in new ".Dumper \%self;

    if ($self{baseuri}) {                                                        # there are already values there
	if ($mode & O_TRUNC) {                                                   # if we want an empty slate
	    $self{assertions} = {};
	    map { $self{assertions}->{$_} = $tmp->{assertions}->{$_} }
		    keys %{ $tmp->{assertions} };
	    $self{mid2iid} = {};
	    map { $self{mid2iid}->{$_} = $tmp->{mid2iid}->{$_} }
		    keys %{ $tmp->{mid2iid} };
	}

    } elsif ($mode & O_CREAT) {                                                  # careful cloning from prototypical TM
        foreach my $k (keys %$tmp) {
	    if ($k eq 'assertions') {
		map { $self{assertions}->{$_} = $tmp->{assertions}->{$_} }
		    keys %{ $tmp->{assertions} };

	    } elsif ($k eq 'mid2iid') {
		map { $self{mid2iid}->{$_} = $tmp->{mid2iid}->{$_} }
		    keys %{ $tmp->{mid2iid} };

	    } else {
		$self{$k} = $tmp->{$k};
	    }
        }
    } else {
	die "no map on servers";
    }

    return bless \%self, $class;
}


our $VERSION  = '0.02';

1;

__END__