head	1.8;
access;
symbols;
locks; strict;
comment	@# @;


1.8
date	2003.05.05.19.03.00;	author rse;	state Exp;
branches;
next	1.7;

1.7
date	2003.05.05.11.56.12;	author rse;	state Exp;
branches;
next	1.6;

1.6
date	2003.05.05.11.16.26;	author rse;	state Exp;
branches;
next	1.5;

1.5
date	2003.04.26.20.27.46;	author rse;	state Exp;
branches;
next	1.4;

1.4
date	2003.04.26.18.47.54;	author rse;	state Exp;
branches;
next	1.3;

1.3
date	2003.04.24.11.17.16;	author rse;	state Exp;
branches;
next	1.2;

1.2
date	2003.04.23.09.04.07;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2003.03.07.20.30.45;	author rse;	state Exp;
branches;
next	;


desc
@@


1.8
log
@flush more work of this afternoon
@
text
@##
##  AS -- Accounting System
##  Copyright (c) 2002-2003 Cable & Wireless Deutschland <http://www.cw.com/de/>
##  Copyright (c) 2002-2003 Ralf S. Engelschall <rse@@engelschall.com>
##
##  This file is part of AS, an accounting system which can be
##  found at http://as.is.eu.cw.com/
##
##  This program is free software; you can redistribute it and/or
##  modify it under the terms of the GNU General Public License
##  as published by the Free Software Foundation; either version
##  2.0 of the License, or (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
##  General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
##  USA, or contact The OSSP Project <ossp@@ossp.org>.
##
##  as_db.pm: AS Database Management API
##

require 5.006;
require Exporter;

use strict;

##  _________________________________________________________________________
##
##  AS::DB -- AS Database Management
##  _________________________________________________________________________
##

package AS::DB;

use IO::File;
use DBI;
use DBD::Pg;

@@AS::DB::ISA       = qw(Exporter);
@@AS::DB::EXPORT_OK = qw(new destroy DESTROY attr schema_create schema_destroy db_connect db_handle db_disconnect);

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);

    $self->{'dbh'} = undef;

    $self->{'attr'} = {
        'su_username' => 'postgresql',
        'su_password' => 'postgresql',
        'su_database' => 'template1',
        'as_username' => 'as',
        'as_password' => 'as',
        'as_database' => 'as',
        'as_expiring' => '+4y',
        'db_schema'   => 'as_db.sql',
        'db_host'     => '',
        'db_port'     => '',
    };

    return $self;
}

sub destroy {
    my $self = shift;
    return;
}

sub DESTROY {
    my $self = shift;
    $self->destroy;
    return;
}

sub attr {
    my $self = shift;
    my $name = shift;
    my $value = shift;

    if (not defined($name)) {
        #   get names of existing attributes
        return sort(keys(%{$self->{'attr'}}));
    }
    elsif (not defined($value)) {
        #   get value of attribute
        return $self->{'attr'}->{$name};
    }
    else {
        #   set value of attribute
        my $old_value = $self->{'attr'}->{$name};
        $self->{'attr'}->{$name} = $value;
        return $old_value;
    }
}

sub _connect {
    my $self = shift;
    my $us_id = shift;
    my $db_id = shift;

    my $username = (  $us_id eq 'su' 
                    ? $self->{'attr'}->{'su_username'}
                    : $self->{'attr'}->{'as_username'});
    my $password = (  $us_id eq 'su' 
                    ? $self->{'attr'}->{'su_password'}
                    : $self->{'attr'}->{'as_password'});
    my $database = (  $db_id eq 'su'
                    ? $self->{'attr'}->{'su_database'} 
                    : $self->{'attr'}->{'as_database'});

    my $source = "dbi:Pg:dbname=$database";
    if ($self->{'attr'}->{'db_host'}) {
        $source .= ";host=" . $self->{'attr'}->{'db_host'};
    }
    if ($self->{'attr'}->{'db_port'}) {
        $source .= ";port=" . $self->{'attr'}->{'db_port'};
    }

    my $db;
    ($db = DBI->connect($source, $username, $password)) 
        || die "unable to connect to database \"$database\" as user \"$username\"";
    $db->{AutoCommit} = 0;
    $db->{RaiseError} = 1;

    return $db;
}

sub schema_create {
    my $self = shift;

    #   check for disconnected state
    if (defined($self->{'dbh'})) {
        die "you are still connected to database -- have to disconnect first";
    }

    #   read external PL/pgSQL schema definition
    print STDERR "<".$self->{'attr'}->{'db_schema'}."\n";
    my $io = new IO::File "<".$self->{'attr'}->{'db_schema'}
        || die "unable to read PL/pgSQL schema definition file \"" . 
               $self->{'attr'}->{'db_schema'} . "\"";
    my $sql; { local $/ = undef; $sql = (<$io>); }
    $io->close;

    #   replace attribute variables in SQL statements
    foreach my $var (keys(%{$self->{'attr'}})) {
        $sql =~ s|\@@${var}\@@|$self->{'attr'}->{$var}|sg;
    }

    #   extract comments and annotate SQL "CREATE TABLE" and "CREATE FUNCTION"
    #   statements with the corresponding PL/pgSQL "COMMENT ON TABLE|COLUMN|FUNCTION"
    #   statements
    my $do = $sql;
    $do =~ s|\n--[ \t]+([^\n]+)\nCREATE\s+TABLE\s+(\S+)\s+\((.+?\n)\);|&do_tab($1, $2, $3), ''|sge;
    $do =~ s|\n--[ \t]+([^\n]+)\nCREATE\s+SEQUENCE\s+(\S+)\s+(.+?);|&do_seq($1, $2, $3), ''|sge;
    $do =~ s|\n--[ \t]+([^\n]+)\nCREATE\s+FUNCTION\s+([a-zA-Z][a-zA-Z0-9_]*(?:\s*\(.*?\))?).*?\s+AS\s+'(.+?\n)';|&do_fct($1, $2, $3), ''|sge;
    sub do_tab {
        my ($comment, $table, $do) = @@_; 
        $comment =~ s|^\s*(.+?)\s*$|$1|s;
        my $C = {};
        $do =~ s|\n\s+(\S+)\s+(.+?)\n\s+--\s+([^\n]+(\n\s+--\s+[^\n]+)*)|&do_col($C, $1, $2, $3), ''|sge;
        sub do_col {
            my ($C, $field, $type, $comment) = @@_; 
            $comment =~ s|\s*\n\s*(--\s*)?| |sg;
            $comment =~ s|\s+| |sg;
            $comment =~ s|^\s*(.+?)\s*$|$1|s;
            $C->{$field} = $comment;
        }
        my $com = "COMMENT ON TABLE $table\n" .
                  "    IS '$comment';\n";
        foreach my $field (sort(keys(%{$C}))) {
            my $comment = $C->{$field};
            $com .= "COMMENT ON COLUMN $table.$field\n" .
                    "    IS '$comment';\n";
        }
        $sql =~ s|(CREATE\s+TABLE\s+$table\s+\(.+?\n\);)|$1\n$com|s;
    }
    sub do_seq {
        my ($comment, $sequence, $do) = @@_; 
        $comment =~ s|^\s*(.+?)\s*$|$1|s;
        my $com = "COMMENT ON SEQUENCE $sequence\n" .
                  "    IS '$comment';\n";
        $sql =~ s|(CREATE\s+SEQUENCE\s+$sequence\s+.+?;)|$1\n$com|s;
    }
    sub do_fct {
        my ($comment, $function, $do) = @@_; 
        $comment =~ s|^\s*(.+?)\s*$|$1|s;
        my $com = "COMMENT ON FUNCTION $function\n" .
                  "    IS '$comment';\n";
        $function = quotemeta($function);
        $sql =~ s|(CREATE\s+FUNCTION\s+$function.*?\s+AS\s+'.+?\n';)|$1\n$com|s;
    }

    #   remove the comments from the original PL/pgSQL script
    $sql =~ s|^\s*--\s+.+$||mg;
    $sql =~ s|\n+|\n|sg;

    #   determine AS account expiring
    my $as_expiring = $self->{'attr'}->{'as_expiring'};
    if ($as_expiring =~ m|^\+(\d+)([dmy])$|) {
        my ($num, $unit) = ($1, $2);
        if    ($unit eq 'd') { $num *= 60*60*24;     }
        elsif ($unit eq 'm') { $num *= 60*60*24*31;  }
        elsif ($unit eq 'y') { $num *= 60*60*24*365; }
        my $expires = time() + $num;
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($expires);
        $as_expiring = sprintf("%04d-%02d-%02d 00:00:00", $year+1900, $mon+1, $mday);
    }

    #   connect as super-user to super-user database
    my $db = &_connect($self, "su", "su");

    #   perform super-user transaction (on super-user database)
    $db->{AutoCommit} = 1;
    eval {
        #   create new AS user
        $db->do(sprintf(
            "CREATE USER \"%s\" WITH" .
            "  VALID UNTIL '%s'" .
            "  ENCRYPTED PASSWORD '%s'" .
            "  NOCREATEDB NOCREATEUSER;", 
            $self->{'attr'}->{'as_username'},
            $as_expiring,
            $self->{'attr'}->{'as_password'}
        ));
    };
    if ($@@) {
        die "operation aborted because $@@";
    }
    eval {
        #   create new AS database
        $db->do(sprintf(
            "CREATE DATABASE \"%s\";",
            $self->{'attr'}->{'as_database'}
        ));
    };
    if ($@@) {
        die "operation aborted because $@@";
    }

    #   reconnect as super-user to AS database
    $db->disconnect;
    $db = &_connect($self, "su", "as");

    #   perform super-user transaction (on AS database)
    $db->{AutoCommit} = 1;
    eval {
        #   add manual comment on AS database
        $db->do(sprintf(
            "COMMENT ON DATABASE \"%s\" IS 'Accounting System';",
            $self->{'attr'}->{'as_database'}
        ));
        #   activate PL/pgSQL as procedural language in AS database
        $db->do(
            "CREATE FUNCTION plpgsql_call_handler ()" .
            "  RETURNS LANGUAGE_HANDLER" .
            "  AS '\$libdir/plpgsql' " .
            "  LANGUAGE C;" .
            "COMMENT ON FUNCTION plpgsql_call_handler ()" .
            "  IS 'PL/pgSQL Call Handler';" .
            "CREATE TRUSTED PROCEDURAL LANGUAGE plpgsql" .
            "  HANDLER plpgsql_call_handler;"
        );
    };
    if ($@@) {
        die "operation aborted because $@@";
    }

    #   reconnect as AS user to AS database
    $db->disconnect;
    $db = &_connect($self, "as", "as");

    #   perform AS user transaction (on AS database)
    eval {
        #   create AS database schema by executing individual
        #   PL/pgSQL statements from external definition
        $db->do($sql);

        $db->commit;
    };
    if ($@@) {
        $db->rollback;
        die "transaction aborted because $@@";
    }

    #   initialize database
    eval {
        #   initialize as_config table
        $db->do("INSERT INTO as_config (cf_var, cf_val)" .
                "  VALUES ('version', '0.5.0');");
        $db->do("INSERT INTO as_config (cf_var, cf_val)" .
                "  VALUES ('created', now());");

        #   initialize as_epoch table
        #   (with epoch borders)
        $db->do("INSERT INTO as_epoch (ep_epoch, ep_begin)" .
                "  VALUES (0, '-infinity');");
        $db->do("INSERT INTO as_epoch (ep_epoch, ep_begin)" .
                "  VALUES (as_epoch_max(), 'infinity');");

        #   initialize as_account table
        #   (with root account)
        $db->do("INSERT INTO as_epoch (ep_begin) VALUES (now());");
        $db->do("INSERT INTO as_oid (id_type) VALUES ('account');");
        $db->do("INSERT INTO as_account" .
                "  (ac_oid, ac_parent, ac_name, ac_description, ac_abstract," .
                "   ac_diversion, ac_epoch_start, ac_epoch_end)" .
                "  VALUES" .
                "  (as_oid_current(), as_oid_current(), '', 'Root Account', 'true'," .
                "   as_oid_current(), as_epoch_current(), as_epoch_max());");

        #   log database creation
        $db->do("INSERT INTO as_log (lg_entry)" .
                "  VALUES ('initial database creation');");

        $db->commit;
    };
    if ($@@) {
        $db->rollback;
        die "transaction aborted because $@@";
    }

    #   disconnect from database
    $db->disconnect;
}

sub schema_destroy {
    my $self = shift;

    #   check for disconnected state
    if (defined($self->{'dbh'})) {
        die "you are still connected to database -- have to disconnect first";
    }

    #   connect as super-user to super-user database
    my $db = &_connect($self, "su", "su");
    $db->{AutoCommit} = 1;

    #   perform super-user transaction (on super-user database)
    $db->do(sprintf("DROP DATABASE \"%s\";", $self->{'attr'}->{'as_database'}));
    $db->do(sprintf("DROP USER \"%s\"\;", $self->{'attr'}->{'as_username'}));

    #   disconnect from database
    $db->disconnect;
}

sub db_connect {
    my $self = shift;

    #   check for disconnected state
    if (defined($self->{'dbh'})) {
        die "you are already connected to database -- have to disconnect first";
    }

    #   connect as AS user to AS database
    $self->{'dbh'} = &_connect($self, "as", "as");
}

sub db_handle {
    my $self = shift;
    return $self->{'dbh'};
}

sub db_disconnect {
    my $self = shift;

    #   check for connected state
    if (not defined($self->{'dbh'})) {
        die "you are still not connected to database -- have to connect first";
    }

    #   disconnect  
    $self->{'dbh'}->disconnect;
    $self->{'dbh'} = undef;
}

sub account {
    my $self = shift;

    if (@@_) {
        my %attr = @@_;
        my @@ac = ();
        my $dbh = $self->db_handle
            or die "unable to retrieve database handle";
        my $query = '';
        foreach my $name (sort(keys(%attr))) {
            $query .= " AND" if ($query ne '');
            $query .= " as_${name} = '".&AS::DB::Util::sql_escape($attr{$name})."'";
        }
        my $rv = $dbh->selectall_hashref(sprintf("SELECT * FROM as_account WHERE %s", $query), 'ac_oid')
            or die "unable to fetch FIXME";
        foreach my $oid (sort(keys(%{$rv}))) {
            my $ac = new AS::DB::Account ($self);
            #   FIXME?
            print STDERR "oid=<$oid>:\n";
            foreach my $a (sort(keys(%{$rv->{$oid}}))) {
                print "  <$a>=<".$rv->{$oid}->{$a}.">\n";
                $ac->set($a => $rv->{$oid}->{$a});
            }
            push(@@ac, $ac);
        }
        return @@ac;
    }
    else {
        my $ac = AS::DB::Account->new($self);
        return $ac;
    }
}

##  _________________________________________________________________________
##
##  AS::DB::Util -- AS Database Utilities
##  _________________________________________________________________________
##

package AS::DB::Util;

sub sql_escape {
    my ($str) = @@_;
    $str =~ s|\'|\''|sg; # vim
    return $str;
}

##  _________________________________________________________________________
##
##  AS::DB -- AS Database Management
##  _________________________________________________________________________
##

package AS::DB::Account;

@@AS::DB::Account::ISA       = qw(Exporter);
@@AS::DB::Account::EXPORT_OK = qw(new destroy DESTROY attr sync);

sub _make_attr {
    my %attr = @@_;
    my $a = {};
    if (defined(%attr)) {
        foreach my $name (keys(%attr)) {
            $a->{$name} = [ $attr{$name}, undef ];
        }
    }
    return $a;
}

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $as    = shift;

    my $self = {};
    bless ($self, $class);

    $self->{'as'}   = $as;
    $self->{'attr'} = {};

    return $self;
}

sub destroy {
    my $self = shift;
    return;
}

sub DESTROY {
    my $self = shift;
    $self->destroy;
    return;
}

sub attr {
    my $self = shift;
    my @@args = @@_;

    if (not defined(@@args)) {
        #   get names of existing attributes
        return sort(keys(%{$self->{'attr'}}));
    }
    else {
        my $rv = undef;
        while (@@args) {
            my $name  = shift(@@args);
            $name =~ s|^-||s;
            my $value = shift(@@args);
            if (not defined($value)) {
                #   get value of attribute
                $rv = $self->{'attr'}->{$name}->[1] 
                   || $self->{'attr'}->{$name}->[0];
            }
            else {
                #   set value of attribute
                if (not defined($self->{'attr'}->{$name})) {
                    $self->{'attr'}->{$name} = [ undef, undef ];
                }
                my $old_value = $self->{'attr'}->{$name}->[1] 
                             || $self->{'attr'}->{$name}->[0];
                $self->{'attr'}->{$name}->[1] = $value;
                $rv = $old_value;
            }
        }
        return $rv;
    }
}

sub sync {
    my $self = shift;

    my $attr = $self->{'attr'};
    my $stmt = '';
    if (not defined($attr->{'oid'})) {
        ##
        ##   create new account
        ##
        my $db = $self->{'as'}->db_handle
            or die "unable to retrieve database handle";
        eval {
            #   start new epoch
            $db->do("INSERT INTO as_epoch (ep_begin) VALUES (now());");

            #   iterate over parent accounts and make sure they exist
            #   (if not, create intermediate ones as abstract accounts)
            my $name = $self->attr(-name);
            if ($name !~ m/^(\/[^\/]+)+$/) {
                die "invalid account name \"$name\"";
            }
            my @@name = split(/\//, $name);
            my ($parent) = $db->selectrow_array(
                "SELECT ac_oid FROM as_account" .
                "  WHERE ac_name = '' AND ac_parent = ac_oid;"
            );
            for (my $i = 1; $i <= ($#name-1); $i++) {
                my ($this) = $db->selectrow_array(sprintf(
                    "SELECT ac_oid FROM as_account" .
                    "  WHERE ac_name = '%s' AND ac_parent = '%s';",
                    $name[$i], $parent
                ));
                if (not defined($this) or $this eq '') {
                    #   create new OID
                    $db->do("INSERT INTO as_oid (id_type) VALUES ('account');");
                    #   create intermediate account
                    $db->do(sprintf(
                        "INSERT INTO as_account" .
                        "  (ac_oid, ac_parent, ac_name, ac_abstract, " .
                        "   ac_diversion, ac_epoch_start, ac_epoch_end)" .
                        "  VALUES" .
                        "  (as_oid_current(), %s, '%s', 'true'," .
                        "   as_oid_current(), as_epoch_current(), as_epoch_max());",
                        $parent, $name[$i]
                    ));
                    #   determine OID of intermediate account
                    ($this) = $db->selectrow_array(sprintf(
                        "SELECT ac_oid FROM as_account" .
                        "  WHERE ac_name = '%s' AND ac_parent = '%s';",
                        $name[$i], $parent
                    ));
                }
                $parent = $this;
            }

            #   make sure account still does not exist
            my ($this) = $db->selectrow_array(sprintf(
                "SELECT ac_oid FROM as_account" .
                "  WHERE ac_name = '%s' AND ac_parent = '%s';",
                $name[-1], $parent
            ));
            if (defined($this)) {
                die "account already exists";
            }

            #   determine columns/values of new account object
            my $columns = '';
            my $values  = '';
            my $default = {
                'diversion'   => "as_oid_current()", 
            };
            my $enforce = {
                'parent'      => $parent,
                'oid'         => "as_oid_current()", 
                'epoch_start' => "as_epoch_current()",
                'epoch_end'   => "as_epoch_max()",
                'name'        => "'".&AS::DB::Util::sql_escape($name[-1])."'",
            };
            my $sql = {};
            map { $sql->{$_} = $enforce->{$_} 
                            || ($self->{'attr'}->{$_}->[1] ? "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[1])."'" : undef)
                            || ($self->{'attr'}->{$_}->[0] ? "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[0])."'" : undef)
                            || $default->{$_} 
            } (keys(%{$enforce}), keys(%{$self->{'attr'}}), keys(%{$default}));
            foreach my $name (keys(%{$sql})) {
                if (defined($sql->{$name})) {
                    $columns .= "," if ($columns);
                    $columns .= "ac_${name}";
                    $values  .= "," if ($values);
                    $values  .= $sql->{$name};
                }
            }
            if (not $columns) {
                die "missing attributes on new account";
            }

            #   create new OID
            $db->do("INSERT INTO as_oid (id_type) VALUES ('account');");

            #   create new account
            print STDERR "$columns :: $values\n";
            $db->do(sprintf(
                "INSERT INTO as_account (%s) VALUES (%s);",
                $columns, $values
            ));
            
            #   log performed logical operation
            $db->do(sprintf(
                "INSERT INTO as_log (lg_entry) VALUES " .
                "('create new account; oid=' || as_oid_current());"));

            $db->commit;
        };
        if ($@@) {
            $db->rollback;
            die "database operation aborted because $@@";
        }
    }
    else {
        ##
        ##   update existing account
        ##
       # my $set = '';
       # foreach my $name (keys(%{$attr})) {
       #     if ($attr->{$name}->[0] ne $attr->{$name}->[1]) {
       #         $set .= "," if ($set);
       #         $set .= "ac_${name} = '".&AS::DB::Util::sql_escape($attr->{$name})."'";
       #     }
       # }
       # if ($set) {
       #     #   FIXME: later perhaps not all fields trigger a new epoch!
       # }
            #   close current epoch
            #$db->do(sprintf("UPDATE ONLY as_account" .
            #                " SET ac_epoch_end = currval('as_epoch_ep_epoch_seq')" .
            #                " WHERE ac_epoch_end = NULL"));
#
        #   close epoch on current 
        #$stmt .= sprintf("UPDATE ONLY as_account" .
        #                 " SET ac_epoch_end = currval('as_epoch_ep_epoch_seq')" .
        #                 " WHERE ac_epoch_end = INFINITY
        #                 ");
#
#        if ($set) {
#            $stmt .= sprintf("UPDATE ONLY as_account SET %s WHERE ac_oid = '%s';", $set, $attr->{'oid'});
#        }
    }

    return;
}

sub delete {
    my $self = shift;

    # SET CONSTRAINTS all DEFERRED
};

1;

__END__

##  _________________________________________________________________________
##
##  Manual Page
##  _________________________________________________________________________
##

=pod

=head1 NAME

B<AS::DB> - AS Database Management

=head1 DESCRIPTION

This is the Perl/DBI based database management module for the Accounting
System (AS). This is mainly an abstraction and management layer between
the Perl language and the underlying PostgreSQL RDBMS.

=head1 METHODS

=head2 DATABASE MANAGEMENT

Database management methods:

=over 4

=item C<$as = >B<new>C< AS::DB;>

Create management object.

=item C<$as-E<gt>>B<destroy>C<;>

Destroy management object.

=item C<@@attr = $as-E<gt>>B<attr>C<();>

=item C<$value_old = $as-E<gt>>B<attr>C<($name, $value);>

=item C<$value = $as-E<gt>>B<attr>C<($name);>

Set and get management attributes. The following attributes are recognized:

=over 4

=item B<su_username> (default: "postgresql")

Username of PostgreSQL superuser.

=item B<su_password> (default: "postgresql")

Password of PostgreSQL superuser.

=item B<su_database> (default: "template1")

Database for PostgreSQL superuser connections.

=item B<as_username> (default: "as")

Username of PostgreSQL AS user.

=item B<as_password> (default: "as")

Password of PostgreSQL AS user.

=item B<as_database> (default: "as")

Database for PostgreSQL AS user and system.

=item B<as_expiring> (default: "+4y")

Expire time (in absolute PostgreSQL "YYYY-MM-DD HH:MM:SS" time format or
relative /^\+[0-9]+[dmy]$/ format) of PostgreSQL AS user.

=item B<db_schema> (default: "as_db.sql")

Filename of PL/pgSQL based database schema definition script.

=item B<db_host> (default: "")

Host name where PostgreSQL is running for remote connections.

=item B<db_port> (default: "")

Port number where PostgreSQL is running for remote connections.

=back

=item C<$as-E<gt>>B<schema_create>C<();>

=item C<$as-E<gt>>B<schema_destroy>C<();>

=back

=head2 OBJECT MANAGEMENT

=head3 Account Object Management

=over 4

=item C<$ac = $as-E<gt>>B<account>C<;>

Create new empty account object.

=item C<$ac = $ac-E<gt>>B<copy>C<($from);>

Copy account object by duplicating all attributes
except the OID.

=item C<$ac = $as-E<gt>>B<account>C<($name_or_oid, $epoch);>

Fetch single account object.

=item C<@@ac = $as-E<gt>>B<account>C<($name_or_oid, undef);>

Fetch particular account objects from all epochs.

=item C<@@ac = $as-E<gt>>B<account>C<(undef, $epoch);>

Fetch all account objects from single epoch.
If C<$epoch> is "C<max>", the currently active account objects
are fetched only.

=item C<@@ac = $as-E<gt>>B<account>C<(undef, undef);>

Fetch all account objects from all epochs.

=item C<$rc = $as-E<gt>>B<update>C<;>

Refetch last database attribute values. The following table lists the
possible results. In case of a conflict situation the function returns
C<undef>.

 base user last result action
 ---- ---- ---- -------------
 -    -    -    none
 E    -    -    none
 -    S    -    none
 E    S    -    conflict
 -    -    E:B  none
 E    -    E:B  none
 -    S    E:B  none
 E    S    E:B  none
 -    -    E:U  none
 E    -    E:U  none
 -    S    E:U  none
 E    S    E:U  none
 -    -    E:X  none
 E    -    E:X  none
 -    S    E:X  conflict
 E    S    E:X  conflict

=item C<$rc = $as-E<gt>>B<commit>C<;>

Commit pending attribute changes to database. In case of an update
conflict (base epoch is lower than last exiting epoch in database), the
function returns C<undef>.

=item C<$rc = $as-E<gt>>B<sync>C<;>

Just calls B<update> and in case of successful operation
(no conflicts) call B<commit>.

=item C<$as-E<gt>>B<destroy>C<;>

Destroy account object. Pending attribute changes are lost.

=back

ro
  real
  virtual
rw
  trigger new epoch
  not trigger new epoch

  ro
  rw
  re

=head3 Account Object Manipulation

=over 4

=item C<@@attr = $ac-E<gt>>B<attr>C<();>

Get list of attribute names.

=item C<$value_old = $ac-E<gt>>B<attr>C<($name =E<gt> $value>[, ...]C<);>

Set one or more attributes to new value(s). The old value of the
last attribute is given back.

=item C<$value = $ac-E<gt>>B<attr>C<($name>[, C<$revision>]C<);>

Get value of particular attribute. Possible values for C<$revision> are
C<"base"> (value of last successful B<sync> operation), C<"user"> (value
of last attribute set operation), C<"last"> (value of last unsuccessful
B<sync> operation in case of conflict), and C<"auto"> (same as C<"user">
with fallback C<"base"> in case the attribute was not set since the last
B<sync> operation). The default C<$revision> is C<"auto">.

=back

=head3 Event Object Management

=head3 User Object Management

=head3 Group Object Management

=head3 Locality Object Management

=head3 Holiday Object Management

=head1 SEE ALSO

L<as_db.pl>, L<as_db.sql>.

=head1 AUTHOR

Cable & Wireless Germany, Development Team.

=cut

@


1.7
log
@bugfix function parsing
@
text
@d698 1
a698 1
=item C<$as = >B<new>C< as_db;>
d767 1
a767 1
Object management methods:
d771 67
d840 10
a849 1
=head2 OBJECT QUERY
d851 1
a851 1
Object query methods:
d855 18
d874 10
@


1.6
log
@finally get insertion of new account working
@
text
@d162 1
a162 1
    $do =~ s|\n--[ \t]+([^\n]+)\nCREATE\s+FUNCTION\s+(\S+(?:\s*\(.*?\))?).*?\s+AS\s+'(.+?\n)';|&do_fct($1, $2, $3), ''|sge;
@


1.5
log
@just flush my work on AS DB of this evening
@
text
@a519 30
        my $columns = '';
        my $values  = '';
        my $default = {
            'parent'      => "as_oid_current()", 
            'diversion'   => "as_oid_current()", 
        };
        my $enforce = {
            'oid'         => "as_oid_current()", 
            'epoch_start' => "as_epoch_current()",
            'epoch_end'   => "as_epoch_max()",
        };
        my $sql = {};
        map { $sql->{$_} = $enforce->{$_} 
                        || ($self->{'attr'}->{$_}->[1] ? "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[1])."'" : undef)
                        || ($self->{'attr'}->{$_}->[0] ? "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[0])."'" : undef)
                        || $default->{$_} 
        } (keys(%{$enforce}), keys(%{$self->{'attr'}}), keys(%{$default}));
        foreach my $name (keys(%{$sql})) {
            next if ($name eq 'name');
            if (defined($sql->{$name})) {
                $columns .= "," if ($columns);
                $columns .= "ac_${name}";
                $values  .= "," if ($values);
                $values  .= $sql->{$name};
            }
        }
        if (not $columns) {
            die "missing attributes on new account";
        }

d565 41
a605 1
            $name = $name[-1];
d611 1
d613 2
a614 2
                "INSERT INTO as_account (ac_name, %s) VALUES ('%s', %s);",
                $columns, $name, $values
d661 6
@


1.4
log
@comment PL/pgSQL handler and add the new name <-> OID mapping stored procedures
@
text
@d301 1
d307 11
d486 1
d493 2
a494 1
                return $self->{'attr'}->{$name};
d504 1
a504 1
                return $old_value;
d507 1
d523 2
a524 2
            'parent'      => "currval('as_oid_id_oid_seq')", 
            'diversion'   => "currval('as_oid_id_oid_seq')", 
d527 3
a529 3
            'oid'         => "currval('as_oid_id_oid_seq')", 
            'epoch_start' => "currval('as_epoch_ep_epoch_seq')",
            'epoch_end'   => "NULL",
d538 1
a549 2
        #   FIXME: name splitted into name and parent determination

d556 3
a558 2
            #   iterate over parent accounts
            my $name = $self->{'attr'}->{'-name'};
d560 1
a560 1
                die "invalid account name";
d563 31
a593 4
            my $parent = undef;
            for (my $i = 0; $i <= ($#name-1); $i++) {
                my $st = $db->prepare(sprintf("SELECT ac_oid FROM as_account WHERE ac_name = '%s' AND ac_parent = '$parent'"));
                $st->execute;
d595 1
d601 4
a604 2
            print STDERR sprintf("INSERT INTO as_account (%s) VALUES (%s);", $columns, $values)."\n";
            $db->do(sprintf("INSERT INTO as_account (%s) VALUES (%s);", $columns, $values));
d607 3
a609 2
            $db->do(sprintf("INSERT INTO as_log (lg_entry) VALUES " .
                            "('create new account; oid=' || currval('as_oid_id_oid_seq'));"));
@


1.3
log
@activate PL/pgSQL; create new as_epoch_max() stored procedure; convert to BIGSERIAL
@
text
@d265 2
@


1.2
log
@flush pending changes
@
text
@d156 3
a158 2
    #   extract comments and annotate SQL "CREATE TABLE" statements
    #   with the corresponding PL/pgSQL "COMMENT ON TABLE|COLUMN" statements
d160 1
d162 2
a163 2
    $do =~ s|\n--[ \t]+([^\n]+)\nCREATE\s+TABLE\s+(\S+)\s+\((.+?\n)\);|&do1($1, $2, $3), ''|sge;
    sub do1 {
d167 2
a168 2
        $do =~ s|\n\s+(\S+)\s+(.+?)\n\s+--\s+([^\n]+(\n\s+--\s+[^\n]+)*)|&do2($C, $1, $2, $3), ''|sge;
        sub do2 {
d191 8
d252 1
d259 9
d279 1
a279 1
        #   create AS database schema by executing  individual
d281 27
a307 7
        while ($sql =~ s|^\s*(.+?;)||s) {
            my $stmt = $1;
            $stmt =~ s|\s+| |sg;
            $stmt =~ s|^\s+||s;
            $stmt =~ s|\s+$||s;
            $db->do($stmt);
        }
d386 2
a387 1
            print "oid=<$oid>:\n";
d512 1
a512 1
            'epoch_end'   => "INFINITY",
d516 2
a517 2
                        || "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[1])."'"
                        || "'".&AS::DB::Util::sql_escape($self->{'attr'}->{$_}->[0])."'"
d534 5
a538 2
        #   create new OID
        $stmt .= sprintf("INSERT INTO as_oid (id_type) VALUES ('account');");
d540 11
a550 2
        #   start a new epoch
        $stmt .= sprintf("INSERT INTO as_epoch (ep_begin) VALUES (now());");
d552 2
a553 26
        #   create new account
        $stmt .= sprintf("INSERT INTO as_account (%s) VALUES (%s);", $columns, $values);
        
        #   log performed logical operation
        $stmt .= sprintf("INSERT INTO as_log (lg_entry) VALUES " .
                         "('create new account; oid=' || currval('as_oid_id_oid_seq'));");
    }
    else {
        ##
        ##   update existing account
        ##
        my $set = '';
        foreach my $name (keys(%{$attr})) {
            if ($attr->{$name}->[0] ne $attr->{$name}->[1]) {
                $set .= "," if ($set);
                $set .= "ac_${name} = '".&AS::DB::Util::sql_escape($attr->{$name})."'";
            }
        }
        if ($set) {
            #   FIXME: later perhaps not all fields trigger a new epoch!
        }
        #   close epoch on current 
        $stmt .= sprintf("UPDATE ONLY as_account" .
                         " SET ac_epoch_end = currval('as_epoch_ep_epoch_seq')" .
                         " WHERE ac_epoch_end = INFINITY
                         ");
d555 7
a561 4
        if ($set) {
            $stmt .= sprintf("UPDATE ONLY as_account SET %s WHERE ac_oid = '%s';", $set, $attr->{'oid'});
        }
    }
a562 5
    if ($stmt) {
        my $db = $self->{'as'}->db_handle
            or die "unable to retrieve database handle";
        eval {
            $db->do($stmt);
d567 1
a567 1
            die "sync operation aborted because $@@";
d569 29
@


1.1
log
@fully work off the AS DB API architecture by introducing a Perl
management API for the AS DB which currently at least performs all the
schema creation/destruction the old executable as_db.pl did. The new
as_db.pl now just calls this Perl API.
@
text
@a26 2
package as_db;

d32 8
d44 2
a45 2
@@as_db::ISA       = qw(Exporter);
@@as_db::EXPORT_OK = qw(new destroy DESTROY attr schema_create schema_destroy);
d159 2
a160 2
    $do =~ s|\n--\s+([^\n]+)\nCREATE\s+SEQUENCE\s+(\S+)\s+(.+?);|&do_seq($sql, $1, $2, $3), ''|sge;
    $do =~ s|\n--\s+([^\n]+)\nCREATE\s+TABLE\s+(\S+)\s+\((.+?\n)\);|&do1($sql, $1, $2, $3), ''|sge;
d162 1
a162 1
        my ($sql, $comment, $table, $do) = @@_; 
d183 1
a183 1
        my ($sql, $comment, $sequence, $do) = @@_; 
d299 248
d551 6
d561 1
a561 1
B<as_db> - AS Database Management
d571 4
d587 1
a587 1
=item C<$as-E<gt>>B<attr>C<($name, $value);>
d635 22
@