#!/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
~;
}
sub footer {
print qq~
~;
}
sub build_record_page {
my (%record) = @_;
my ($val) = "";
my ($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~
~;
&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~| $field | ~;
}
print qq~
| 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~| $field | ~;
}
print qq~
~;
foreach $result (@results) {
%rec = &process_record(&grab_data($result));
print qq~~;
foreach $field (@db_fields) {
print qq~| ~.&nl2br($rec{$field}).qq~ | ~;
}
print qq~
~;
}
print qq~
~;
&footer;
}
sub multi_match {
my ($type,$action,$what,@results) = @_;
my (%rec);
&header($search_num." Matches Found For ". $form{'search_term'});
print 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~
~;
&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~
~;
}
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);
}