#============================================================== # db_RDB.pm # Mark Pruett - 06/12/2000 # # The db_ routines here are specific to RDB. # # Tables are read into a data structure: # # $tbl{MAX_FLDLEN} = # $tbl{COMMENTS}->[0..n] = # $tbl{ORDER}->[0..n] = # $tbl{FIELDS}->{"field-name"}->{FTYPE} = # $tbl{FIELDS}->{"field-name"}->{FCOMMENT} = # $tbl{FIELDS}->{"field-name"}->{VALUE}->[0..n] = # $tbl{NUM_RECORDS} = # $tbl{DELETED}->[0..n] = 1 (0..n index is the table row, 1 = true) # #============================================================== use RDB_lock; #-------------------------------------------------------------- # This layer of calls should isolate the application from # the underlying database. We currently only support RDB, # but if we keep this interface clean, we can ease porting to # other relational databases. #-------------------------------------------------------------- sub db_get_table { my ($query) = @_; %rdb = get_rdb_table ($query); return %rdb; } #------------------------------------------------------------- # Given the field name (fname) and array row number, return # the value for that field. #------------------------------------------------------------- sub db_get_field { my ($fname, $row, %rdb_in) = @_; return $rdb_in{FIELDS}->{$fname}->{VALUE}->[$row]; } #------------------------------------------------------------- # Return the row number of the row in rdb_in where fields $fname # have the values $target_vals (where these are tab-delimited # lists of field names and their corresponding values). Return # -1 if no matching record was found. #------------------------------------------------------------- sub db_find_record_by_matching_fields { my ($fnames, $target_vals, %rdb_in) = @_; my $nummatched; my $val; my $i; my $row = -1; @fns = split ('\t', $fnames); @vals = split ('\t', $target_vals); # sanity check our field names and values. if (($#fns < 0) || ($#fns != $#vals)) { return $row; } for ($i=0; $i < $rdb_in{NUM_RECORDS}; $i++) { $nummatched = 0; for ($j=0; $j <= $#fns; $j++) { $val = db_get_field ($fns[$j], $i, %rdb_in); if ($val eq $vals[$j]) { $nummatched++; } } if ($nummatched eq ($#fns + 1)) { $row = $i; last; } } return $row; } #------------------------------------------------------------- # Return the row number of the row in rdb_in where field $fname # has the value $target_val. Return -1 if no matching record # was found. #------------------------------------------------------------- sub db_find_record { my ($fname, $target_val, %rdb_in) = @_; my $val; my $i; my $row = -1; for ($i=0; $i < $rdb_in{NUM_RECORDS}; $i++) { $val = db_get_field ($fname, $i, %rdb_in); if ($val eq $target_val) { $row = $i; last; } } return $row; } #----------------------------------------------------------------- # Create a new, empty table (in-memory) given a comment, and # tab-delimited field name and field type strings. #----------------------------------------------------------------- sub db_new_table { my ($comment, $fn, $ft) = @_; my $i; @fnames = split ("\t", $fn); @ftypes = split ("\t", $ft); my %rec; $rec{MAX_FLDLEN} = 100; $rec{NUM_RECORDS} = 0; $rec{COMMENTS}->[0] = $comment; for ($i=0; $i <= $#fnames; $i++) { $rec{ORDER}->[$i] = $fnames[$i]; $rec{FIELDS}->{$fnames[$i]}->{FTYPE} = $ftypes[$i]; $rec{FIELDS}->{$fnames[$i]}->{FCOMMENT} = ""; } return %rec; } #------------------------------------------------------------- #------------------------------------------------------------- sub db_get_table_header { my ($table) = @_; %rdb = get_rdb_table_header ($table); return %rdb; } #------------------------------------------------------------- # This will add a new record to the in-memory table. Another # routine is needed to actually write the file. That other # routine should handle file locking. #------------------------------------------------------------- sub db_add_record { my ($autoinc_fname, $fldstr, $valstr, %rdb) = @_; my $i; @fields = split ('\t', $fldstr); @values = split ('\t', $valstr); for ($i=0; $i <= $#fields; $i++) { if (defined $values[$i]) { $input{$fields[$i]} = $values[$i]; } else { $input{$fields[$i]} = ""; } } #--------------------------------------------------------- # if necessary, get the next available key. #--------------------------------------------------------- my $rec; my $max = -1; # Does the field even exist? if ($rdb{FIELDS}->{"$autoinc_fname"}->{FTYPE} ne "") { # Find max value. for ($rec=0; $rec <= ($rdb{NUM_RECORDS}-1); $rec++) { $val = $rdb{FIELDS}->{"$autoinc_fname"}->{VALUE}->[$rec]; if ($val > $max) { $max = $val; } } } if ($max < 0) { $newid = 0; } else { $newid = $max + 1; } # insert the new record $newrec = $rdb{NUM_RECORDS}; my $fld = ($rdb{ORDER}); foreach $fn (@$fld) { if ($fn eq $autoinc_fname) { $rdb{FIELDS}->{"$fn"}->{VALUE}->[$newrec] = $newid; } elsif (defined $input{"$fn"}) { $rdb{FIELDS}->{"$fn"}->{VALUE}->[$newrec] = $input{"$fn"}; } else { $rdb{FIELDS}->{"$fn"}->{VALUE}->[$newrec] = ""; } } $rdb{NUM_RECORDS}++; return %rdb; } #------------------------------------------------------------- # This will edit an existing record in the in-memory table. Another # routine is needed to actually write the file. That other # routine should handle file locking. #------------------------------------------------------------- sub db_edit_record { my ($offset, $fldstr, $valstr, %rdb) = @_; my $i; # Create a hash of the new fields: $input{} = @fields = split ('\t', $fldstr); @values = split ('\t', $valstr); for ($i=0; $i <= $#fields; $i++) { if (defined $values[$i]) { $input{$fields[$i]} = $values[$i]; } else { $input{$fields[$i]} = ""; } } # edit the record my $fld = ($rdb{ORDER}); foreach $fn (@$fld) { if (defined $input{"$fn"}) { $rdb{FIELDS}->{"$fn"}->{VALUE}->[$offset] = $input{"$fn"}; } else { $rdb{FIELDS}->{"$fn"}->{VALUE}->[$offset] = ""; } } return %rdb; } #------------------------------------------------------------- # This will add a new record to the in-memory table. Another # routine is needed to actually write the file. That other # routine should handle file locking. #------------------------------------------------------------- sub db_delete_record { my ($fname, $fvalue, %rdb) = @_; my $i; my $deleted = 0; for ($rec=0; $rec <= ($rdb{NUM_RECORDS}-1); $rec++) { # if the field values match, mark as deleted. if ($rdb{FIELDS}->{"$fname"}->{VALUE}->[$rec] eq $fvalue) { $rdb{DELETED}->[$rec] = 1; $deleted++; } } return ($deleted, %rdb); } #============================================================= # RDB SUPPORT ROUTINES #============================================================= #------------------------------------------------------------- # Given an RDB query, return a structure containing the header # (field names, field types) structure. #------------------------------------------------------------- sub get_rdb_table_header { my ($query) = @_; my %tbl; # open rdb table file open (RDBFILE, "cat $query |"); my $processed_comments = 0; my $processed_fieldnames = 0; my $processed_fieldtypes = 0; my $comment_idx = 0; my @forder; my @ftypes; my $fld; my @data; my $recnum = 0; $tbl{MAX_FLDLEN} = 0; # read each record while () { chop; # read comment records if ((substr($_, 0, 1) eq "#") && ($processed_comments == 0)) { $tbl{COMMENTS}->[$comment_idx++] = $_; } # read field names elsif ($processed_fieldnames == 0) { $processed_comments = 1; $processed_fieldnames = 1; # save the order of the field names @forder = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { $tbl{ORDER}->[$fld] = $forder[$fld]; } } # read field types elsif ($processed_fieldtypes == 0) { $processed_fieldtypes = 1; @ftypes = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { ($type, @fld_comment) = split (' ', $ftypes[$fld]); $tbl{FIELDS}->{$forder[$fld]}->{FCOMMENT} = join (' ', @fld_comment); $tbl{FIELDS}->{$forder[$fld]}->{FTYPE} = $type; } # break out field comments last; # we're done, exit loop. } } # close rdb table file close (RDBFILE); return %tbl; } #------------------------------------------------------------- # Read an RDB table into a perl structure. # #------------------------------------------------------------- sub get_rdb_table { my ($query) = @_; my %tbl; # open rdb table file open (RDBFILE, "$query |"); my $processed_comments = 0; my $processed_fieldnames = 0; my $processed_fieldtypes = 0; my $comment_idx = 0; my @forder; my @ftypes; my $fld; my @data; my $recnum = 0; $tbl{MAX_FLDLEN} = 0; # read each record while () { chop; # read comment records if ((substr($_, 0, 1) eq "#") && ($processed_comments == 0)) { $tbl{COMMENTS}->[$comment_idx++] = $_; } # read field names elsif ($processed_fieldnames == 0) { $processed_comments = 1; $processed_fieldnames = 1; # save the order of the field names @forder = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { $tbl{ORDER}->[$fld] = $forder[$fld]; } } # read field types elsif ($processed_fieldtypes == 0) { $processed_fieldtypes = 1; @ftypes = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { ($type, @fld_comment) = split (' ', $ftypes[$fld]); $tbl{FIELDS}->{$forder[$fld]}->{FCOMMENT} = join (' ', @fld_comment); $tbl{FIELDS}->{$forder[$fld]}->{FTYPE} = $type; } # break out field comments } # read each data record else { @data = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { if (! defined ($data[$fld])) { $data[$fld] = ""; } $tbl{FIELDS}->{$forder[$fld]}->{VALUE}->[$recnum] = $data[$fld]; # track the length of the longest field. if (length($data[$fld]) > $tbl{MAX_FLDLEN}) { $tbl{MAX_FLDLEN} = length($data[$fld]); } } $recnum++; } } $tbl{NUM_RECORDS} = $recnum; if ($tbl{MAX_FLDLEN} > 80) { $tbl{MAX_FLDLEN} = 80; } elsif ($tbl{MAX_FLDLEN} < 20) { $tbl{MAX_FLDLEN} = 20; } # close rdb table file close (RDBFILE); return %tbl; } #------------------------------------------------------------- # Given a RDB table perl structure, write the data to file # $filename. #------------------------------------------------------------- sub write_rdb_table { (my $filename, $make_backup, %rdb) = @_; my $idx; my $fld; my $order = ($rdb{ORDER}); my $textout; my $backup_postfix = 0; my $rc = 1; # A return code of 1 indicates failure. # Lock the rdb table. if (db_file_lock ($filename) == 0) { print STDERR "Couldn't lock file!\n"; return $rc; } # back up the original file... if ($make_backup != 0) { $backup_filename = sprintf ("%s.bak%d", $filename, $backup_postfix++); while (-e $backup_filename) { $backup_filename = sprintf ("%s.bak%d", $filename, $backup_postfix++); } # move current file to backup file. if (-e $filename) { my $okay = system ("mv $filename $backup_filename"); if ($okay != 0) { # Unlock the file before returning. db_file_unlock ($filename, 0); return $rc; } } } #----------------------------- if (! open (OUTFILE, "> $filename")) { print STDERR "$0: Unable to open file $filename. $!\n"; # Unlock the file before returning. db_file_unlock ($filename, 0); return $rc; } # COMMENTS my $comments = $rdb{COMMENTS}; for ($idx=0; $idx <= $#$comments; $idx++) { print OUTFILE $comments->[$idx]."\n"; } # FIELD NAMES $textout = $order->[0]; for ($fld=1; $fld <= $#$order; $fld++) { $textout .= "\t".$order->[$fld]; } print OUTFILE $textout."\n"; # FIELD TYPES $textout = $rdb{FIELDS}->{$order->[0]}->{FTYPE}; for ($fld=1; $fld <= $#$order; $fld++) { $textout .= "\t".$rdb{FIELDS}->{$order->[$fld]}->{FTYPE}; } print OUTFILE $textout."\n"; # DATA my $rec; for ($rec=0; $rec <= ($rdb{NUM_RECORDS}-1); $rec++) { if ((! defined($rdb{DELETED}->[$rec])) || ($rdb{DELETED}->[$rec] != 1)) { $textout = $rdb{FIELDS}->{$order->[0]}->{VALUE}->[$rec]; for ($fld=1; $fld <= $#$order; $fld++) { $textout .= "\t".$rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$rec]; } print OUTFILE $textout."\n"; } } close (OUTFILE); $rc = 0; # Unlock the file before returning. db_file_unlock ($filename, 0); return $rc; } #------------------------------------------------------------- # Read an RDB table into a perl structure. # #------------------------------------------------------------- sub get_rdb_table_from_array { my (@array) = @_; my %tbl; my $processed_comments = 0; my $processed_fieldnames = 0; my $processed_fieldtypes = 0; my $comment_idx = 0; my @forder; my @ftypes; my $fld; my @data; my $recnum = 0; $tbl{MAX_FLDLEN} = 0; # process each record foreach $_ (@array) { chop; # read comment records if ((substr($_, 0, 1) eq "#") && ($processed_comments == 0)) { $tbl{COMMENTS}->[$comment_idx++] = $_; } # read field names elsif ($processed_fieldnames == 0) { $processed_comments = 1; $processed_fieldnames = 1; # save the order of the field names @forder = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { $tbl{ORDER}->[$fld] = $forder[$fld]; } } # read field types elsif ($processed_fieldtypes == 0) { $processed_fieldtypes = 1; @ftypes = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { ($type, @fld_comment) = split (' ', $ftypes[$fld]); $tbl{FIELDS}->{$forder[$fld]}->{FCOMMENT} = join (' ', @fld_comment); $tbl{FIELDS}->{$forder[$fld]}->{FTYPE} = $type; } # break out field comments } # read each data record else { @data = split ("\t", $_); for ($fld=0; $fld <= $#forder; $fld++) { if (! defined ($data[$fld])) { $data[$fld] = ""; } $tbl{FIELDS}->{$forder[$fld]}->{VALUE}->[$recnum] = $data[$fld]; # track the length of the longest field. if (length($data[$fld]) > $tbl{MAX_FLDLEN}) { $tbl{MAX_FLDLEN} = length($data[$fld]); } } $recnum++; } } $tbl{NUM_RECORDS} = $recnum; if ($tbl{MAX_FLDLEN} > 80) { $tbl{MAX_FLDLEN} = 80; } elsif ($tbl{MAX_FLDLEN} < 20) { $tbl{MAX_FLDLEN} = 20; } return %tbl; } #----------------------------------------------------------------- #----------------------------------------------------------------- sub rdb_sort_table { my ($fname, $ascending, %rdb) = @_; my $order = ($rdb{ORDER}); my $i, $j; my $a, $b; my $temp; my $changed; for ($i=0; $i <= ($rdb{NUM_RECORDS}-1); $i++) { $changed = 0; for ($j=1; $j <= ($rdb{NUM_RECORDS}-1); $j++) { # Compare target fields of adjacent records. $a = $rdb{FIELDS}->{"$fname"}->{VALUE}->[$j-1]; $b = $rdb{FIELDS}->{"$fname"}->{VALUE}->[$j]; # Ascending Sort if (($ascending == 1) && ($a gt $b)) { # Swap records - Iterate across all fields for (my $fld=0; $fld <= $#$order; $fld++) { $temp = $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j-1]; $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j-1] = $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j]; $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j] = $temp; } $changed = 1; } # Descending Sort elsif (($ascending != 1) && ($a lt $b)) { # Swap records - Iterate across all fields for (my $fld=0; $fld <= $#$order; $fld++) { $temp = $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j-1]; $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j-1] = $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j]; $rdb{FIELDS}->{$order->[$fld]}->{VALUE}->[$j] = $temp; } $changed = 1; } } # Short circuit if nothing changed during an entire iteration. if ($changed == 0) { last; } } return %rdb; } ################ end RDB-specific db_ routines ################ 1;