Ignore:
Timestamp:
2015-12-10T12:19:20+13:00 (8 years ago)
Author:
jmt12
Message:

Continuing to refactor driver code to move shared code up to parent classes. Have all the basic drivers done...

File:
1 edited

Legend:

Unmodified
Added
Removed

  • gs2-extensions/tdb/trunk/perllib/DBDrivers/TDB.pm

    r30338 r30347  
    5353    my $class = shift(@_);
    5454
    55     my $self = DBDrivers::GDBM->new();
     55    my $self = DBDrivers::GDBM->new(@_);
    5656
    5757    # Default TDB file extension
    … …  
    5959    # Should the TDB used a specific affinity?
    6060    $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity
    61     # Keep track of all opened file handles
    62     $self->{'handle_pool'} = {};
    6361    # Ask TDB executables to display debugging information?
    64     $self->{'tdb_debug'} = 0; # 1 to enable
     62    $self->{'tdb_debug'} = 1; # 1 to enable
     63
     64    # note: file separator agnostic
     65    $self->{'executable_path'} = $ENV{GEXTTDBEDIT_INSTALLED} . '/bin/';
     66    $self->{'read_executable'} = 'tdb2txt';
     67    $self->{'keyread_executable'} = 'tdbkeys';
     68    $self->{'write_executable'} = 'txt2tdb';
     69
     70    # Optional Support
     71    $self->{'supports_persistentconnection'} = 1;
     72    $self->{'supports_set'} = 1;
    6573
    6674    bless($self, $class);
    … …  
    96104# -----------------------------------------------------------------------------
    97105
     106# Handled by BaseDBDriver
     107# sub debugPrint(string) => void
     108# sub debugPrintFunctionHeader(*) => void
     109# sub get_infodb_file_path(string, string) => string
    98110
    99 ## @function _get_tdb_executable(string)
    100 #
    101 sub _get_tdb_executable
    102 {
    103     my $self = shift(@_);
    104     my $program = shift(@_);
    105     if (!defined $ENV{GEXTTDBEDIT_INSTALLED} || !-d $ENV{GEXTTDBEDIT_INSTALLED})
    106     {
    107     die('Fatal Error! Path to TDB binaries not found. Have you sourced setup.bash?');
    108     }
    109     my $program_exe = &util::filename_cat($ENV{GEXTTDBEDIT_INSTALLED} . '/bin/' . $program . &util::get_os_exe());
    110     if (!-x $program_exe)
    111     {
    112     die('Fatal Error! File doesn\'t exist or isn\'t executable: ' . $program_exe);
    113     }
    114     return $program_exe;
    115 }
    116 ## _get_tdb_executable(string) => string ##
    117 
    118 
    119 # Handled by BaseDBDriver
    120 # sub get_infodb_file_path(string, string)
    121 
    122 # With infodb_handle already set up, these functions work the same as parent version
    123 # sub delete_infodb_entry {}
    124 # sub write_infodb_entry {}
    125 # sub write_infodb_rawentry {}
     111# Handled by 70HyphenFormat
     112# sub read_infodb_entry(string, string) => hashmap
     113# sub read_infodb_file(string, hashmap) => void
     114# sub read_infodb_keys(string, hashmap) => void
     115# sub read_infodb_rawentry(string, string) => string
     116# sub set_infodb_entry(string, string, hashmap) => integer
     117# sub write_infodb_entry(filehandle, string, hashmap) => void
     118# sub write_infodb_rawentry(filehandle, string, string) => void
    126119
    127120
    … …  
    144137sub close_infodb_write_handle {
    145138    my $self = shift(@_);
     139    $self->debugPrintFunctionHeader(@_);
    146140    my $infodb_handle = shift(@_);
    147141    my $actually_close = shift(@_); # Undefined most of the time
    148142    if (defined($actually_close)) {
    149     $self->_debugPrint('(<infodb_handle>,"' . $actually_close . '")');
    150143    # We'll need the file path so we can locate and remove the entry in the
    151144    # handle pool
    … …  
    156149    # we can search for the appropriate file extension that should be there
    157150    # for valid paths.
    158     my $pattern = '\.' . $self->{'default_file_extension'} . '$';
     151    my $pattern = '\.' . $self->{'default_file_extension'} . '(\s\[APPEND\])?$';
    159152    if ($actually_close =~ /$pattern/) {
    160153        $infodb_file_path = $actually_close;
    … …  
    173166    }
    174167    if (defined($infodb_file_path)) {
     168            $self->debugPrint('Closing connection: ' . $infodb_file_path);
    175169        delete($self->{'handle_pool'}->{$infodb_file_path});
    176170    }
    … …  
    181175    $self->SUPER::close_infodb_write_handle($infodb_handle);
    182176    }
     177    else {
     178    $self->debugPrint('Connection persists for later use.');
     179    }
    183180}
    184181## close_infodb_write_handle(filehandle) => void ##
     182
     183# sub delete_infodb_entry {}
    185184
    186185
    … …  
    190189{
    191190    my $self = shift(@_);
    192     my $infodb_file_path = shift(@_);
    193     my $opt_append = shift(@_);
    194 
    195     my $txt2tdb_exe = $self->_get_tdb_executable('txt2tdb');
    196 
    197     my $cmd = '"' . $txt2tdb_exe . '"';
    198     if ((defined $opt_append) && ($opt_append eq "append")) {
    199         $cmd .= ' -append';
     191    if ($self->{'tdb_debug'}) {
     192        push(@_, '-debug');
    200193    }
    201     $cmd .= ' "' . $infodb_file_path . '"';
    202     # Optional flags
    203     if ($self->{'forced_affinity'} >= 0) {
    204         $cmd = 'taskset -c 5 ' . $cmd;
    205     }
    206     if ($self->{'debug'}) {
    207         $cmd .= ' -debug';
    208     }
    209 
    210     # we're going to pipe the key value pairs, in the appropriate format, from
    211     # within the buildproc, so we create a piped handle here
    212     my $infodb_file_handle = undef;
    213     # if the connection is already open, simply return it.
    214     if (defined $self->{'handle_pool'}->{$infodb_file_path}) {
    215     $infodb_file_handle = $self->{'handle_pool'}->{$infodb_file_path};
    216     }
    217     else {
    218     $self->_debugPrint('(' . $infodb_file_path . ')');
    219     if(!open($infodb_file_handle, "| $cmd")) {
    220         print STDERR "Error: Failed to open pipe to $cmd\n";
    221         print STDERR "       $!\n";
    222         return undef;
    223     }
    224     binmode($infodb_file_handle,":utf8");
    225     # Remember to store the newly created connection in the pool so we can
    226     # re-use for subsequent calls.
    227     $self->{'handle_pool'}->{$infodb_file_path} = $infodb_file_handle;
    228     }
    229     return $infodb_file_handle;
     194    my $handle = $self->SUPER::open_infodb_write_handle(@_);
     195    return $handle;
    230196}
    231197## open_infodb_write_handle(string, string) => filehandle ##
    232198
    233 
    234 ## @function read_infodb_file
    235 #
    236 sub read_infodb_file
    237 {
    238     my $self = shift(@_);
    239     my $infodb_file_path = shift(@_);
    240     my $infodb_map = shift(@_);
    241 
    242     $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)');
    243 
    244     my $tdb2txt_exe = $self->_get_tdb_executable('tdb2txt');
    245 
    246     if (!open (PIPEIN, '"' . $tdb2txt_exe . '" "' . $infodb_file_path . '" |')) {
    247         print STDERR 'Error: Failed to open pipe to ' . $tdb2txt_exe . "\n";
    248         print STDERR "       $!\n";
    249         return undef;
    250     }
    251 
    252     binmode(PIPEIN,":utf8");
    253 
    254     my $infodb_line = "";
    255     my $infodb_key = "";
    256     my $infodb_value = "";
    257     while (defined ($infodb_line = <PIPEIN>)) {
    258         if ($infodb_line =~ /^\[([^\]]+)\]$/) {
    259             $infodb_key = $1;
    260         }
    261         elsif ($infodb_line =~ /^-{70}$/) {
    262             $infodb_map->{$infodb_key} = $infodb_value;
    263             $infodb_key = "";
    264             $infodb_value = "";
    265         }
    266         else {
    267             $infodb_value .= $infodb_line;
    268         }
    269     }
    270     close (PIPEIN);
    271 }
    272 ## read_infodb_file(string, hashmap) => void ##
    273 
    274 
    275 ## @function read_infodb_keys(string, hashmap)
    276 #
    277 sub read_infodb_keys
    278 {
    279     my $self = shift(@_);
    280     my $infodb_file_path = shift(@_);
    281     my $infodb_map = shift(@_);
    282 
    283     $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)');
    284 
    285     my $tdbkeys_exe = $self->_get_tdb_executable('tdbkeys');
    286 
    287     if (!open (PIPEIN, '"' . $tdbkeys_exe . '" "' . $infodb_file_path . '" |')) {
    288         die("Error! Couldn't open pipe from read_infodb_keys: $infodb_file_path\n$!\n");
    289     }
    290 
    291     binmode(PIPEIN,":utf8");
    292 
    293     my $infodb_line = "";
    294     my $infodb_key = "";
    295     my $infodb_value = "";
    296     while (defined ($infodb_line = <PIPEIN>)) {
    297         # remove end of line
    298         chomp $infodb_line;
    299         $infodb_map->{$infodb_line} = 1;
    300     }
    301 
    302     close (PIPEIN);
    303 }
    304 ## read_infodb_keys(string, hashmap) => void ##
    305 
    306 
    307 ## @function set_infodb_entry(string, string, hashmap)
    308 #
    309 sub set_infodb_entry
    310 {
    311     my $self = shift(@_);
    312     my $infodb_file_path = shift(@_);
    313     my $infodb_key = shift(@_);
    314     my $infodb_map = shift(@_);
    315 
    316     $self->_debugPrint('(' . $infodb_file_path . ', ' . $infodb_key . ', <hashmap>)');
    317 
    318     # Protect metadata values that go inside quotes for tdbset
    319     foreach my $k (keys %$infodb_map) {
    320         my @escaped_v = ();
    321         foreach my $v (@{$infodb_map->{$k}}) {
    322             if ($k eq "contains") {
    323                 # protect quotes in ".2;".3 etc
    324                 $v =~ s/\"/\\\"/g;
    325                 push(@escaped_v, $v);
    326             }
    327             else {
    328                 my $ev = &ghtml::unescape_html($v);
    329                 $ev =~ s/\"/\\\"/g;
    330                 push(@escaped_v, $ev);
    331             }
    332         }
    333         $infodb_map->{$k} = \@escaped_v;
    334     }
    335 
    336     # Generate the record string
    337     my $serialized_infodb_map = $self->_convert_infodb_hash_to_string($infodb_map);
    338 
    339     # Store it into GDBM
    340     my $tdbset_exe = $self->_get_tdb_executable('tdbset');
    341     my $cmd = '"' . $tdbset_exe . '" "' . $infodb_file_path . '" "' . $infodb_key . '" "' . $serialized_infodb_map . '"';
    342     my $status = system($cmd);
    343 
    344     return $status;
    345 }
    346 ## set_infodb_entry(string, string, hashmap) => integer ##
    347 
    3481991;
Note: See TracChangeset for help on using the changeset viewer.