APLawrence.com -  Resources for Unix and Linux Systems, Bloggers and the self-employed

Creating Simple Logs with Perl and HTML

There are often situations where you just need a simple log that multiple people can add to. Sometimes people do this with shared Excel spreadsheets or simple Access databases.

Here I wrote a very simple HTML Perl log creator. This is very basic, although you could easily extend it for more features. As presented here, it lets you design logs with up to 20 fields. The first field is always either a unique value that you will enter, or an automatically incrementing unique field. The code will not allow duplicate records where the key field (the first field) is not unique. All other fields are text.

Be sure to enter lengths for the fields. This is only used as the display length for inputting new data; you can actually enter data of any length.

You can go back and edit field lengths at any time or delete the log if you know its password (you set the password when you first create the log).

Locking is enforced to allow multiple users and enforce the unique keys.

To edit or delete an existing record, enter its key field. This will bring up a page asking if you want to leave the old data, replace it with your new entry, or delete both the old record and your new entry.

Searching is simple, case insensitive across all fields at the same time.

There are just two scripts that go in your cgi-bin directory. These assume a subdirectory of "db"; you need to create that or change the scripts.

Main script is "index.pl":

#!/usr/bin/perl
use CGI qw(:standard);
$mywww="/usr/home/pcunix/www/";
dbmopen %CONFIG, "$mywww/data/db/config", 0700;
foreach $i (param) {
   foreach $j (param($i)) {
       $$i=$j;
       $CONFIG{$i}=$j;
   }
}
$overpass="justdoit";

if ($killit =~ /Delete/ ) {
   $killit =~ s/Delete /DB_/;
   delete $CONFIG{$killit};
   unlink "$mywww/data/db/$killit.db";
   $killit =~ s/DB_/PA_/;
   delete $CONFIG{$killit};
   dbmclose %CONFIG;
   dbmopen %CONFIG, "$mywww/data/db/config", 0700;
}
print header;
print <<EOF;
<html><head><title>Simple database creation</title></head>
<body>
<h2>Simple Databases</h2>
<form action="/cgi-bin/db/index.pl" method="POST">
EOF
if ( $dbnew ) {
  $dbkey="DB_$dbnew";
  $dbpass="PA_$dbnew";
  $CONFIG{$dbpass}=$password;
    $CONFIG{$dbkey}="$fn0|$fn1|$fn2|$fn3|$fn4|$fn5|$fn6|$fn7|$fn8|$fn9";
    $CONFIG{$dbkey} .="|$fn10|$fn11|$fn12|$fn13|$fn14|$fn15|$fn16|$fn17|$fn18|$fn19";
    $CONFIG{$dbkey} .="|$fl0|$fl1|$fl2|$fl3|$fl4|$fl5|$fl6|$fl7|$fl8|$fl9";
    $CONFIG{$dbkey} .="|$fl10|$fl11|$fl12|$fl13|$fl14|$fl15|$fl16|$fl17|$fl18|$fl19";
    $CONFIG{$dbkey} .="|$ft0|$ft1|$ft2|$ft3|$ft4|$ft5|$ft6|$ft7|$ft8|$ft9";
    $CONFIG{$dbkey} .="|$ft10|$ft11|$ft12|$ft13|$ft14|$ft15|$ft16|$ft17|$ft18|$ft19";
}
if ($create eq "new")
  {
    print <<EOF;
    <p>Name : <input name = "create" size = 30 >
    <p>Password <input type=password name=password size=15 maxlength=15>
    <p>(or type name of existing database to edit)
    <p><input type="submit" value="Edit or Create " name=newdb>
    <p><input type="submit" value="Delete Database" name=newdb>
        </form></body></html>
EOF
    dbmclose %CONFIG;
    exit 0;
} 
if ($create ) {
  $dbkey="DB_$create";
  $dbpass="PA_$create";
     print "<h2>$create</h2>";
   if ($CONFIG{$dbkey} ) {
     @dbase=split /\|/, $CONFIG{$dbkey};
     if ($password ne $CONFIG{$dbpass} and $password ne $overpass ) {
     print <<EOF;
<p><h2>Incorrect Password! </h2>
<p><input type="submit" value="Refresh">
</form></body></html>
EOF
exit 0;
     }
if ($newdb eq "Delete Database") {
print <<EOF;
<p><h2>Delete $create ? </h2> 
<p><input type="submit" value="Delete $create" name=killit> 
<p><input type="submit" value="Cancel" name=killit> 
</form></body></html>
EOF
exit 0;

}
     $password=$CONFIG{$dbpass}; 
     print <<EOF;
<p>Database $create exists- assuming edit
<p>WARNING: Changing field lengths or types can cause data loss.
EOF
   }
  $CONFIG{$dbpass}=$password;
    print '<p><input type="submit" value="Submit Changes">';
    print "<p>New password: <input type=password name=password value=$password>";
    print "<p><table><tr><th>Field Name</th><th>Length</th><th>Type</th>\n";
    for ($i=0; $i < 20; $i++) {
       $fval=$dbase[$i];
       $lval=$dbase[$i + 20];
       $tval=$dbase[$i + 40];
       print "<tr><td><input name=\"fn$i\" value=\"$fval\">";
       print "</td><td><input name=\"fl$i\" value=\"$lval\" size=3>";
       print "</td><td><select name=\"ft$i\" ><option " if $i == 0; 
       print "selected" if $tval eq "Auto Increment" and $i == 0;
       print ">Auto Increment<option " if $i == 0;
       print "selected" if $tval eq "Unique Key" and $i == 0;
       print ">Unique Key</select></td>\n " if $i == 0;
       print "</td></tr>\n " if $i gt 0;
       #print "selected" if $tval eq "Text" and $i > 0;
       #print ">Text<option " if $i > 0;
       #print "selected" if $tval eq "Number" and $i gt 0;
       #print ">Number</select></td></tr>\n " if $i gt 0;
    }
    print "</table>";
  $CONFIG{$dbkey}="" unless ($CONFIG{$dbkey} ne "");
print <<EOF; 
<p><input type="hidden" name="dbnew" value="$create">
</form></body></html>
EOF
dbmclose %CONFIG;
exit 0;
}
print '<p><a href="http://aplawrence.com/cgi-bin/db/index.pl?create=new">Edit or Create New</a><p>';
foreach (sort keys CONFIG) {
  $dbname=$_;
  $dbname =~ s/^DB_//;
  print "<br><a href=\"/cgi-bin/db/access.pl?open=$dbname\">$dbname</a>" if /^DB/;
}
print <<EOF; 
<p><input type="submit" value="Refresh">
<p>
February 2002 Tony Lawrence <a href="http://aplawrence.com/index.html">aplawrence.com</a>
<p>
There are often situations where you just need a simple log that multiple people can add to.   Sometimes people do this with shared Excel spreadsheets or 
simple Access databases.
<p>This is very basic, although you could easily extend it for more features.
As presented here, it lets you design logs with up to 20 fields.  The first field is always either a unique value that you will enter, or an automatically incrementing unique field.  The code will not allow duplicate records where the 
key field (the first field) is not unique.  All other fields are text.
<p>Be sure to enter lengths for the fields.  This is only used as the display length for inputting new data; you can actually enter data of any length.

<p>You can go back and edit field lengths at any time or delete the log if you 
know its password (you set the password when you first create the log).
<p>Locking is enforced to allow multiple users and enforce the unique keys.
<p>To edit or delete an existing record, enter its key field.  This will bring up a page asking if you want to leave the old data, replace it with your new entry, or delete both the old record and your new entry.
<p>Searching is simple, case insensitive across all fields at the same time.
<p>There are just two scripts that go in your cgi-bin directory. These assume 
a subdirectory of "db"; you need to create that or change the scripts.
<hr>

</form></body></html>
EOF
dbmclose %CONFIG;
 

This is "access.pl"
#!/usr/bin/perl
use CGI qw(:standard);
use Fcntl ':flock';
$mywww="/usr/home/pcunix/www/";
# for creation or deletion, name is passed as arg
# but it's also used as a parameter while working with logs
$open=shift @ARGV;
$lock_file="$mywww/data/db/locking";
$ok=1;
@dbase="";
# pickup CGI parameters- could be $open also
foreach $i (param) {
   foreach $j (param($i)) {
       $$i=$j;
       $CONFIG{$i}=$j;
   }
}
$db="DB_$open";
$dbkey=$db;
# config file open
dbmopen %CONFIG, "$mywww/data/db/config", null;
# create the logfile if it's not already there
$recordcount=getrecs();

if ($searchfor) {
    searchlog(); exit 0;
}

$add="" if ( $edit =~ /No/ ); 

if ($edit =~ /Yes/ ) {
  my_writ($rkey,$tdata);
  $add="";
}
if ($edit =~ /Delete/ ) {
  my_writ($rkey,"");
  $add="";
}

if ($add ) {
  $ok=$fn0;
  dbmopen %DATA, "$mywww/data/db/$db", null;
  foreach (keys %DATA ) {
    @list=split /\|/, $DATA{$_};
    $ok=0 if $list[0] eq $fn0;
    $rkey=$_;
    $odata=$DATA{$rkey};
    last if not $ok;
  }
dbmclose %DATA;
}
if ($add and $ok) {
    $recordcount=getrecs();
    $recordcount++;
    $key= sprintf("%0.20d",$recordcount);
    $tdata="$fn0|$fn1|$fn2|$fn3|$fn4|$fn5|$fn6|$fn7|$fn8|$fn9";
    $tdata .="$fn10|$fn11|$fn12|$fn13|$fn14|$fn15|$fn16|$fn17|$fn18|$fn19";
    my_writ($key,$tdata);
}
## If the write above  failed, $ok is false 
#
if ($add and not $ok ) {
  myheader();
    $tdata="$fn0|$fn1|$fn2|$fn3|$fn4|$fn5|$fn6|$fn7|$fn8|$fn9";
    $tdata .="$fn10|$fn11|$fn12|$fn13|$fn14|$fn15|$fn16|$fn17|$fn18|$fn19";
  @odata=split /\|/, $odata; 
  print "Replace $odata[0] $odata[1] $odata[2] $odata[3] $odata[4]..";
  print "<p>With $fn0  $fn1 $fn2 $fn3 $fn4..?";
  print "<input type=hidden value=\"$tdata\" name=tdata>";
  print "<input type=hidden value=\"$rkey\" name=rkey>";
  print "<input type=hidden value=\"$open\" name=open>";
  print "<input type=hidden value=\"Add New Entry\" name=add>";
  print '<p><input type=submit value="Yes, replace it" name=edit>';
  print ' <input type=submit value="No, leave original" name=edit>';
  print '<p><input type=submit value="Delete both of them" name=edit>';
  print "</form> </body></html>";
  exit 0;
}
        
myheader();
print <<EOF;
<p>Add Entry:
<table><tr>
EOF
@dbase=split /\|/, $CONFIG{$dbkey};
$val=getlast(); $val++;
for ($x=0; $x < 20 ; $x++ ) {
  last if not $dbase[$x] or not $dbase[$x+20];
  print "<th width=$dbase[$x+20]>$dbase[$x]</th>";
}
print "</tr><tr>";
 for ($x=0; $x < 20 ; $x++ ) {
  last if not $dbase[$x] or not $dbase[$x+20];
  print "<td><input name=fn$x size=$dbase[$x+20]";
   if ($x == 0 and $dbase[$x+40] eq "Auto Increment") {
      print " value=$val";
   }
  print "> </td>";
}

print <<EOF;;
</tr></table>
<p><input type=hidden value="$open" name=open>
<p><input type=submit value="Add New Entry" name=add></form>
<hr>
<form action="/cgi-bin/db/access.pl" method=POST>
<p><input type=hidden value="$open" name=open>
<p>Search: <input name=searchfor>
<p><input type=submit value="Search" name=search></form>
</form>
EOF
$count=0;
$lastc=0;
  print "<table><tr>";
  for ($x=0; $x < 20 ; $x++ ) {
  $lastc=$x;
  last if not $dbase[$x] or not $dbase[$x+20];
  print "<th width=$dbase[$x+20]>$dbase[$x]</th>";
}
print "</tr>";
dbmopen %DATA, "$mywww/data/db/$db", null;
foreach (reverse sort keys %DATA ) {
  next if not $DATA{$_};
  @list=split /\|/, $DATA{$_};
  print "<tr>";
  for ($x=0; $x < $lastc; $x++) {
     print "<td>$list[$x]</td>" ;

  } 
  last if $count++ == 50;
}
print "</tr></table>";
dbmclose %CONFIG;
dbmclose %DATA;
my_close;

sub myheader() {
print header, <<EOF;
<html><head><title>$open</title></head>
<body>
<h2>$open</h2>
<p><a href="http://aplawrence.com/cgi-bin/db/index.pl">Select new log</a>
<form action="/cgi-bin/db/access.pl" method=POST>
EOF
}
sub my_writ() {
open LOCK, ">$lock_file";
$too_long=0;
until (flock(LOCK, LOCK_EX | LOCK_NB)) {
  sleep 1;
  $too_long++;
  if ($too_long > 30) {
  exit 0;
  }
}
$db="DB_$open";
$ok=1;
dbmopen %DATA, "$mywww/data/db/$db", null;
  foreach (keys %DATA ) {
    @list=split /\|/, $DATA{$_};
    $ok=0 if $list[0] eq $fn0;
    $srkey=$_;
    $odata=$DATA{$srkey};
    last if not $ok;
  }
## If this does find a dupe now, it just is not going to write it
#
$ok = 1 if ( $edit =~ /Yes/ or $edit =~ /Delete/);
$DATA{$_[0]}=$_[1] if $ok ;
delete $DATA{$_[0]} if ( $edit =~ /Delete/);
close LOCK;
dbmclose %DATA;
print "wrote to $_[0]\n" if $debug;
}

sub searchlog() {
  @dbase=split /\|/, $CONFIG{$dbkey};
  print header;
  print "<html><head><title>$open</title><body><h2>$open $searchfor</h2>";
  print "<table><tr>\n";
  for ($x=0; $x < 20 ; $x++ ) {
  $lastc=$x;
  last if not $dbase[$x] or not $dbase[$x+20];
  print "<th width=$dbase[$x+20]>$dbase[$x]</th>\n";
}
print "</tr>";
dbmopen %DATA, "$mywww/data/db/$db", null;
  foreach (reverse sort keys %DATA ) {
    if ($DATA{$_} =~ /$searchfor/i) {
      @list=split /\|/,$DATA{$_};
  print "\n<tr>";
  for ($x=0; $x < $lastc; $x++) {
     print "<td>$list[$x]</td>" ;

  } 

    }
  }
dbmclose %DATA;
print "</table>";
print "</body></html>";

}
sub getrecs() {
dbmopen %DATA, "$mywww/data/db/$db", 0700;
$recordcount=keys(%DATA);
dbmclose %DATA;
return $recordcount;
}
sub getlast() {
dbmopen %DATA, "$mywww/data/db/$db", 0700;
$val="";
foreach (%DATA) {
      @list=split /\|/,$DATA{$_};
      $val=$list[0] if $list[0] > $val;
}
dbmclose %DATA;
return $val;
}
 

Got something to add? Send me email.





(OLDER)    <- More Stuff -> (NEWER)    (NEWEST)   

Printer Friendly Version

-> -> Creating Simple Logs with Perl and HTML




Increase ad revenue 50-250% with Ezoic


More Articles by

Find me on Google+

© Tony Lawrence



Kerio Samepage


Have you tried Searching this site?

Unix/Linux/Mac OS X support by phone, email or on-site: Support Rates

This is a Unix/Linux resource website. It contains technical articles about Unix, Linux and general computing related subjects, opinion, news, help files, how-to's, tutorials and more.

Contact us





The danger of computers becoming like humans is not as great as the danger of humans becoming like computers. (Konrad Zuse)

In fact, my main conclusion after spending ten years of my life working on the TEX project is that software is hard. It’s harder than anything else I’ve ever had to do. (Donald Knuth)












This post tagged: