view release on metacpan or  search on metacpan

Ent.pm  view on Meta::CPAN

        "UNIQUE (id, nm)",
        ],
    rel => [
        "id int unsigned not null",     # FK: ent
        "pid int unsigned not null",    # parent id
        "type char(4)",                 # relationships can be codified
        "i int",                        # and/or enumerated
        "UNIQUE  (id, pid, type, i)",
        ],
    xattr => [
        "id int unsigned not null",     # FK: ent
        "type char(4)",
        "s  text",                      # ascii blob
        "FULLTEXT (s)",
        ],
    );

while (my ($tab, $cols) = each %tabs) {
    $tabs{$tab} = {};
    for (@$cols) {
        my ($nm, $def) = /^(\w+)\s*(.*)/i;
        if ($nm eq uc($nm)) {
            push @{$tabs{$tab}{mods}}, "$nm $def";
            next;
            }
        $tabs{$tab}{cols}{$nm}{def} = $def;
        $tabs{$tab}{cols}{$nm}{quote} ||= $def =~ /$_/i for @QDTT;
        }
    }

sub OK { 1; }

# --- exported module interface -----------------------------------------------

=head2 <db, err> = new [pass-through]

Used to generate a datastore connection object.  Any optional arguments passed may be used to create and configure the connection.  The method returns a list containing a blessed object, a numeric error code, and a human legible error string.

If the object is set to I<undef> the caller should check the error values, else the returned object may be used to access the methods listed below:

=cut

sub new {
    my $self = shift;
    return unless $self->dbc(&DB::Ent::args);

    $self->{dups} ||= $DB::Ent::DUPSWARN;
    $self->{dbh}->{PrintError} = 0;     # we'll display errors
    $self->{dbh}->trace(2, $self->{trace})
        if $self->{trace};

    OK;
    }

sub dbc {
    my $self = shift;
    %$self = (%$self, @_);

    $self->{proto} ||= "mysql";
    $self->{srv}   ||= "localhost";
    $self->{usr}   ||= (getpwuid($>))[0];
    $self->{pwd}   ||= "";
    $self->{dbn}   ||= "";

    my $dsn = join ":", "DBI", @{$self}{qw/proto dbn srv/};
    $self->{dbh} = DBI->connect($dsn, $self->{usr}, $self->{pwd});
    @{$self}{qw/err errstr/} = ($?, $!);

    !$?;
    }

=head2 <ok> = init

Used to create an entity schema this method must be called with extreme care as it will first destroy an existing schema, including all data.  Before this method may be called, a connection to the datastore must be established.

Typically it is not necessary for users to call this method directly since the B<new> method will call it if it detects that the datastore has not been initialised.

The storage element types (in the nomenclature of this driver these are database tables) created are named: I<ent>, I<attr>, I<rel>, and I<xattr>.  The B<nm> parameter to the various methods offered by this module must receive one of these values.

This method takes no arguments and returns a success flag.

=cut

sub init {
    my $self = shift;
    my %args = @_;
    for (keys %tabs) {
        $self->x("DROP TABLE IF EXISTS $_") if $args{DROP};
        $self->tabmk() || return;
        }
    OK;
    }

=head2 <id> = ins <nm> <attr-hashref> [filt-hashref]

Creates a new entry of the type indicated by the first argument passed (see docs for the I<init()> method above for a review of valid names).  Attributes must be passed in a hash reference and must match those allowed by the element type.

The return value consists of the id of the new entry; in case of failure error information is returned.

B<Note:> For signature compatibility with I<upd()>, this method accepts a filter hash reference whose keys are added to the I<attr-hashref>.  This makes for easy upserts!

=cut

# needs to support upserts and coderefs for values

sub ins {
    my ($self, $nm, $args, $filt) = @_;
    my (@cols, @vals);
    $args = {%$args, %$filt} if ref($filt) eq "HASH";
    for (keys %$args) {
        push @cols, $_;
        push @vals, $tabs{$nm}{cols}{$_}{quote}
            ? $self->q($args->{$_})
            : $args->{$_}
            ;
        }

    $self->x(
        sprintf("INSERT INTO $nm (%s) VALUES (%s)",
            join(",", @cols),
            join(",", @vals),