Tip: Creative use of the forward and back browser buttons can be very
helpful here, to view current data or recover lost data.
EOF
&printfooter ;
exit ; # hmm, not the cleanest
}
# Copy "in_nnn" fields into $dbdata{$in{'key'}} (used by add and update)
# Currently, this does NOT fill in gaps in data, e.g. (in_001, in_003) is
# only two fields, not three with a blank one in the middle.
sub putfieldstodb {
# create full data string, removing empty fields at the end
my(@field)= sort grep(/^in_\d\d\d$/, keys %in) ;
$#field-- while ( ($#field>0) && !length($in{$field[$#field]}));
# Normalize raw CRLF into LF, to accommodate brain-dead OS's
foreach (@field) { $in{$_}=~ s/\r\n/\n/g }
$dbdata{$in{'key'}}= join($delim, map { &slashunescape($_) } @in{@field}) ;
}
#----- translation to/from slash-escaped string format ---------------
# unescape the user input into raw data
sub slashunescape {
my($s)= @_ ;
$s=~ s/(\\(n|r|t|f|b|a|e|0(?!\d\d)|\d\d\d|x[0-9A-Fa-f]{2}|c.|\\))/
eval qq(\"$1\") /ge ;
return $s ;
}
# use backslashes to escape string, to make it suitable for input form
sub slashescape {
my($s)= @_ ;
$s=~ s/\\/\\\\/g ;
$s=~ s/\n/\\n/g ;
$s=~ s/\r/\\r/g ;
$s=~ s/\t/\\t/g ;
$s=~ s/\f/\\f/g ;
$s=~ s/\x08/\\b/g ;
$s=~ s/\a/\\a/g ;
$s=~ s/\e/\\e/g ;
$s=~ s/\0(?!\d\d)/\\0/ ;
$s=~ s/([\ca-\cz])/ "\\c" . chr(ord($1)+64) /ge ;
$s=~ s/([^\x20-\x7e])/ "\\x" . sprintf("%02x",ord($1)) /ge ;
return $s ;
}
# Identical to &slashescape(), except doesn't escape \n
sub slashescapetextarea {
my($s)= @_ ;
$s=~ s/\\/\\\\/g ;
$s=~ s/\r/\\r/g ;
$s=~ s/\t/\\t/g ;
$s=~ s/\f/\\f/g ;
$s=~ s/\x08/\\b/g ;
$s=~ s/\a/\\a/g ;
$s=~ s/\e/\\e/g ;
$s=~ s/\0(?!\d\d)/\\0/ ;
$s=~ s/([\ca-\ci\ck-\cz])/ "\\c" . chr(ord($1)+64) /ge ;
$s=~ s/([^\x20-\x7e\n])/ "\\x" . sprintf("%02x",ord($1)) /ge ;
return $s ;
}
#----- routines to calculate various globals and arrays --------------
# Calculate all global scalars and arrays, as part of initialization.
# Order is sometimes important here.
# None of these should need recalculating; they should all be constant.
sub calcglobals {
@safein{keys %in}= map { &HTMLescape($_) } values %in ;
# Save database definition to send to script again
$dbdefnget= &urlencodelist(&subhash(*in, qw(file delim columns referer))) ;
$dbdefnpost= &hiddenvars(&subhash(*in, qw(file delim columns referer))) ;
$delim= ($in{'delim'}=~ /\d/)
? join("", map { chr } ($in{'delim'}=~ /(\d+)/g) )
: $DEFAULT_DELIM ;
$safedelim= &slashescape($delim) ;
# Columns are "title:flags"; store in @title and @flags[]{flags}.
# Flags are one char and may take numeric value, e.g. "title:a5b11cd".
# Default flag value is 1. Initial numeric value stored in 'preflag'. (?)
# could be cleaner here...
@column= (split(/\s*,\s*/, $in{'columns'})) ;
for (0..$#column) { ($title[$_],$flags[$_])= split(/:/, $column[$_], 2) }
@title= map { &HTMLescape($_) } @title ;
foreach (0..$#flags) {
($flags[$_])= { 'preflag', split(/([a-zA-Z])/, $flags[$_]) } ;
foreach $key (keys %{$flags[$_]}) {
$flags[$_]{$key}= '1' unless length($flags[$_]{$key}) ;
}
}
}
# Find current parameters of table
# columns start with column 0
sub calctablesize {
&findmaxwidths ;
$lastcol= ($#column>$#maxwidth) ? $#column : $#maxwidth ;
}
# Find maximum widths of data in columns
# jsm-- field array could be saved to use later, for speed?
sub findmaxwidths {
@maxwidth= () ;
@maxheight= () ;
foreach $key (keys %dbdata) {
my($i, $numlines) ;
foreach (split(/$delim/, $dbdata{$key})) {
# @maxheight() calc is only needed for textareas, but let's
# figure all of them, may come in handy.
$numlines= s/\n/\n/g + 1 ;
$maxheight[$i]= $numlines if $maxheight[$i]<$numlines ;
if ($flags[$i]{'t'}) {
foreach my $l (split(/\n/)) {
$l= &slashescape($l) ;
$maxwidth[$i]= length($l) if $maxwidth[$i]
$debug
Editing "$safein{'file'}" database
$topmsg
EOF
}
# Print common footer
sub printfooter {
print <
DBMEdit 1.0