#!/usr/local/bin/perl

use CGI qw(header param);
print header();


#features skipped: types num/sum/textarea/radio
#also, needs report generation
#and multiple field sorting


#define some commonly used CGI key names,
#preprend with | so they aren't in the column name namespace

$keykey = "|key";
$keysort = "|sort";
$keydb = "|db";
$keytask = "|task";

$dbname = param($keydb);


if ((length $dbname > 50) || ($dbname !~ /^[a-zA-Z0-9_]*$/)) {
    print "Illegal database name<br>";
    exit;
}

$task = param($keytask);

#if user hasn't specified a db name, 
#print list of links to all db's

if(!(defined($dbname))){
    printheader();
    opendir(DIR,".") || print "can't open ."; #list all files in this dir
    while(defined(my $file= readdir(DIR))) {
	if($file =~ /^(.*).kdb$/ ){ #db descriptors in form of dbname.kdb
	    $dbname = $1;
	    print qq(<a href="?$keydb=$dbname">$dbname</a><br>)
	} 
    }
    closedir(DIR);
    exit;
} 


#we have a dbname, try to open it
dbmopen(%db,"./$dbname",0644) || print "Can't open $dbname $!<br>";


#if we have no task than just dump the database to a table
if($task eq ""){
    printheader();
    
    print qq(<a href="?$keytask=new&amp;$keydb=$dbname">add entry</a>);
    viewdata();
}

#add a new entry:

if($task eq "new") {
    printheader();
    
    loadfieldinfo(); #gets dbname from global variables
    print qq(<b>add entry:</b>);
    printform();
    
}

#edit an existing entry
#same as adding new, but we override the 'default' values

if($task eq "edit") {
    printheader();

    loadfieldinfo(); #gets dbname from global variables
    print qq(<b>edit entry:</b>);
    #now override fielddefault{} entries with loaded values
    $key = param("$keykey");
    $fielddefault{$keykey} = $key;
    $data = $db{$key};

    $i = 0;
    foreach $datum (split(/\n/,$data)){
	chomp $datum;
	$fieldname = $fieldnames[$i];
	$fielddefault{$fieldname} = $datum;
	$i++;
    }
    printform();
    
}

# updating can be the result of a new or edit

if($task eq "update"){

    #generate a new key if the key field is blank
    $thiskey = param("$keykey");
    if($thiskey eq ""){
	$thiskey = time.".".$$; 
    }
    
    loadfieldinfo(); #gets dbname from global variables

    #buuld the multiple column values as multiple lines in a scalar

    $data = "";
    foreach $fieldname (@fieldnames){
	$datum = param($fieldname);
	$datum =~ s/\n/ /g;

	if($fieldtype{$fieldname} eq "date"){ #ensure date fields are YYYY.MM.DD
	    $datum = cleandate($datum);
	}
	$data .= "$datum\n";
    }
    #put data into database hash
    $db{$thiskey} = $data;

    #resfresh page to view of db
    printrefreshview();
}


#deleting is pretty straightforward
if($task eq "delete"){
    $thiskey = param("$keykey");
    delete($db{$thiskey});
    printrefreshview();
}


dbmclose(%db);

# table view of data:


sub viewdata {
    loadfieldinfo(); 
    print qq(<table border="1">);
    print qq(<tr><th><i>edit</i></th>);
    $i = 0;

    #print the field names and an option to sort on this field
    foreach $fieldname (@fieldnames){
	print qq(<th>$fieldname <a href="?$keydb=$dbname&amp;$keysort=$i">vv</a></th>);
	$i++;
    }
    print qq(<th><i>delete</i></th>);

    
    calculateSortOrder();

    foreach $key(sort onSortOrder keys %db){
	#print link to edit
	print qq(<tr><th><a href="?$keydb=$dbname&amp;$keytask=edit&amp;$keykey=$key">&gt;&gt;</a></th>);
	$i = 0;

	#print all colums for this row
	foreach $datum (split(/\n/,$db{$key})){

	    #checkboxes are the only fields that needs parsing for the display

	    #changeblank entries to &nbsp; so the table doesn't fill in
	    if($datum eq "") {$datum = "&nbsp;";}
	    $datum = valuesafe($datum);

	    if($fieldtype{$fieldnames[$i]} eq "checkbox" && $datum eq "on"){
		$datum = "<center><b>X</b></center>";
	    } 	    

	    print qq(<td>$datum</td>);
	    $i++;
	}

	# in case the last few fields were blank, we need
	# to generate filler TD's until we have as many TDs 
	# as fieldnames...
	while($i <= $#fieldnames){
	    print qq(<td>&nbsp;</td>);
	    $i++;
	}

	#print link to delete with javascript confirmation
	print qq(<td><a href="?$keydb=$dbname&amp;$keytask=delete&amp;$keykey=$key" onClick="return alert('Delete this record-- are you sure?')">xxx</a></td>);
	print qq(</tr>);

    }
    print qq(</tr>);
    print qq(</table>);
}

# print a form to edit/create an entry
# basically, go through all the fields(columns) for this database and 
# print a UI piece of the appropriate type
# --the default fields will be the db defaults if this is new, otherwise
# --should have been overriden with the values for this entry
sub printform {
    print qq(<form><input type="hidden" name="$keydb" value="$dbname">\n<input type="hidden" name="$keytask" value="update">\n<table border=1>);
    foreach $fieldname (@fieldnames){
	print qq(<tr><td align="right">$fieldname</td><td>);

	if($fieldtype{$fieldname} eq "text") {
	    $value = valuesafe($fielddefault{$fieldname});
	    print qq(<input type="text" name="$fieldname" size="$fieldlength{$fieldname}" value="$value">);
	}

	if($fieldtype{$fieldname} eq "checkbox") {
	    $prechecked = "";
	    if($fielddefault{$fieldname} eq "on"){
		$prechecked = " CHECKED ";
	    }
	    print qq(<input type="checkbox" name="$fieldname" $prechecked>);
	}

	if($fieldtype{$fieldname} eq "select") {
	    print qq(<select name="$fieldname"><option value="">select...\n);
	    foreach $thisoption(split(/\,/,$fieldoptions{$fieldname})){
		$selected = "";
		if($fielddefault{$fieldname} eq $thisoption){
		    $selected = " SELECTED ";
		}
		print qq(<option $selected>$thisoption\n);
	    }
	    print qq(</select>);
	}

	if($fieldtype{$fieldname} eq "date") {
	    $defaultdate = $fielddefault{$fieldname};
	    if($defaultdate eq ""){ #calculate todays date if we have none
		($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
		$year += 1900;
		$mon++;
		if(length($mday) == 1) { $mday = "0".$mday;}
		if(length($mon) == 1) { $mon = "0".$mon;}
		$defaultdate = "$year.$mon.$mday";
	    }
	    print qq(<input type="text" name="$fieldname" size="10" value="$defaultdate">);
	}


	print qq(</td></tr>\n);
    }
    
    print qq(<tr><td>&nbsp;</td><td><input type="submit" value="update"></td></tr>\n);
    print qq(<input type="hidden" name="$keykey" value="$fielddefault{$keykey}"></form>);
    print qq(</table>);

}


# read the db descriptor, load the data for each field, including extra data for the various types


sub loadfieldinfo {
    open(READFIELDS,"< $dbname.kdb") || print "can't open $dbname.kdb $!";
    while(defined($nextline=<READFIELDS>)){
	chomp $nextline;
	($fieldname,$fieldtype,@rest) = split(/\|/,$nextline);
	push(@fieldnames,$fieldname);
	$fieldtype{$fieldname} = $fieldtype;
	if($fieldtype eq "text"){
	    $fielddefault{$fieldname} = $rest[0];
	    #assume a length default of 40 if none exists
	    if($rest[1] eq "") { $rest[1] = 40; } 
	    $fieldlength{$fieldname} = $rest[1];
	}
	if($fieldtype eq "select"){
            $fieldoptions{$fieldname} = $rest[0];
            $fielddefault{$fieldname} = $rest[1];
        }
	if($fieldtype eq "checkbox"){
            $fielddefault{$fieldname} = $rest[0];
        }

    }


    close READFIELDS;
}


#simple header
sub printheader {
    print qq(<font size=+3><b><a href=".">k/db</a></b></font><br>);
    if(dbname  ne ""){
	print qq(<font size=+2><b><a href="?$keydb=$dbname">$dbname</a></b></font><br>);
    }
}

#refresh back to plain view of this db
sub printrefreshview{
    print qq(<meta http-equiv="Refresh" content="0; URL=?$keydb=$dbname">);
}

#return YYYY.MM.DD version of this date... somewhat fragile
sub cleandate {
    my($origdate) = @_;
    if($origdate =~ /^(\d*)\.(\d*)\.(\d*)$/){
	return $origyear = makeDigitLength($1,4).".".makeDigitLength($2,2).".".makeDigitLength($3,2);
    } else { #too screwed up don't try to parse it
	return $origdate;
    }
    
}
#make strig a certain length by trimming off lefthand digits or prepending 0s
sub makeDigitLength {
    my($string,$length) = @_;
    #if the string is too long, trim the left most digits
    if(length($string) > $length){
	$string = substr($string,length($string) - $length);
    } else { # otherwise prepend zeros if/as needed
	while(length($string) < $length) {
	    $string = "0".$string;
	}
    }
    return $string;
}


# the default sort order is col 0, col 1, col 2 etc
# but it can be overriden, with one particular col being the first thing sorted
sub calculateSortOrder {
    @sortorder = (0...$#fieldnames);
    $sorton = param($keysort);
    if($sorton =~ /\d/){
	splice(@sortorder,$sorton,1);
	splice(@sortorder,0,0,($sorton));
    }
    
}

# sort on that sortorder
sub onSortOrder {
    for($i = 0; $i < $#sortorder; $i++){
	$truea =  getColByKey($a,$sortorder[$i]);
	$trueb =  getColByKey($b,$sortorder[$i]);
	if($truea ne $trueb) {
	    return $truea cmp $trueb;
	}
    }
    return $a cmp $b;
}

#return pos'th line of data for key, which corresponds to pos'th column for this row
sub getColByKey {
    my($key,$pos) = @_;
    return(split(/\n/,$db{$key}))[$pos];
}

sub valuesafe {
    my($value) = @_;
    $value =~ s/\"/&quot;/g;
    $value =~ s/\</&lt;/g;
    $value =~ s/\>/&gt;/g;
return $value;
}