Bug #102021 for Palm-ThinkDB: More fixes for ThinkDB.pm

What follows is my latest patch file for ThinkDB.pm. It includes previously reported fixes, plus fixes for more problems that I have run across: 1) In the type 87 database record I noticed in one of my SmartList-To-Go databases that the usual pattern of two null characters following field names was--at times--two null characters with an extraneous character between them. Unmodified ThinkDB.pm couldn't handle this alteration in the usual pattern. 2) In fields that are lists, or in the list of Categories, unmodified ThinkDB.pm cannot deal properly with the case where deletions to the field list or the Categories list have been made. --- ./original/ThinkDB.pm 2001-06-12 15:11:10.000000000 -0500 +++ ./original/fixed/ThinkDB.pm 2015-02-09 11:01:28.000000000 -0600 @@ -58,7 +58,7 @@ # Column names! Yowch. if ($record_type == 1) { - my ($numcols, @trash, $tcnum, $tctype, $tcname, $tidx); + my ($numcols, @trash, $tcnum, $tctype, $tcname, $tidx, $bool); _debug_print("Columns:\n"); $data = substr $data, 1; ($numcols, @trash) = unpack("C13", $data); @@ -67,11 +67,20 @@ for (my $i = 1; $i <= $numcols; $i++) { (@trash[0..1], $tcnum, $tctype, @trash[0..9]) = unpack("C13", $data); $tidx = index($data, "\000", 14); - $tcname = substr($data, 14, $tidx - 14); - _debug_printf(" i: $i colnum: %03d coltype: %02d colname: '%s'\n", $tcnum, $tctype, $tcname); + # deal with case where two null characters don't follow field name + # in rare cases there is an extraneous character present, between the + # two null characters + $bool = (substr($data, $tidx + 1, 1) ne "\000"); + if ($bool) { + die " trouble with field names, stopping at" + if substr($data, $tidx + 2, 1) ne "\000"; + } + $tcname = substr($data, 14, $tidx - 14); + _debug_printf(" i: $i colnum: %03d coltype: %02d colname: '%s'\n", + $tcnum, $tctype, $tcname); $self->{cols}[$tcnum]{type} = $tctype; $self->{cols}[$tcnum]{name} = $tcname; - + $tidx++ if $bool; $data = substr $data, $tidx; } _debug_print("\n"); @@ -79,20 +88,25 @@ # List items elsif ($record_type > 2 && $record_type < 82) { - my (@list, $colid, $num, @order); + my (@list, @list2, $colid, $num, @order, $idx); $data = substr $data, 1; $colid = $record_type - 2; ($num) = unpack("C", $data); if ($num > 0) { - (@order) = unpack("C$num", $data); + (@order) = unpack("C$num", substr $data, 1); (@list) = split("\000", substr($data, $num + 1), $num + 1); # get rid of trailing garbage! pop @list; # Sort according to order? Not needed -- only for aesthetics #(@list) = @list[sort { $order[$a] <=> $order[$b] } 0 .. $#list]; - + $idx = 0; + foreach (@order) { + @list2[$_] = @list[$idx]; + $idx++; + } $self->{list}{$colid} = \@list; - + $self->{list2}{$colid} = \@list2; + $self->{order}{$colid} = \@order; _debug_print("Record ID: ", $record{id}, "\n", " List Record for Column $colid\n", " Ordering: ", join(", ", @order), "\n", @@ -107,11 +121,12 @@ # Unpack a record my $foo; - my ($type, $id) = unpack "CxN", $data; + my ($type, $cat, $id) = unpack "CCN", $data; _debug_printf(" type: %d id: %d\n", $type, $id); $data = substr $data, 6; $record{idnum} = $id; + $record{category} = $cat; if ($id > $self->{high_id}) { $self->{high_id} = $id; } @@ -145,7 +160,7 @@ } # Float elsif ($ctype == 4) { - my (@val) = unpack("s2", $data); + my (@val) = unpack("f>", $data); _debug_printf(" col: %02d data: %s\n", $cid, join(',', @val)); $record{col}{$cid} = $val[0]; $record{raw}{$cid} = substr $data, 0, 4; @@ -154,7 +169,7 @@ # List! elsif ($ctype == 5) { my ($val) = unpack("C", $data); - $record{col}{$cid} = $self->{list}{$cid}[$val - 1]; + $record{col}{$cid} = $self->{list2}{$cid}[$val]; _debug_printf(" col: %02d idx: %d val: '%s'\n", $cid, $val, $record{col}{$cid}); $data = substr $data, 1; @@ -291,7 +306,7 @@ $record->{idnum} = ++$self->{high_id}; } - $retval = pack("CxN", 87, $record->{idnum}); + $retval = pack("CCN", 87, $record->{category}, $record->{idnum}); foreach my $field (sort { $a <=> $b } keys %{$record->{col}}) { $ctype = $self->{cols}[$field]{type}; @@ -311,9 +326,14 @@ elsif ($ctype == 3) { $retval .= pack("N", $record->{col}{$field}); } + #Float + elsif ($ctype == 4) { + $retval .= pack("f>", $record->{col}{$field}); + } + # List elsif ($ctype == 5) { - $retval .= pack("C", $self->list_lookup($field, $record->{col}{$field})); + $retval .= pack("C", $self->list_lookup_2($field, $record->{col}{$field})); } # Checkbox elsif ($ctype == 6) { @@ -419,6 +439,19 @@ } } return 0; +} + +sub list_lookup_2 { + my $self = shift; + my $cid = shift; + my $txt = shift; + + for (my $i = 0; $i <= $#{$self->{list2}{$cid}}; $i++) { + if ($self->{list2}{$cid}[$i] eq $txt) { + return $i; + } + } + return 0; } sub add_to_list { -- Alan Wehmann Alan.Wehmann@gmail.com