view release on metacpan or  search on metacpan

lib/DBIx/VersionedSubs.pm  view on Meta::CPAN

for (descending) ordering of rows.

=cut

__PACKAGE__->mk_classdata($_)
    for qw(dbh code_version code_live code_history code_source verbose);

use vars qw'%default_values $VERSION';

$VERSION = '0.09';

%default_values = (
    dbh          => undef,
    code_source  => {},
    code_live    => 'code_live',
    code_history => 'code_history',
    code_version => 0,
    verbose      => 0,
);

=head1 CLASS METHODS

=head2 C<< Package->setup >>

Sets up the class data defaults:

    code_source  => {}
    code_live    => 'code_live',
    code_history => 'code_history',
    code_version => 0,
    verbose      => 0,

C<code_source> contains the Perl source code for all loaded functions.
C<code_live> and C<code_history> are the names of the two tables
in which the live code and the history of changes to the live code
are stored. C<code_version> is the version of the code when it
was last loaded from the database.

The C<verbose> setting determines if progress gets output to
C<STDERR>.
Likely, this package variable will get dropped in favour of
a method to output (or discard) the progress.

=cut

sub setup {
    my $package = shift;
    warn "Setting up $package defaults"
        if $package->verbose;
    my %defaults = (%default_values,@_);
    for my $def (keys %defaults) {
        if (! defined $package->$def) {
            $package->$def($defaults{$def});
        };
    }
    $package;
};

=head2 C<< Package->connect DSN,User,Pass,Options >>

Connects to the database with the credentials given.

If called in void context, stores the DBI handle in the
C<dbh> accessor, otherwise returns the DBI handle.

If you already have an existing database handle, just
set the C<dbh> accessor with it instead.

=cut

sub connect {
    my ($package,$dsn,$user,$pass,$options) = @_;
    if (defined wantarray) {
        DBI->connect($dsn,$user,$pass,$options)
            or die "Couldn't connect to $dsn/$user/$pass/$options";
    } else {
        $package->dbh(DBI->connect($dsn,$user,$pass,$options));
    }
};

=head2 C<< Package->create_sub NAME, CODE >>

Creates a subroutine in the Package namespace.

If you want a code block to be run automatically
when loaded from the database, you can name it C<BEGIN>.
The loader code basically uses

    package $package;
    *{"$package\::$name"} = eval "sub { $code }"

so you cannot stuff attributes and other whatnot 
into the name of your subroutine, not that you should.

One name is special cased - C<BEGIN> will be immediately
executed instead of installed. This is most likely what you expect.
As the code elements are loaded by C<init_code> in alphabetical
order on the name, your C<Aardvark> and C<AUTOLOAD> subroutines
will still be loaded before your C<BEGIN> block runs.

The C<BEGIN> block will be called with the package name in C<@_>.

Also, names like C<main::foo> or C<Other::Package::foo> are possible
but get stuffed below C<$package>. The practice doesn't get saner there.

=cut

sub create_sub {
    my ($package,$name,$code) = @_;
    my $package_name = ref $package || $package;

    my $ref = $package->eval_sub($package_name,$name,$code);
    if ($ref) {
        if ($name eq 'BEGIN') {
            $ref->($package);
            return undef
        } else {
            no strict 'refs';
            no warnings 'redefine';
            *{"$package\::$name"} = $ref;
            $package->code_source->{$name} = $code;