DB-Object

 view release on metacpan or  search on metacpan

lib/DB/Object.pm  view on Meta::CPAN

        return( $self->error( "Parameter \"$k\" is missing from the hash." ) ) if( !CORE::length( $def->{ $k } ) );
    }
    my $key = CORE::join( '|', @$def{qw( pack file line )} );
    my $ref = $hash->{ $key };
    # $ts is thee timestamp of the file recorded at the time
    my $ts = $ref->{ts};
    # A DB::Object::Statement object
    my $qo = $ref->query_object;
    return if( !CORE::length( $def->{file} ) );
    return if( !-e( $def->{file} ) );
    return if( ( CORE::stat( $def->{file} ) )[9] != $ts );
    return( $self->error( "Query object retrieved from constant query cache is void!" ) ) if( !$qo );
    return( $self->error( "Query object retrieved from constant query cache is not a DB::Object::Query object or one of its sub classes." ) ) if( !$self->_is_object( $qo ) || !$qo->isa( 'DB::Object::Query' ) );
    return if( $self->database ne $qo->database_object->database );
    return( $self->_cache_this( $qo ) );
}

sub constant_queries_cache_set
{
    my( $self, $def ) = @_;
    my $hash = $self->constant_queries_cache;
    foreach my $k ( qw( pack file line query_object ) )
    {
        return( $self->error( "Parameter \"$k\" is missing from the hash." ) ) if( !CORE::length( $def->{ $k } ) );
    }
    return( $self->error( "Provided query object is not a DB::Object::Query." ) ) if( !$self->_is_object( $def->{query_object} ) || !$def->{query_object}->isa( 'DB::Object::Query' ) );
    $def->{ts} = ( CORE::stat( $def->{file} ) )[9];
    my $key = CORE::join( '|', @$def{qw( pack file line )} );
    $hash->{ $key } = $def;
    return( $def );
}

# See also datatype_to_constant()
sub constant_to_datatype
{
    my $self = shift( @_ );
    return unless( scalar( @_ ) && defined( $_[0] ) );

lib/DB/Object/Cache/Tables.pm  view on Meta::CPAN

sub cache_file
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $f = shift( @_ ) || return( $self->error( "No tables cache file path was provided." ) );
        ## No change
        return( $f ) if( $f eq $self->{cache_file} );
        if( -e( $f ) )
        {
            my $mtime = ( stat( $f ) )[9];
            $self->updated( $mtime );
            my $hash = $self->read( $f ) || return;
            $self->cache( $hash );
        }
        $self->{cache_file} = $f;
    }
    return( $self->{cache_file} );
}

sub get

lib/DB/Object/Cache/Tables.pm  view on Meta::CPAN

    return( $self->error( "Hash reference provided for tables cache ($hash) is not a hash reference." ) ) if( !$self->_is_hash( $hash => 'strict' ) );
    foreach my $k ( qw( host port driver tables ) )
    {
        return( $self->error( "Tables cache provided is missing the \"$k\" key." ) ) if( !length( $hash->{ $k } ) );
    }
    return( $self->error( "\"tables\" property in cache data is not an array reference." ) ) if( !$self->_is_array( $hash->{tables} ) );
    ## Possibly reload the cache if the modification date changed
    my $cache = $self->cache;
    my $f = $self->cache_file;
    my $last_update = $self->updated;
    if( -s( $f ) && $last_update && ( stat( $f ) )[9] != $last_update )
    {
        $cache = $self->read( $f ) || return;
    }
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} } = {} if( ref( $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} } ) ne 'HASH' );
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} }->{tables} = $hash->{tables};
    $cache->{ $hash->{host} }->{ $hash->{driver} }->{ $hash->{port} }->{ $hash->{database} }->{timestamp} = time();
    if( !defined( $self->write( $cache ) ) )
    {
        return;
    }

lib/DB/Object/Mysql/Tables.pm  view on Meta::CPAN

    my $struct  = $self->{structure};
    my $fields  = $self->{fields};
    my $default = $self->{default};
    my $primary = $self->{primary};
    my @output = ();
    foreach my $field ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) )
    {
        push( @output, "$field $struct->{ $field }" );
    }
    push( @output, "PRIMARY KEY(" . CORE::join( ',', @$primary ) . ")" ) if( $primary && @$primary );
    my $info = $self->stat( $table );
    my @opt  = ();
    push( @opt, "TYPE = $info->{type}" ) if( $info->{type} );
    my $addons = $info->{create_options};
    if( $addons )
    {
        $addons =~ s/(\A|\s+)([\w\_]+)\s*=\s*/$1\U$2\E=/g;
        push( @opt, $addons );
    }
    push( @opt, "COMMENT='" . quotemeta( $info->{ 'comment' } ) . "'" ) if( $info->{comment} );
    my $str = "CREATE TABLE $table (\n\t" . CORE::join( ",\n\t", @output ) . "\n)";

lib/DB/Object/Mysql/Tables.pm  view on Meta::CPAN

If it is called in void context, the statement handler is executed immediately.

It returns the statement handler created.

See L<PostgreSQL documentation for more information|https://dev.mysql.com/doc/refman/5.7/en/repair-table.html>

=head2 stat

Provided with a table name and this will prepare a C<SHOW TABLE STATUS> MySQL query. If no table explicitly specified, then this will prepare a stat query for all tables in the database.

    $tbl->stat( 'my_table' );
    # SHOW TABLE STATUS FROM my_database LIKE 'my_table'
    $tbl->stat;
    # SHOW TABLE STATUS FROM my_database

The stat statement will be executed and an hash reference of property-value pairs in lower case will be retrieved for each table. Each table hash is stored in another hash reference of table name-properties hash reference pairs.

If only one table was the subject of the stat, in list context, this returns an hash of those table stat properties, and in scalar context its hash reference.

If the stat was done for the entire database, in list context, this returns an hash of all those tables to properties pairs, or an hash reference in scalar context.

lib/DB/Object/Postgres/Tables.pm  view on Meta::CPAN

    my $struct  = $self->{structure};
    my $fields  = $self->{fields};
    my $default = $self->{default};
    my $primary = $self->{primary};
    my @output = ();
    foreach my $field ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) )
    {
        push( @output, "$field $struct->{ $field }" );
    }
    push( @output, "PRIMARY KEY(" . CORE::join( ',', @$primary ) . ")" ) if( $primary && @$primary );
    my $info = $self->stat( $table );
    my @opt  = ();
    my $addons = $info->{create_options};
    if( $addons )
    {
        $addons =~ s/(\A|\s+)([\w\_]+)\s*=\s*/$1\U$2\E=/g;
        push( @opt, $addons );
    }
    push( @opt, "COMMENT='" . quotemeta( $info->{ 'comment' } ) . "'" ) if( $info->{comment} );
    my $str = "CREATE TABLE $table (\n\t" . CORE::join( ",\n\t", @output ) . "\n)";
    $str   .= ' ' . CORE::join( ' ', @opt ) if( @opt );

lib/DB/Object/Postgres/Tables.pm  view on Meta::CPAN

    {
        $sth->execute() ||
            return( $self->error( "Error while executing query to rename table '$table' into '$new':\n$query", $sth->errstr() ) );
    }
    $self->reset_structure;
    return( $sth );
}

sub repair { return( shift->error( "repair() is not implemented PostgreSQL." ) ); }

sub stat { return( shift->error( "stat() is not implemented PostgreSQL." ) ); }

sub structure
{
    my $self  = shift( @_ );
    return( $self->_clone( $self->{_cache_structure} ) ) if( $self->{_cache_structure} && !CORE::length( $self->{_reset_structure} // '' ) );
    my $table = $self->{table} ||
        return( $self->error( "No table provided to get its structure." ) );
    my $struct  = $self->{structure} // {};
    my $fields  = $self->{fields} // {};
    my $types_dict = $self->database_object->datatype_dict;

lib/DB/Object/SQLite/Tables.pm  view on Meta::CPAN

    my $struct  = $self->{structure};
    my $fields  = $self->{fields};
    my $default = $self->{default};
    my $primary = $self->{primary};
    my @output = ();
    foreach my $field ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) )
    {
        push( @output, "$field $struct->{ $field }" );
    }
    push( @output, "PRIMARY KEY(" . CORE::join( ',', @$primary ) . ")" ) if( $primary && @$primary );
    my $info = $self->stat( $table );
    my @opt  = ();
    push( @opt, "TYPE = $info->{type}" ) if( $info->{type} );
    my $addons = $info->{create_options};
    if( $addons )
    {
        $addons =~ s/(\A|\s+)([\w\_]+)\s*=\s*/$1\U$2\E=/g;
        push( @opt, $addons );
    }
    push( @opt, "COMMENT='" . quotemeta( $info->{comment} ) . "'" ) if( $info->{comment} );
    my $str = "CREATE TABLE $table (\n\t" . CORE::join( ",\n\t", @output ) . "\n)";

lib/DB/Object/Tables.pm  view on Meta::CPAN

        $self->{reverse} = 0;
        $q->sort( $self->{reverse} );
    }
    return( $self->{reverse} );
}

sub stat
{
    my $self = shift( @_ );
    my $class = ref( $self );
    return( $self->error( "stat() is not implemented by $class." ) );
}

# sub structure must be superseded by sub classes
sub structure
{
    my $self = shift( @_ );
    my $class = ref( $self );
    return( $self->error( "structure() is not implemented by $class." ) );
}