use Perl

Okay, so we have this problem. Databasing objects is a pain in the arse. You have to know about fields and relationships, and all that guff before you can begin, so an object oriented database would be very nice. Basically I want to be able to take objects that look roughly like:

$object = bless({
        _oid => 1,
        width => bless({
                _oid => 2,
                cm => 10,
          }, "Length"
        ),
        height => bless( {
                _oid => 3,
                cm => 23,
        }, "Length",
      ),
    }, "Square"
);


Store them in a database like:

$db->insert( $object );

and then run queries against the database like:

$aref = $db->get(q{ref($this) eq 'Length'});

to get a list of all objects that match the criteria.

Its a difficult nut to crack, because its hard to know what lies in deep data structures. But I think that this implmentation (redefining bless is the key), with optimisation, could be a winner. Now, a little bit more work needs doing. For instance, a class needs to be written to provide objects with ids automagically (or maybe a helper method), but the priciples seem work okay. (EMORETESTINGREQUIRED)

package OODB;

use strict;
use warnings::register;

use DB_File;
use Storable qw ( freeze thaw );
use Scalar::Util qw ( blessed );
use Data::Dumper;

sub new {
    my $class = shift;
    my %objects;
    tie %objects, 'DB_File', "myoodb.oo";
    my $self = {
                      objects => \%objects,
                    };
    bless $self, $class;
}

sub get {
    my $self = shift;
    my $q = shift;
    my $r = parseQuery( $q );
    my @myobjects;
    {
        no warnings;
        foreach my $d (values %{$self->{objects}}) {
            my $that = thaw( $d );
            my $this = $that->{object};
            if(eval "if ( $q ) { return 1; } return 0;") {
        push @myobjects, $this;
            }
        }
    }

    ## okay, we have the that we want to load, now we need to reverse
    ## our insert to make sure that everything we get out is from
    ## a toplevel.
    use subs qw ( bless );
    {
        my $d = Dumper( \@myobjects );
        local *bless = sub {
            my $struct = shift;
            my $class = shift;
            my $oid = $struct->{_oid};
            my $list = thaw( $self->{objects}->{ $oid } );
            foreach my $key (keys %{$list->{object}}) {
        if ($struct->{$key} ne $list->{object}->{$key} && !blessed($list->{object}->{$key})) {
            $struct->{$key} = $list->{object}->{$key};
        }
            }
            return CORE::bless($struct,$class);
        };
        my $VAR1;
        eval $d;
        return $VAR1;
    }
}

sub parseQuery {
    return $_[0];
}

sub insert {
    my $self = shift;
    my $struct = shift;
    my $sid = $struct->{_oid};
    my $d = Dumper( $struct );
    use subs qw ( bless );
    {
        local *bless = sub {
            my $obj = CORE::bless($_[0], $_[1]);
            my $hash = {
                    _oid => $_[0]->{_oid},
                    object => $obj,
                    class => $_[1],
                  };
            my $data = freeze( $hash );
            $self->{objects}->{ $_[0]->{_oid} } = $data;
            return $obj;
        };
        my $VAR1;
        eval $d;
        if ($@) {
            print "Could not insert: $@\n";
        }
    }
}

1;