view release on metacpan or  search on metacpan

lib/App/JESP/Driver.pm  view on Meta::CPAN

Usage:

  $this->apply_patch( $patch );

=cut

sub apply_patch{
    my ($self, $patch) = @_;
    $log->info("Applying patch ".$patch->id());
    if( my $sql = $patch->sql() ){
        $log->trace("Patch is SQL='$sql'");
        return $self->apply_sql( $sql );
    }
    if( my $script_file = $patch->script_file() ){
        $log->trace("Patch is SCRIPT='".$script_file."'");
        return $self->apply_script( $script_file );
    }
}

=head2 apply_script

Runs the given 'script' file, with the given environment:

  JESP_DSN : The full Perl DSN string
  JESP_USER: DB User
  JESP_PASSWORD: DB Password
  JESP_SCHEME: 'dbi'
  JESP_DRIVER: The name of the DBI driver in use
  JESP_DRIVER_DSN: the part of the DSN after the driver

Then the JESP_DRIVER_DSN is parsed and split into its components to generate environment variables.
The most common is:

  JESP_DATABASE: Name of the database to connect to
  JESP_PORT: The port to connect to.
  ...

=cut

sub apply_script{
    my ($self, $script) = @_;

    my @cmd = ( $script );

    my $input = '';

    my $on_stdout = sub{
        $log->info( @_ );
    };
    my @stderr;
    my $on_stderr = sub{
        $log->warn( @_ );
        push @stderr , @_;
    };

    my $properties = {};
    my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn( $self->jesp()->dsn() );
    ref($self)->_OdbcParse( $driver_dsn , $properties , [] );
    $properties->{user} ||= $self->jesp()->username();
    $properties->{password} ||= $self->jesp()->password();
    $properties = {
        %$properties,
        %{ defined( $attr_hash ) ? $attr_hash : {} },
        dsn => $self->jesp()->dsn(),
        scheme => $scheme,
        driver => $driver,
        driver_dsn => $driver_dsn,
        attr_string => $attr_string,
    };
    my %EXTRA_ENV = ();
    # Outside testing, be verbose.
    $EXTRA_ENV{IPCRUNDEBUG} = 'basic' unless( $ENV{AUTOMATED_TESTING} || $ENV{HARNESS_ACTIVE} );
    # Transfer all the DB properties
    foreach my $key ( keys %{$properties} ){
        if( $properties->{$key} ){
            $EXTRA_ENV{'JESP_'.uc($key)} = $properties->{$key};
        }
    }

    local %ENV = ( %ENV , %EXTRA_ENV );
    IPC::Run::run( \@cmd , \$input , $on_stdout , $on_stderr ) or die join(' ', @cmd).": $? : ".join("\n", @stderr )."\n";
}


=head2 apply_sql

Databases and their drivers vary a lot when it comes
to apply SQL patches. Some of them are just fine with sending
a blog of SQL to the driver, even when it contains multiple
statements and trigger or procedure, function definitions.

Some of them require a specific implementation.

This is the default implementation that just use the underlying DB
connection to send the patch SQL content.

=cut

sub apply_sql{
    my ($self, $sql) = @_;
    my $dbh = $self->jesp()->get_dbh()->();
    my $ret = $dbh->do( $sql );
    return  defined($ret) ? $ret : confess( $dbh->errstr() );
}


# Shamelessly copied from DBD-mysql-4.043/lib/DBD/mysql.pm
sub _OdbcParse {
    my($class, $dsn, $hash, $args) = @_;
    my($var, $val);
    if (!defined($dsn)) {
        return;
    }
    while (length($dsn)) {
        if ($dsn =~ /([^:;]*\[.*]|[^:;]*)[:;](.*)/) {
            $val = $1;
            $dsn = $2;
            $val =~ s/\[|]//g; # Remove [] if present, the rest of the code prefers plain IPv6 addresses
        } else {
            $val = $dsn;