view release on metacpan or  search on metacpan

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

=head2 C<< Package->live_code_version >>

Returns the version number of the live code
in the database.

This is done with a C< SELECT max(version) FROM ... > query,
so this might scale badly on MySQL which (I hear) is bad
with queries even against indexed tables. If this becomes
a problem, changing the layout to a single-row table which
stores the live version number is the best approach.

=cut

sub live_code_version {
    my ($package) = @_;
    my $sth = $package->dbh->prepare_cached(sprintf <<'SQL', $package->code_history);
        SELECT max(version) FROM %s
SQL
    $sth->execute();
    my ($result) = $sth->fetchall_arrayref();
    $result->[0]->[0] || 0
}

=head2 C<< Package->init_code >>

Adds / overwrites subroutines/methods in the Package namespace
from the database.

=cut

sub init_code {
    my ($package) = @_;
    my $table = $package->code_live;
    #warn "Loading code for $package from $table";
    my $sql = sprintf <<'SQL', $table;
        SELECT name,code FROM %s
            ORDER BY name
SQL

    my $sth = $package->dbh->prepare_cached($sql);
    $sth->execute();
    while (my ($name,$code) = $sth->fetchrow()) {
        $package->create_sub($name,$code);
    }

    $package->code_version($package->live_code_version);
};

=head2 C<< Package->update_code >>

Updates the namespace from the database by loading
all changes.

Note that if you have/use closures or iterators,
these will behave weird if you redefine a subroutine
that was previously closed over.

=cut

sub update_code {
    my ($package) = @_;
    my $version = $package->code_version || 0;
    #warn "Checking against $version";
    my $sth = $package->dbh->prepare_cached(sprintf <<'SQL', $package->code_history);
        SELECT distinct name,action,new_code,version FROM %s
            WHERE version > ?
            ORDER BY version DESC
SQL

    $sth->execute($version);

    my %seen;

    my $current_version = $version || 0;
    while (my ($name,$action,$code,$new_version) = $sth->fetchrow()) {
        next if $seen{$name}++;
        
        warn "Reloading $name"
            if $package->verbose;
        $current_version = $current_version < $new_version 
                         ? $new_version
                         : $current_version;

        if ($action eq 'I') {
            $package->create_sub($name,$code);
        } elsif ($action eq 'U') {
            $package->create_sub($name,$code);
        } elsif ($action eq 'D') {
	    $package->destroy_sub($name);
        };
    }
    $package->code_version($current_version);
};

=head2 C<< Package->add_code_history Name,Old,New,Action >>

Inserts a new row in the code history table.

This
would be done with triggers on a real database,
but my development target includes MySQL 3 and 4.

=cut

sub add_code_history {
    my ($package,$name,$old_code,$new_code,$action) = @_;
    my $ts = strftime('%Y%m%d-%H%M%S',gmtime());
    my $sth = $package->dbh->prepare_cached(sprintf <<'SQL',$package->code_history);
        INSERT INTO %s (name,old_code,new_code,action,timestamp) VALUES (?,?,?,?,?)
SQL
    $sth->execute($name,$old_code,$new_code,$action,$ts);
}

=head2 C<< Package->update_sub name,code >>

Updates the code for the subroutine C<Package::$name>
with the code given.

Note that the update only happens in the database, so the change
will only take place on the next roundtrip / code refresh.

This cannot override subroutines that don't exist in the database.

=cut

sub update_sub {
    my ($package,$name,$new_code) = @_;
    $package->add_code_history($name,$package->code_source->{$name},$new_code,'U');
    my $sth = $package->dbh->prepare_cached(sprintf <<'SQL',$package->code_live);
        UPDATE %s SET code=?
        WHERE name=?
SQL
    $sth->execute($new_code,$name);
};


=head2 C<< Package->insert_sub name,code >>

Inserts the code for the subroutine C<Package::$name>.

Note that the insert only happens in the database, so the change
will only take place on the next roundtrip / code refresh.

This can also be used to override methods / subroutines that
are defined elsewhere in the Package:: namespace.

=cut

sub insert_sub {
    my ($package,$name,$new_code) = @_;
    $package->add_code_history($name,'',$new_code,'I');
    my $sth = $package->dbh->prepare_cached(sprintf <<'SQL',$package->code_live);
        INSERT INTO %s (name,code) VALUES (?,?)
SQL
    $sth->execute($name,$new_code);
};

=head2 C<< Package->redefine_sub name,code >>

Inserts or updates the code for the subroutine C<Package::$name>.

Note that the change only happens in the database, so the change
will only take place on the next roundtrip / code refresh.

This can be used to override methods / subroutines that
are defined in the database, elsewhere in the Package:: 
namespace or not at all.

=cut

sub redefine_sub {
    my ($package,$name,$new_code) = @_;
    
    if (! eval { $package->update_sub($name,$new_code) }) {
        warn "Inserting $name"
            if $package->verbose;
        $package->insert_sub($name,$new_code)
    }
};

=head2 C<< Package->delete_sub name,code >>

Deletes the code for the subroutine C<Package::$name>.

Note that the update only happens in the database, so the change
will only take place on the next roundtrip / code refresh.