#!/usr/bin/perl # Define Your Database Fields Here Like So # Field Name => [Number, 'Readable Name', 'type of field, two options are text or textarea' %fields = ( ID => [0, 'Link ID:', 'text'], Name => [1, 'Name:', 'text'], Email => [2, 'E-Mail Address:', 'text'], Phone => [3, 'Phone Number:', 'text'], Address => [4, 'Street Address:', 'textarea'] ); # IF you are not using ID as your key, specify the name here. $db_key = 'ID'; $delimeter = "|"; $file = "./file.cgi"; $numberfile = "./num.cgi"; @db_fields = (); # Holds Specific Field Information foreach $field (sort { $fields{$a}[0] <=> $fields{$b}[0] } keys %fields) { $db_id{$field} = $fields{$field}[0]; $db_name{$field} = $fields{$field}[1]; $db_type{$field} = $fields{$field}[2]; push @db_fields, $field; } %form = &parse; &print_headers; if ($form{'action'} eq "addrecord") { &add_record; } elsif ($form{'action'} eq "add_record_two") { &add_record_two; } elsif ($form{'action'} eq "edit") { &edit; } elsif ($form{'action'} eq "edit_two") { &edit_two; } elsif ($form{'action'} eq "edit_three") { &edit_three; } elsif ($form{'action'} eq "edit_four") { &edit_four; } elsif ($form{'action'} eq "delete") { &delete_record; } elsif ($form{'action'} eq "delete_two") { &delete_two; } elsif ($form{'action'} eq "delete_three") { &delete_three; } elsif ($form{'action'} eq "search") { &header("Search For Something"); &search_form("search_two"); &footer; } elsif ($form{'action'} eq "search_two") { &search_two; } else { &header("Simple Perl Database"); &footer; } sub header { $title = shift; print qq~ $title
Make your own free website on Tripod.com
~; } sub footer { print qq~
Add A Record Modify a Record Delete a Record Search
~; } sub build_record_page { my (%record) = @_; my ($val) = ""; my ($html) = qq~~; foreach $obj (@db_fields) { if ($obj eq $db_key) { next; # ID's are dynamically made, so why let the user do it? } $html .= qq~~; } $html .= "
Record
$db_name{$obj}~; if ($db_type{$obj} eq "text") { # Makes the text box if ($record{$obj}) { $val = qq~ VALUE="$record{$obj}"~; } else { $val = ""; } $html .= qq~~; } elsif ($db_type{$obj} eq "textarea") { # Makes the textarea if ($record{$obj}) { $val = qq~$record{$obj}~; } else { $val = ""; } $html .= qq~~; } $html .= qq~

"; print $html; } sub print_headers { # Print out the headers if they haven't already been printed. if (!$headers_printed) { print "Content-type: text/html\n\n"; $headers_printed = 1; } } sub get_next_id { my ($num); open (NUM, $numberfile); $num = ; close (NUM); $num++; open (NUM, ">".$numberfile); if ($flock) { flock(NUM, 2) } print NUM $num; close (NUM); return $num; } sub process_record { # changes the data format to something we can use my (@array) = @_; my (%record); my ($num) = 0; # map is similar to grep, in that it evaluates each list entry, and returns the new list with changes made. # this line looks at the available fields in $db_fields, and causes the array to go back to a usable # hash format. %record = map { $db_fields[$num] => $array[$num++] } @_; return %record; } sub grab_data { # Takes a record, and grabs it into an array my ($line) = shift; my (@data) = split (/\Q$delimeter\E/o, $line); foreach (@data) { s/``/\n/g; # Change `` back to newlines.. s/~~/$delimeter/g; # get the delimiter back } return @data; } sub get_record { my ($exist) = 0; my ($key) = shift; open(DATA, $file); while () { (/^\s*$/) and next; # Looks for blank lines chomp $_; @record = &grab_data($_); %dat = process_record(@record); if ($dat{$db_key} eq $key) { $exist = 1; last; } } close (DATA); $exist ? return (%dat) : return; } sub make_data { my %record = @_; my ($rec, $line) = ""; foreach $field (@db_fields) { # repeats for all of your configured fields $rec = $record{$field}; $rec =~ s/\r//g; # Scrap that Windows Line Feed # This pattern below compiles once, as we dont want any weird results. $rec =~ s/\Q$delimeter\E/~~/og; # Scraps the delimeter if used, and makes it ~~ $rec =~ s/\n/``/g; # Grabs Newlines, and makes them `` $line .= $rec.$delimeter; # Your Record is Being Made } chop $line; # Whoops... gotta scrap that delimiter at the end (extra one) return $line."\n"; # returns the new record, with the nice shiny line feed } sub add_record { &header("Add a Record"); print qq~

~; &build_record_page; print qq~
~; &footer; } sub add_record_two { $form{$db_key} = &get_next_id(); my ($line) = &make_data(%form); open (DATABASE, ">>".$file); if ($flock) { flock(DATABASE, 2) } print DATABASE $line; close (DATABASE); &header("Add a Record Successful"); print qq~
Here Is Your Record

~; my (%result) = get_record($form{$db_key}); if (%result) { &build_record_page(%result); } else { print "Error - No Record Added"; } &footer; } sub search { my (%dat); my ($or_match) = 0; my ($findit,$param) = ""; my @search_terms = (); ($form{'type'} eq 'phrase') ? (@search_terms = ($form{'search_term'})) : (@search_terms = split (/\s/, $form{'search_term'})); if ($form{'boolean'} eq "or") { $or_match = 1;} if ($or_match) { $param = '||' } else { $param = '&&'; } foreach $term (@search_terms) { next if (length($term) < 2); # skips single letter terms if ($form{'field'} eq "everything") { $findit .= "/\Q$term\E/oi $param "; } else { $findit .= "\$dat{\$form{'field'}} =~ /\Q$term\E/oi $param "; } } chop ($findit); chop ($findit); chop ($findit); $reg = eval "sub { $findit; }"; $@ and print "Error Processing Search" and return; open(DATA, $file); while () { (/^\s*$/) and next; # Looks for blank lines chomp $_; if ($form{'field'} eq "everything") { if (&{$reg}) { push @search_results,$_; } } else { @record = &grab_data($_); %dat = &process_record(@record); if (&{$reg}) { push @search_results,$_; } } } close (DATA); @search_results = &search_sorter(@search_results); return (@search_results); } sub search_sorter { my (@results) = @_; my(@rec); my (%temp_rec,$eval_code); $stop = @db_fields; foreach $result (@results){ (@rec) = &grab_data($result); $eval_code ='$temp_rec{$rec[0]} = { $db_key => "$rec[0]", '; for($i=1;$i<$stop;$i++){ $eval_code .= "\$db_fields[$i] => \"\$rec[$i]\",\n"; } $eval_code .= '};'; eval $eval_code; } $sort_field = $form{'sort_field'}; @results=(); foreach $field (sort { lc($a->{$sort_field}) cmp lc($b->{$sort_field}) } values %temp_rec){ $new_record = ""; for($i=0;$i<$stop;$i++){ # Now We have to make sure all of our fields are encoded again so it looks right $field->{$db_fields[$i]} =~ s/\Q$delimeter\E/~~/og; $field->{$db_fields[$i]} =~ s/\n/``/g; $new_record .= "$field->{$db_fields[$i]}\|"; } chop $new_record; push @results, $new_record; } return (@results); } sub search_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } &multi_match_view(@results) if ($search_num > 0); } sub nomatches { my $colspan = @db_fields; &header("No Matches Found For ". $form{'search_term'}); print qq~

~; foreach $field (@db_fields) { print qq~~; } print qq~
$field
No Matches Found For "$form{'search_term'}"
~; &footer; } sub multi_match_view { my (@results) = @_; my (%rec); &header($search_num." Matches Found For ". $form{'search_term'}); print qq~
~; foreach $field (@db_fields) { print qq~~; } print qq~~; foreach $result (@results) { %rec = &process_record(&grab_data($result)); print qq~~; foreach $field (@db_fields) { print qq~~; } print qq~~; } print qq~
$field
~.&nl2br($rec{$field}).qq~
~; &footer; } sub multi_match { my ($type,$action,$what,@results) = @_; my (%rec); &header($search_num." Matches Found For ". $form{'search_term'}); print qq~
~; foreach $field (@db_fields) { print qq~~; } print qq~~; foreach $result (@results) { %rec = &process_record(&grab_data($result)); print qq~~; foreach $field (@db_fields) { print qq~~; } print qq~~; } print qq~
Select
$field
~.&nl2br($rec{$field}).qq~

~; &footer; } sub edit { &header("Search To Edit"); &search_form("edit_two","To Edit"); &footer; } sub edit_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } elsif ($search_num > 0) { &multi_match("radio","edit_three","Edit",@results); } } sub edit_three { &header("Edit Record"); print qq~
~; my (%result) = get_record($form{'key'}); if (%result) { &build_record_page(%result); } else { print qq~Error --- Record Does Not Exist ~; } print qq~
~; &footer; } sub edit_four { $form{$db_key} = $form{'key'}; my ($line) = &make_data(%form); my ($found) = 0; my ($output) = ""; open (DATABASE, $file); while () { chomp($_); (/^\s*$/) and next; my (%dat) = &process_record(&grab_data($_)); if ($dat{$db_key} eq $form{'key'}) { $output .= $line; $found = 1; } else { $output .= "$_\n"; } } close (DATABASE); if ($found) { open (DATABASE, ">".$file); if ($flock) { flock(DATABASE, 2); } print DATABASE $output; close (DATABASE); } &header("Record Edited Successful"); print qq~
Here Is Your Record

~; my (%result) = get_record($form{'key'}); if (%result) { &build_record_page(%result); } else { print "Error - No Record Added"; } print qq~

~; &footer; } sub delete_record { &header("Search To Delete"); &search_form("delete_two","To Delete"); &footer; } sub delete_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } elsif ($search_num > 0) { &multi_match("checkbox","delete_three","Delete",@results); } } sub delete_three { my (@keys) = split (/,/,$form{'key'}); my ($output) = ""; my ($found) = 0; open (DATABASE, $file); while () { chomp($_); (/^\s*$/) and next; my (%dat) = &process_record(&grab_data($_)); foreach $key (@keys) { if ($dat{$db_key} eq $key) { $found = 1; } } if ($found) { $found = 0; next; } else { $output .= "$_\n"; } } close (DATABASE); open (DATABASE, ">".$file); if ($flock) { flock(DATABASE, 2); } print DATABASE $output; close (DATABASE); &header("Record Edited Successful"); print qq~
Record(s) Deleted>
~; &footer; } sub search_form { $action_val = shift; $text = shift; my ($check) = ""; print qq~
Search For a Record $text
Search Term   Type Phrase  Keywords
Boolean Connector   AND  OR
Search Fields All: ~; foreach $field (@db_fields) { if ($field eq $db_key) { next; } print qq~  $db_name{$field} ~; } print qq~
Sort By ~; foreach $field (@db_fields) { if ($field eq "ID") { $val = " CHECKED"; } else { $val = "" }; print qq~  $db_name{$field} ~; } print qq~
~; print qq~
~; } sub nl2br { #changes newlines to
's my ($tmp) = shift; $tmp =~ s/\n/\n
/g; return ($tmp); } sub parse { my (%temp); (*fval) = @_ if @_ ; local ($buf); if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN,$buf,$ENV{'CONTENT_LENGTH'}); } else { $buf=$ENV{'QUERY_STRING'}; } if ($buf eq "") { return 0 ; } else { @fval=split(/&/,$buf); foreach $i (0 .. $#fval) { ($name,$val)=split (/=/,$fval[$i],2); $val=~tr/+/ /; $val=~ s/%(..)/pack("c",hex($1))/ge; $name=~tr/+/ /; $name=~ s/%(..)/pack("c",hex($1))/ge; if (!defined($temp{$name})) { $temp{$name}=$val; } else { $temp{$name} .= ",$val"; } } } return (%temp); }