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...

Location:
gs2-extensions/tdb/trunk/perllib
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • gs2-extensions/tdb/trunk/perllib/DBDrivers/70HyphenFormat.pm

    r30341 r30347  
    3232#
    3333###############################################################################
     34
     35# Note: This driver may be a candidate for further splitting, maybe into a
     36# PipedExecutableDriver and a 70HyphenFormatDriver... but for now all piped
     37# drivers are 70 hyphen format ones, so, yeah.
    3438
    3539package DBDrivers::70HyphenFormat;
    … …  
    5963    $self->{'read_executable'} = 'error';
    6064    $self->{'write_executable'} = 'error';
     65    $self->{'forced_affinity'} = -1; # Set to processor number for forced affinity
    6166    bless($self, $class);
    6267    return $self;
    … …  
    6873
    6974
    70 ## @function close_infodb_handle(filehandle)
    71 #
    72 sub close_infodb_handle
    73 {
    74     my $self = shift(@_);
    75     my $infodb_handle = shift(@_);
    76     $self->debugPrintFunctionHeader();
    77     close($infodb_handle);
    78 }
    79 ## close_infodb_handle(filehandle) => void ##
    80 
    81 
    8275## @function close_infodb_write_handle(filehandle)
    8376#
    … …  
    8578{
    8679    my $self = shift(@_);
    87     $self->close_infodb_handle(@_);
     80    $self->debugPrintFunctionHeader(@_);
     81    my $handle = shift(@_);
     82    my $force_close = shift(@_); # Undefined most of the time
     83    my $continue_close = $self->removeConnectionIfPersistent($handle, $force_close);
     84    if ($continue_close) {
     85    close($handle);
     86    }
     87    return;
    8888}
    8989## close_infodb_write_handle(filehandle) => void ##
    … …  
    142142{
    143143    my $self = shift(@_);
     144    $self->debugPrintFunctionHeader(@_);
    144145    my $infodb_handle = shift(@_);
    145146    my $infodb_key = shift(@_);
    146 
    147147    # A minus at the end of a key (after the ]) signifies 'delete'
    148     print $infodb_handle "[$infodb_key]-\n";
    149 
     148    print $infodb_handle '[' . $infodb_key . ']-' . "\n";
    150149    # The 70 minus signs are also needed, to help make the parsing by db2txt simple
    151150    print $infodb_handle '-' x 70, "\n";
    … …  
    160159    my $self = shift(@_);
    161160    $self->debugPrintFunctionHeader(@_);
    162     my $infodb_file_handle = $self->openWriteHandle(@_);
     161    my $path = shift(@_);
     162    my $append = shift(@_);
     163    my $infodb_file_handle = $self->retrieveConnectionIfPersistent($path, $append);;
     164    # No available existing connection
     165    if (!defined $infodb_file_handle || !$infodb_file_handle) {
     166        $infodb_file_handle = $self->openWriteHandle($path, $append, @_);
     167    $self->registerConnectionIfPersistent($infodb_file_handle, $path, $append);
     168    }
    163169    return $infodb_file_handle;
    164170}
    … …  
    181187    }
    182188    my $infodb_file_handle = undef;
    183     my $cmd = '"' . $exe . '" ' . $default_args;
     189    my $cmd = '';
     190    if ($self->{'forced_affinity'} >= 0)
     191    {
     192        $cmd = 'taskset -c ' . $self->{'forced_affinity'} . ' ';
     193    }
     194    $cmd .= '"' . $exe . '" ' . $default_args;
    184195    foreach my $open_arg (@_) {
     196    # Special - append is typically missing a hyphen
     197    if ($open_arg eq 'append') {
     198        $open_arg = '-append';
     199    }
    185200    $cmd .= ' ' . $open_arg;
    186201    }
    … …  
    199214
    200215## @function openReadHandle(string, string) => filehandle
     216#
    201217sub openReadHandle
    202218{
    … …  
    207223
    208224
     225## @function openWriteHandle(*) => filehandle
     226#
    209227sub openWriteHandle
    210228{
    … …  
    212230    return $self->openPipedHandle(RWMODE_WRITE, $self->{'write_executable'}, @_);
    213231}
     232## openWriteHandle(*) => filehandle ##
     233
    214234
    215235## @function read_infodb_entry(string, string) => hashmap
    … …  
    232252    my $infodb_file_path = shift(@_);
    233253    my $infodb_map = shift(@_);
     254    $self->debugPrintFunctionHeader($infodb_file_path, $infodb_map);
    234255    my $infodb_file_handle = $self->openReadHandle($infodb_file_path);
    235256    my $infodb_line = "";
    … …  
    250271        }
    251272    }
    252   $self->close_infodb_handle($infodb_file_handle);
     273  $self->close_infodb_write_handle($infodb_file_handle);
    253274}
    254275## read_infodb_file(string, hashmap) => void ##
    … …  
    291312    }
    292313    }
    293     $self->close_infodb_handle($infodb_file_handle);
     314    $self->close_infodb_write_handle($infodb_file_handle);
    294315}
    295316## read_infodb_keys(string, hashmap) => void ##
    … …  
    354375    print $infodb_file_handle "[$infodb_key]\n";
    355376    print $infodb_file_handle "$serialized_infodb_map\n";
    356     $self->close_infodb_handle($infodb_file_handle);
     377    $self->close_infodb_write_handle($infodb_file_handle);
    357378    $status = 0; # as in exit status of cmd OK
    358379    }

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

    r30343 r30347  
    4444    # Debug messages for this driver
    4545    $self->{'debug'} = $debug; # 1 to enable
     46    # Keep track of all opened file handles, but only for drivers that support
     47    # persistent connections
     48    $self->{'handle_pool'} = {};
    4649    # Default file extension - in this case it is an error to create a DB from
    4750    # BaseDBDriver
    4851    $self->{'default_file_extension'} = 'err';
    4952    # Support
     53    $self->{'supports_datestamp'} = 0;
     54    $self->{'supports_merge'} = 0;
     55    $self->{'supports_persistentconnection'} = 0;
     56    $self->{'supports_rss'} = 0;
    5057    $self->{'supports_set'} = 0;
    5158    bless($self, $class);
    … …  
    6875    if ($self->{'debug'}) {
    6976    my ($seconds, $microseconds) = gettimeofday();
    70     print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . $message . "\n";
     77    print STDERR '[DEBUG:' . $seconds . '.' . $microseconds . '] ' . (caller 1)[3] . '() ' . $message . "\n";
    7178    }
    7279}
    … …  
    112119## errorPrint(string, integer) => void ##
    113120
     121
     122## @function registerConnectionIfPersistent(filehandle, string, string) => void
     123#
     124sub registerConnectionIfPersistent
     125{
     126    my $self = shift(@_);
     127    my $conn = shift(@_);
     128    my $path = shift(@_);
     129    my $append = shift(@_);
     130    if ($self->{'supports_persistentconnection'}) {
     131    $self->debugPrintFunctionHeader($conn, $path, $append);
     132    my $fhid = $path;
     133    if (defined $append && $append eq '-append') {
     134        $fhid .= ' [APPEND]';
     135    }
     136    $self->debugPrint('Registering connection: "' . $fhid . '"');
     137    $self->{'handle_pool'}->{$fhid} = $conn;
     138    }
     139    return;
     140}
     141## registerConnectionIfPersistent(filehandle, string, string) => void ##
     142
     143
     144## @function removeConnectionIfPersistent(filehandle, string) => integer
     145#
     146sub removeConnectionIfPersistent
     147{
     148    my $self = shift(@_);
     149    my $handle = shift(@_);
     150    my $force_close = shift(@_);
     151    my $continue_close = 1;
     152    if ($self->{'supports_persistentconnection'}) {
     153    $self->debugPrintFunctionHeader($handle, $force_close);
     154    if (defined($force_close)) {
     155        # We'll need the file path so we can locate and remove the entry
     156        # in the handle pool (plus possibly the [APPEND] suffix for those
     157        # connections in opened in append mode)
     158        my $fhid = undef;
     159        # Sometimes we can cheat, as the force_close variable will have the
     160        # file_path in it thanks to the DESTROY block above. Doing a regex
     161        # on force_close will treat it like a string no matter what it was,
     162        # and we can search for the appropriate file extension that should
     163        # be there for valid paths.
     164        my $pattern = '\.' . $self->{'default_file_extension'} . '(\s\[APPEND\])?$';
     165        if ($force_close =~ /$pattern/) {
     166        $fhid = $force_close;
     167        }
     168        # If we can't cheat then we are stuck finding which connection in
     169        # the handle_pool we are about to close. Need to compare objects
     170        # using refaddr()
     171        else {
     172        foreach my $possible_fhid (keys %{$self->{'handle_pool'}}) {
     173            my $possible_handle = $self->{'handle_pool'}->{$possible_fhid};
     174            if (ref($handle) && ref($possible_handle) && refaddr($handle) == refaddr($possible_handle)) {
     175            $fhid = $possible_fhid;
     176            last;
     177            }
     178        }
     179        }
     180        # If we found the fhid we can proceed to close the connection
     181        if (defined($fhid)) {
     182        $self->debugPrint('Closing persistent connection: ' . $fhid);
     183        delete($self->{'handle_pool'}->{$fhid});
     184        $continue_close = 1;
     185        }
     186        else {
     187        print STDERR "Warning! About to close persistent database handle, but couldn't locate in open handle pool.\n";
     188        }
     189    }
     190    # Persistent connection don't close *unless* force close is set
     191    else {
     192        $continue_close = 0;
     193    }
     194    }
     195    return $continue_close;
     196}
     197## removeConnectionIfPersistent(filehandle, string) => integer ##
     198
     199
     200##
     201#
     202sub retrieveConnectionIfPersistent
     203{
     204    my $self = shift(@_);
     205    my $path = shift(@_);
     206    my $append = shift(@_); # -append support
     207    my $conn; # This should be populated
     208    if ($self->{'supports_persistentconnection'}) {
     209    $self->debugPrintFunctionHeader($path, $append);
     210    my $fhid = $path;
     211    # special case: if the append mode has changed for a persistent
     212    # connection, we need to close the old connection first or things
     213    # will get wiggy.
     214    if (defined $append && $append eq '-append') {
     215        # see if there is a non-append mode connection already open
     216        if (defined $self->{'handle_pool'}->{$path}) {
     217        $self->debugPrint("Append mode added - closing existing non-append mode connection");
     218        my $old_conn = $self->{'handle_pool'}->{$path};
     219        $self->close_infodb_write_handle($old_conn, $path);
     220        }
     221        # Append -append so we know what happened.
     222        $fhid .= ' [APPEND]';
     223    }
     224    else {
     225        my $fhid_append = $path . ' [APPEND]';
     226        if (defined $self->{'handle_pool'}->{$fhid_append}) {
     227        $self->debugPrint("Append mode removed - closing existing append mode connection");
     228        my $old_conn = $self->{'handle_pool'}->{$fhid_append};
     229        $self->close_infodb_write_handle($old_conn, $fhid_append);
     230        }
     231    }
     232    if (defined $self->{'handle_pool'}->{$fhid}) {
     233        $self->debugPrint('Retrieving existing connection: ' . $fhid);
     234        $conn = $self->{'handle_pool'}->{$fhid};
     235    }
     236    }
     237    return $conn;
     238}
     239## ##
     240
     241
     242
     243
     244
     245
     246
    114247###############################################################################
    115248## Public Functions
    … …  
    126259    my $infodb_file_name = &util::get_dirsep_tail($collection_name) . '.' . $self->{'default_file_extension'};
    127260    my $infodb_file_path = &FileUtils::filenameConcatenate($infodb_directory_path, $infodb_file_name);
     261    # Correct the path separators to work in Cygwin
     262    if ($^O eq "cygwin") {
     263    $infodb_file_path = `cygpath -w "$infodb_file_path"`;
     264    chomp($infodb_file_path);
     265    $infodb_file_path =~ s%\\%\\\\%g;
     266    }
    128267    return $infodb_file_path;
    129268}
    … …  
    131270
    132271
    133 ## @function supportsDatestamp(void) => boolean
     272## @function supportsDatestamp(void) => integer
    134273#
    135274sub supportsDatestamp
    136275{
    137276    my $self = shift(@_);
    138     return 0;
    139 }
    140 ## supportsDatestamp(void) => boolean ##
     277    return $self->{'supports_datestamp'};
     278}
     279## supportsDatestamp(void) => integer ##
    141280
    142281
    … …  
    146285{
    147286    my $self = shift(@_);
    148     return 0;
    149 }
    150 ## supportsMerge(void) => boolean ##
    151 
    152 
    153 ## @function supportsRSS(void) => boolean
     287    return $self->{'supports_merge'};
     288}
     289## supportsMerge(void) => integer ##
     290
     291
     292## @function supportsPersistentConnection(void) => integer
     293#
     294sub supportsPersistentConnection
     295{
     296    my $self = shift(@_);
     297    return $self->{'supports_persistentconnection'};
     298}
     299## supportsPersistentConnection(void) => integer ##
     300
     301
     302## @function supportsRSS(void) => integer
    154303#
    155304sub supportsRSS
    156305{
    157306    my $self = shift(@_);
    158     return 0;
    159 }
    160 ## supportsRSS(void) => boolean ##
     307    return $self->{'supports_rss'};
     308}
     309## supportsRSS(void) => integer ##
    161310
    162311

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

    r30342 r30347  
    2929use strict;
    3030
     31BEGIN
     32{
     33    if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) {
     34        die("Error! Environment not prepared. Have you sourced setup.bash?\n");
     35    }
     36}
     37
    3138# Libraries
    3239use util;
    … …  
    4754    $self->{'keyread_executable'} = 'gdbmkeys';
    4855    $self->{'write_executable'} = 'txt2db';
     56    # Optional Support
    4957    $self->{'supports_set'} = 1;
    5058    bless($self, $class);
    … …  
    5967
    6068# Handled by BaseDBDriver
    61 # sub get_infodb_file_path(string, string)
     69# sub get_infodb_file_path(string, string) => string
    6270
    6371# Handled by 70HyphenFormat
     72# sub open_infodb_write_handle(string, string?) => filehandle
    6473# sub close_infodb_write_handle(filehandle) => void
    6574# sub delete_infodb_entry(filehandle, string) => void
    … …  
    7281# sub write_infodb_rawentry(filehandle, string, string) => void
    7382
    74 
    75 ## @function open_infodb_write_handle(string, string*) => filehandle
    76 #
    77 #  Handles legacy use of optional 'append' argument where '-append' is required
    78 #
    79 sub open_infodb_write_handle
    80 {
    81     my $self = shift(@_);
    82     my $infodb_file_path = shift(@_);
    83     my $opt_append = shift(@_);
    84     my $infodb_file_handle;
    85     if (defined $opt_append) {
    86     if ($opt_append eq 'append') {
    87         $opt_append = '-append';
    88     }
    89     $infodb_file_handle = $self->SUPER::open_infodb_write_handle($infodb_file_path, $opt_append);
    90     }
    91     else
    92     {
    93     $infodb_file_handle = $self->SUPER::open_infodb_write_handle($infodb_file_path);
    94     }
    95     return $infodb_file_handle;
    96 }
    97 ## open_infodb_write_handle(string, string*) => filehandle ##
    98 
    99831;

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

    r30344 r30347  
    7777# other
    7878#
    79 # All this function does now is turn the optional 'append' argument into the
    80 # appropriate operator for either appending to or clobbering gzip file.
     79# Now only responsible for transforming the optional append argument into the
     80# correct redirection operand (either > for clobber or >> for append)
    8181#
    8282sub open_infodb_write_handle
    … …  
    9898## open_infodb_write_handle(string) => filehandle ##
    9999
    100 
    101100## @function set_infodb_entry(string, string, hashmap)
    102101#

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

    r30338 r30347  
    3333use FileUtils;
    3434# - OO inheritence
    35 use parent 'DBDrivers::BaseDBDriver';
     35use parent 'DBDrivers::70HyphenFormat';
    3636
    3737sub BEGIN
    … …  
    4848{
    4949    my $class = shift(@_);
    50     my $self = DBDrivers::BaseDBDriver->new();
     50    my $self = DBDrivers::70HyphenFormat->new(@_);
    5151    $self->{'default_file_extension'} = 'jdb';
     52
     53    # Executables need a little extra work since we are using Java
     54    # - we need to build up the classpath continue the Jar libraries to use
     55    my $jdbmwrap_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'bin', 'java', 'JDBMWrapper.jar');
     56    my $jdbm_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, 'lib', 'java', 'jdbm.jar');
     57    my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
     58    # Massage paths for Cygwin. Away to run a java program, using a binary that
     59    # is native to Windows, so need Windows directory and path separators
     60    if ($^O eq "cygwin") {
     61    $classpath = `cygpath -wp "$classpath"`;
     62    chomp($classpath);
     63    $classpath =~ s%\\%\\\\%g;
     64    }
     65    $self->{'executable_path'} = '';
     66    $self->{'read_executable'} = 'java -cp "' . $classpath . '" Jdb2Txt';
     67    $self->{'keyread_executable'} = 'java -cp "' . $classpath . '" JdbKeys';
     68    $self->{'write_executable'} = 'java -cp "' . $classpath . '" Txt2Jdb';
     69    # Support
     70    $self->{'supports_set'} = 1;
     71
    5272    bless($self, $class);
    5373    return $self;
    … …  
    6888# sub get_infodb_file_path {}
    6989
    70 
    71 
    72 sub open_infodb_write_handle
    73 {
    74     my $self = shift(@_);
    75     my $infodb_file_path = shift(@_);
    76     my $opt_append = shift(@_);
    77     if (!defined $opt_append) {
    78     $opt_append = '';
    79     }
    80     $self->_debugPrint('("' . $infodb_file_path . '","' . $opt_append . '")');
    81 
    82     my $jdbmwrap_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
    83     my $jdbm_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
    84 
    85   my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
    86 
    87   if ($^O eq "cygwin") {
    88       # Away to run a java program, using a binary that is native to Windows, so need
    89       # Windows directory and path separators
    90 
    91       $classpath = `cygpath -wp "$classpath"`;
    92       chomp($classpath);
    93       $classpath =~ s%\\%\\\\%g;
    94   }
    95 
    96   my $infodb_file_handle = undef;
    97   my $txt2jdb_cmd = "java -cp \"$classpath\" Txt2Jdb";
    98 
    99   if ($opt_append eq "append") {
    100       $txt2jdb_cmd .= " -append";
    101       print STDERR "Append operation to $infodb_file_path\n";
    102   }
    103   else {
    104       print STDERR "Create database $infodb_file_path\n";
    105   }
    106  
    107   # Lop off file extension, as JDBM does not expect this to be present
    108   $infodb_file_path =~ s/\.jdb$//;
    109 
    110   if ($^O eq "cygwin") {
    111       $infodb_file_path = `cygpath -w "$infodb_file_path"`;
    112       chomp($infodb_file_path);
    113       $infodb_file_path =~ s%\\%\\\\%g;
    114   }
    115 
    116   $txt2jdb_cmd .= " \"$infodb_file_path\"";
    117 
    118   if (!open($infodb_file_handle, "| $txt2jdb_cmd"))
    119   {
    120       print STDERR "Error: Failed to open pipe to $txt2jdb_cmd";
    121       print STDERR "       $!\n";
    122       return undef;
    123   }
    124  
    125   binmode($infodb_file_handle,":utf8");
    126   return $infodb_file_handle;
    127 }
    128 
    129 
    130 
    131 sub close_infodb_write_handle
    132 {
    133   my $infodb_handle = shift(@_);
    134 
    135   close($infodb_handle);
    136 }
    137 
    138 
    139 sub read_infodb_file
    140 {
    141   my $infodb_file_path = shift(@_);
    142   my $infodb_map = shift(@_);
    143 
    144   my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
    145   my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
    146 
    147   my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
    148 
    149   if ($^O eq "cygwin") {
    150       # Away to run a java program, using a binary that is native to Windows, so need
    151       # Windows directory and path separators
    152      
    153       $classpath = `cygpath -wp "$classpath"`;
    154       chomp($classpath);
    155       $classpath =~ s%\\%\\\\%g;
    156 
    157       $infodb_file_path = `cygpath -w "$infodb_file_path"`;
    158       chomp($infodb_file_path);
    159       $infodb_file_path =~ s%\\%\\\\%g;
    160   }
    161 
    162   my $jdb2txt_cmd = "java -cp \"$classpath\" Jdb2Txt";
    163 
    164   open (PIPEIN, "$jdb2txt_cmd \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \$infodb_file_path\"\n";
    165   binmode(PIPEIN,":utf8");
    166   my $infodb_line = "";
    167   my $infodb_key = "";
    168   my $infodb_value = "";
    169   while (defined ($infodb_line = <PIPEIN>))
    170   {
    171     $infodb_line =~ s/(\r\n)+$//; # more general than chomp
    172 
    173     if ($infodb_line =~ /^\[([^\]]+)\]$/)
    174     {
    175       $infodb_key = $1;
    176     }
    177     elsif ($infodb_line =~ /^-{70}$/)
    178     {
    179       $infodb_map->{$infodb_key} = $infodb_value;
    180       $infodb_key = "";
    181       $infodb_value = "";
    182     }
    183     else
    184     {
    185       $infodb_value .= $infodb_line;
    186     }
    187   }
    188 
    189   close (PIPEIN);
    190 }
    191 
    192 sub read_infodb_keys
    193 {
    194   my $infodb_file_path = shift(@_);
    195   my $infodb_map = shift(@_);
    196 
    197   my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
    198   my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
    199 
    200   my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
    201 
    202   my $jdbkeys_cmd = "java -cp \"$classpath\" JdbKeys";
    203 
    204   open (PIPEIN, "$jdbkeys_cmd \"$infodb_file_path\" |") || die "couldn't open pipe from jdbmkeys \$infodb_file_path\"\n";
    205   binmode(PIPEIN,":utf8");
    206   my $infodb_line = "";
    207   my $infodb_key = "";
    208   my $infodb_value = "";
    209   while (defined ($infodb_line = <PIPEIN>))
    210   {
    211       # chomp $infodb_line; # remove end of line
    212       $infodb_line =~ s/(\r\n)+$//; # more general than chomp
    213 
    214       $infodb_map->{$infodb_line} = 1;
    215   }
    216 
    217   close (PIPEIN);
    218 }
    219 
    220 
    221    
    222 sub write_infodb_entry
    223 {
    224 
    225   my $infodb_handle = shift(@_);
    226   my $infodb_key = shift(@_);
    227   my $infodb_map = shift(@_);
    228 
    229   print $infodb_handle "[$infodb_key]\n";
    230   foreach my $infodb_value_key (keys(%$infodb_map))
    231   {
    232     foreach my $infodb_value (@{$infodb_map->{$infodb_value_key}})
    233     {
    234       if ($infodb_value =~ /-{70,}/)
    235       {
    236         # if value contains 70 or more hyphens in a row we need to escape them
    237         # to prevent txt2db from treating them as a separator
    238         $infodb_value =~ s/-/&\#045;/gi;
    239       }
    240       print $infodb_handle "<$infodb_value_key>" . $infodb_value . "\n";
    241     }
    242   }
    243   print $infodb_handle '-' x 70, "\n";
    244 }
    245 
    246 
    247 sub write_infodb_rawentry
    248 {
    249 
    250   my $infodb_handle = shift(@_);
    251   my $infodb_key = shift(@_);
    252   my $infodb_val = shift(@_);
    253  
    254   print $infodb_handle "[$infodb_key]\n";
    255   print $infodb_handle "$infodb_val\n";
    256   print $infodb_handle '-' x 70, "\n";
    257 }
    258 
    259 sub set_infodb_entry
    260 {
    261     my $infodb_file_path = shift(@_);
    262     my $infodb_key = shift(@_);
    263     my $infodb_map = shift(@_);
    264  
    265     # HTML escape anything that is not part of the "contains" metadata value
    266     foreach my $k (keys %$infodb_map) {
    267       my @escaped_v = ();
    268       foreach my $v (@{$infodb_map->{$k}}) {
    269         if ($k eq "contains") {
    270           push(@escaped_v, $v);
    271         }
    272         else {
    273           my $ev = &ghtml::unescape_html($v);
    274           push(@escaped_v, $ev);
    275         }
    276       }
    277       $infodb_map->{$k} = \@escaped_v;
    278     }
    279    
    280     # Generate the record string
    281     my $serialized_infodb_map = &dbutil::convert_infodb_hash_to_string($infodb_map);
    282 ###    print STDERR "**** ser dr\n$serialized_infodb_map\n\n\n";
    283 
    284     # Store it into JDBM using 'Txt2Jdb .... -append' which despite its name
    285     # actually replaces the record if it already exists
    286 
    287     my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar");
    288     my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar");
    289    
    290     my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar);
    291 
    292     # Lop off file extension, as JDBM does not expect this to be present
    293     $infodb_file_path =~ s/\.jdb$//;
    294 
    295     if ($^O eq "cygwin") {
    296     # Away to run a java program, using a binary that is native to Windows, so need
    297     # Windows directory and path separators
    298    
    299       $classpath = `cygpath -wp "$classpath"`;
    300       chomp($classpath);
    301       $classpath =~ s%\\%\\\\%g;
    302 
    303       $infodb_file_path = `cygpath -w "$infodb_file_path"`;
    304       chomp($infodb_file_path);
    305       $infodb_file_path =~ s%\\%\\\\%g;
    306     }
    307 
    308     my $cmd = "java -cp \"$classpath\" Txt2Jdb -append \"$infodb_file_path\"";
    309 
    310     my $status = undef;
    311     if(!open(GOUT, "| $cmd"))
    312     {
    313     print STDERR "Error: jdbm::set_infodb_entry() failed to open pipe to: $cmd\n";
    314     print STDERR "       $!\n";
    315     $status = -1;
    316     }
    317     else {
    318     binmode(GOUT,":utf8");
    319    
    320     print GOUT "[$infodb_key]\n";
    321     print GOUT "$serialized_infodb_map\n";
    322 
    323     close(GOUT);
    324     $status = 0; # as in exit status of cmd OK
    325     }
    326 
    327     return $status; 
    328 }
    329 
    330 
    331 
    332 
    333 sub delete_infodb_entry
    334 {
    335   my $infodb_handle = shift(@_);
    336   my $infodb_key = shift(@_);
    337  
    338   # A minus at the end of a key (after the ]) signifies 'delete'
    339   print $infodb_handle "[$infodb_key]-\n";
    340 
    341   # The 70 minus signs are also needed, to help make the parsing by db2txt simple
    342   print $infodb_handle '-' x 70, "\n";
    343 }
     90# Handles by 70HyphenFormat
     91# sub open_infodb_write_handle(string, string?) => filehandle
     92# sub close_infodb_write_handle(filehandle) => void
     93# sub read_infodb_file(string, hashmap) => void
     94# sub read_infodb_keys(string, hashmap) => void
     95# sub write_infodb_entry(filehandle, string, hashmap) => void
     96# sub write_infodb_rawentry(filehandle, string, string) => void
     97# sub set_infodb_entry(filehandle, string, string) => void
     98# sub delete_infodb_entry(filehandle, string) => void
    34499
    3451001;

  • gs2-extensions/tdb/trunk/perllib/DBDrivers/Readme.txt

    r30331 r30347  
    11===== DBDriver =====
     2
     3Note that there are a couple of Drivers that could be further separated to
     4have even better OO, but I started to get bogged down in multiple inheritence
     5problems so I left them as is for now. For instance, separating PipedExecutable
     6support from the 70HyphenFormat driver would increase flexibility, but then it
     7becomes tricky to say which should inherit from which (in a single inheritence)
     8or what order methods should be resolved (in multiple inheritence).
    29
    310==== Inheritence Overview ====
    411
    5   * BaseDBDriver - superclass of all drivers. Some shared utility methods.
    6     * PipedDrivers - drivers that write and read their data via pipes to external executables. Data is in simple Greenstone archive form (i.e. key/value pairs and separated by seventy hyphens)
     12  * BaseDBDriver - superclass of all drivers. Some shared utility methods
     13                   including support for persistent connections (ala TDB).
     14           Thus this is a candidate for separating out the the
     15           PersistentConnectionsDriver.
     16    * 70HyphenFormat - drivers that write and read their data via pipes to
     17                       external executables. Data is in simple Greenstone
     18               archive form (i.e. key/value pairs and separated by
     19               seventy hyphens) - this is a candidate for further
     20               separating out a PipedExecutableDriver.
    721      * GDBM - makes use of GDBM utils (txt2db, db2txt etc)
    822      * GDBMTXTGZ - makes use of gzip (for later use with GDBM)

  • 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;

  • gs2-extensions/tdb/trunk/perllib/dbutil.pm

    r30340 r30347  
    3737    }
    3838    # Are we running standalone? In which case the INC won't be correct
    39     #if (!caller) {
    40     # Ensure the INC includes the path to FileUtils.pm
    41     unshift(@INC, $ENV{'GSDLHOME'} . '/perllib');
    42 
    43     #}
    44     require DBDrivers::GDBM;
    45     my $driver = DBDrivers::GDBM->new(1);
     39    my $perllib_path = $ENV{'GSDLHOME'} . '/perllib';
     40    my $all_inc = join(':', @INC);
     41    if ($all_inc !~ /$perllib_path/) {
     42    unshift(@INC, $perllib_path);
     43    }
    4644}
    4745
    … …  
    240238         'tea' => ['a drink with jam and bread'],
    241239         'doh' => ['which brings us back to']};
     240    $test_count = 0;
     241    $pass_count = 0;
     242    $skip_count = 0;
    242243    print "===== DBUtils Testing Suite =====\n";
    243244    print "For each driver specified, run a battery of tests\n";
    … …  
    259260    &_addPathsToINC();
    260261    foreach my $driver_name (@drivers) {
    261         print "* Testing: " . $driver_name . "\n";
     262        my $t1 = [gettimeofday()];
     263        print "=== Testing: " . $driver_name . " ===\n";
    262264        my $driver = _loadDBDriver($driver_name);
    263265        my $db_path = $driver->get_infodb_file_path('test','/tmp/');
    … …  
    274276        &_printTest('writing raw entry', 1);
    275277        # 3. Close handle
    276         $driver->close_infodb_handle($db_handle);
    277         &_printTest('closing handle', (tell($db_handle) < 1));
     278        $driver->close_infodb_write_handle($db_handle);
     279        if ($driver->supportsPersistentConnection()) {
     280        $test_count += 1;
     281        $skip_count += 1;
     282        print " - Skipping test as persistent drivers delay 'close'.\n";
     283        }
     284        else {
     285        &_printTest('closing handle', (tell($db_handle) < 1));
     286        }
    278287        # 4a. Read entry
    279288        my $data3 = $driver->read_infodb_entry($db_path, 'Alpha');
    … …  
    302311        my $db_handle2 = $driver->open_infodb_write_handle($db_path, 'append');
    303312        $driver->delete_infodb_entry($db_handle2, 'Alpha');
    304         $driver->close_infodb_handle($db_handle2);
     313        $driver->close_infodb_write_handle($db_handle2);
    305314        my $keys2 = {};
    306315        $driver->read_infodb_keys($db_path, $keys2);
    … …  
    308317        # 8. Remove test db
    309318        #unlink($db_path);
     319        my $t2 = [gettimeofday()];
     320        my $elapsed1 = tv_interval($t1, $t2);
     321        print " - Testing took " . $elapsed1 . " seconds\n";
    310322    }
    311323    print "===== Results =====\n";
    … …  
    320332    print "Warning! No drivers specified - expected as arguments to call\n";
    321333    }
    322     my $t1 = [gettimeofday()];
    323     my $elapsed = tv_interval($t0, $t1);
    324     print "===== Complete in " . $elapsed . " seconds =====\n";
     334    my $t3 = [gettimeofday()];
     335    my $elapsed2 = tv_interval($t0, $t3);
     336    print "===== Complete in " . $elapsed2 . " seconds =====\n";
    325337    print "\n";
    326338    exit(0);
Note: See TracChangeset for help on using the changeset viewer.