Changeset 30347

Show
Ignore:
Timestamp:
10.12.2015 12:19:20 (4 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 modified

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