#!/usr/bin/perl use DBI; use CGI::Lite; # # GLOBAL SECTION -------------------------------------------------------------- # $g_database = "Inventory"; $g_edit_password = "insert password here"; $g_delete_password = "insert password here"; $g_create_password = "insert password here"; $debug = 0; # # COLORS ---------------------------------------------------------------------- # $g_color_tbl_info_bg = "#505050"; $g_color_tbl_info_txt = "#ffffff"; $g_color_tbl_edit_bg = "#ffff99"; $g_color_tbl_edit_required = "#cc0000"; $g_color_matching_txt = "#ff0000"; # # Regular expressions # $g_re_name = "[a-zA-Z\\s\\-\\'\\.]+"; $g_re_title = "[a-zA-Z\"\\s\\-\\'\\.\\,\\:\\&\\%\\$\\#\\!\\(\\)\\+\\=\\\\\/]+"; $g_re_text = "[a-zA-Z\"\'\.\?\!\-0-9\#\%\&\(\)\_]*"; $g_re_file = "[a-zA-Z_-0-9\./]+"; # # The mysql tables we are managing -------------------------------------------- # @g_tables = ( "books", "cds", "MP3" ); # # The list of every field in each table and its type/length ------------------- # # field 1st char: n)umeric, c)har, t)extbox # name 2..n char: maximum size in chars %g_books_fields = ( "id" => "n10:\\d+", "title" => "c60:$g_re_title", "author" => "c40:$g_re_name", "isbn" => "c10:[\\dxX]{10}", "publisher" => "c40:$g_re_name", "comments" => "t:$g_re_text" ); %g_cds_fields = ( "id" => "n10:\\d+", "cddbid", => "c10:[a-fA-F\d]+", "genre", => "c20:[a-zA-Z\s]+", "artist", => "c40:$g_re_name", "title", => "c40:$g_re_title", "length", => "c12:\\d+", "tracks", => "t:$g_re_text" ); %g_MP3_fields = ( "id" => "n10:\\d+", "artist", => "c80:$g_re_name", "title", => "c80:$g_re_title", "album", => "c80:$g_re_title", "composer", => "c80:$g_re_name", "track", => "n10:\\d+", "genre", => "s1:$g_re_text", "path", => "c80:$g_re_file", "comment", => "c80:$g_re_text", "minutes", => "n3:\\d+", "seconds", => "n3:\\d+", "bitrate", => "n3:\\d+", "frequency",=> "n10:[\\d\\.]+"); %g_drop_downs = ( "s1", => \@g_genre_dd ); @g_genre_dd = ( "acoustic", "alternative", "ambient", "blues", "cabaret", "celtic", "christian", "classic rock", "classical", "country", "dance", "easy", "elect", "ethnic", "folk", "funk", "gothic", "grunge", "hard", "hip-hop", "instrumental", "jazz", "latin", "metal", "new age", "oldies", "other", "pop", "punk", "r\&b", "rap", "rave", "reggae", "rock", "soundtrack", "southern", "ska", "swing", "trip-hop", "vocal", "world" ); %g_all_fields = ( "books" => \%g_books_fields, "cds" => \%g_cds_fields, "MP3" => \%g_MP3_fields); %g_key_fields = ( "books" => "id", "cds" => "id", "MP3" => "id" ); # # Which fields are EDITABLE, how ---------------------------------------------- # # n)ever editable # editable if p)assword correct # visible a)lways editable # field +) always editable but append only # *) editable w/ right pw, otherwise append %g_books_efields = ( "1id" => "n", "2title" => "p", "3author" => "p", "4isbn" => "p", "5publisher" => "p", "6comments" => "*" ); %g_cds_efields = ( "1id" => "n", "2cddbid", => "p", "3genre", => "p", "4artist", => "p", "5title", => "p", "6length", => "p", "7tracks", => "p" ); %g_MP3_efields = ( ); %g_edit_fields = ( "books" => \%g_books_efields, "cds" => \%g_cds_efields, "MP3" => \%g_MP3_efields ); # # Fields you can SEARCH on, and how to build the SQL -------------------------- # # searchable how to build # field the SQL query %g_books_sfields = ( "1title" => "REGEXP '~'", "2author" => "REGEXP '~'", "3isbn" => "='~'" ); %g_cds_sfields = ( "1title" => "REGEXP '~'", "2artist" => "REGEXP '~'", "3tracks" => "REGEXP '~'" ); %g_MP3_sfields = ( "1title" => "REGEXP '~'", "2artist" => "REGEXP '~'", "3composer" => "REGEXP '~'", "4album" => "REGEXP '~'", "5genre" => "REGEXP '~'"); %g_search_fields = ( "books" => \%g_books_sfields, "cds" => \%g_cds_sfields, "MP3" => \%g_MP3_sfields ); # # Visible fields in the search RESULTS view ----------------------------------- # # visible friendly # field name %g_books_rfields = ( "1title" => "Title", "2author" => "Author", "3isbn" => "ISBN", "4publisher"=> "Publisher" ); %g_cds_rfields = ( "2artist" => "Artist", "1title" => "Title", "3cddbid" => "CDDBID" ); %g_MP3_rfields = ( "1artist", => "Artist", "2composer",=> "Composer", "3title", => "Title", "4album", => "Album", "5genre", => "Genre", "6path", => "Link", "7minutes", => "Minutes", "8seconds", => "Seconds", "9bitrate", => "Bitrate", "0frequency",=> "Frequency" ); %g_results_fields =( "books" => \%g_books_rfields, "cds" => \%g_cds_rfields, "MP3" => \%g_MP3_rfields ); # # What fields you need to get when CREATING a new record ---------------------- # # n)ot enterable # field r)equired # name o)ptional %g_books_cfields = ( "1id" => "n", "2title" => "r", "3author" => "r", "4isbn" => "o", "5publisher" => "r", "6comments" => "o" ); %g_cds_cfields = ( "1id" => "n", "2cddbid", => "o", "3genre", => "o", "4artist", => "r", "5title", => "r", "6length", => "o", "7tracks", => "r" ); %g_MP3_cfields = ( ); %g_create_fields = ( "books" => \%g_books_cfields, "cds" => \%g_cds_cfields, "MP3" => \%g_MP3_cfields ); # # MISC ------------------------------------------------------------------------ # $g_url = "http://wannabe.guru.org/scott/tools/dbase.cgi"; $g_db_user = "www"; $g_db_password = "insert password here"; # # PROGRAM ENTRY POINT --------------------------------------------------------- # main: { # # Connect to the msql database # $g_dbh = DBI->connect("dbi:mysql:$g_database",$g_db_user,$g_db_password); $g_cgi = new CGI::Lite; # # Parse the form data from the page that called us. # %g_form = $g_cgi->parse_form_data; # # Validate the table they want to use # my(@x) = grep(/$g_form{"table"}/, @g_tables); if (@x == ()) { &Error("table name " . $g_form{"table"} . " is invalid."); } # # Validate the command and, if it's ok, do it # if ($g_form{"command"} eq "search") { print "Content-type: text/html\n\n"; &SendSearchForm; $sql = &MakeSearchSQL; &SendSearchResults($sql); } elsif ($g_form{"command"} eq "details") { print "Content-type: text/html\n\n"; &ShowDetail; } elsif ($g_form{"command"} eq "update") { print "Content-type: text/html\n\n"; &UpdateEntry; &ShowDetail; } elsif ($g_form{"command"} eq "delete") { print "Content-type: text/html\n\n"; &DeleteEntry; &SendSearchForm; } elsif ($g_form{"command"} eq "add entry") { print "Content-type: text/html\n\n"; &ReadNewEntry; } elsif ($g_form{"command"} eq "create") { print "Content-type: text/html\n\n"; &CreateEntry; &ClearForm; &SendSearchForm; } elsif ($g_form{"command"} eq "get this playlist") { print "Content-type: audio/x-mpegurl\n\n"; $sql = &MakeSearchSQL; &SendPlaylist($sql); } else { print "Content-type: text/html\n\n"; &SendSearchForm; } # # Cleanup and exit # $g_dbh->disconnect; exit(0); } sub SqlQuote { my($sql) = @_; # # Change any \'s to \\'s # $sql =~ s/\\/\\\\/g; # # Change any quotes to escaped quotes # $sql =~ s/'/\\'/g; $sql =~ s/"/\\"/g; # # Change any wildcards to escaped symbols # $sql =~ s/%/\\%/g; $sql =~ s/_/\\_/g; $sql =~ s/\[/\\\[/g; $sql =~ s/\]/\\\]/g; # # Change any special characters to two char equivalents # $sql =~ s/\n/\\n/g; $sql =~ s/\r/\\r/g; $sql =~ s/\t/\\t/g; $sql; } sub ClearForm { my($temp) = $g_form{"table"}; %g_form = {}; $g_form{"table"} = $temp; } # # Error: make an HTML error page using message passed in argument ------------- # sub Error { @args = @_; print <@args
There was an error processing your request. Sorry about that. Please try again later or something. END ; $g_dbh->disconnect; exit(1); } # # MakeEmptyEditBox: Return HTML for an appropriate empty edit box to prompt # the user for $table.$field based upon that field's type. # sub MakeEmptyEditBox { my($table, $field) = @_; my($fields) = $g_all_fields{$table}; my($type) = $fields->{$field}; my($size) = 20; my($maxsize) = 20; my($rval) = ""; if (($type =~ /^c(\d+)\:/) || ($type =~ /^n(\d+)\:/)) { $size = $1; $maxsize = $size; $size = 80 if ($size > 80); $rval .= ""; } elsif ($type =~ /^t\:/) { $rval .= ""; } else { $rval .= ""; } return($rval); } sub MakePopulatedEditBox { my($table, $field, $value) = @_; my($fields) = $g_all_fields{$table}; my($type) = $fields->{$field}; my($size) = 20; my($maxsize) = 20; my($rval) = ""; if (($type =~ /^c(\d+)\:/) || ($type =~ /^n(\d+)\:/)) { $size = $1; $maxsize = $size; $size = 80 if ($size > 80); $rval .= "$value"; } else { $rval .= ""; } return($rval); } sub MakeDisplayBox { my($table, $field, $value) = @_; my($fields) = $g_all_fields{$table}; my($type) = $fields->{$field}; my($size) = 20; my($rval) = ""; if (($type =~ /^c(\d+)\:/) || ($type =~ /^n(\d+)\:/)) { $size = $1; if ($field eq "path") { $value =~ s#^/usr/local/export#\\\\SCOTCH\\EXPORT#g; $value =~ s#/#\\#g; $value =~ s#\\_#_#g; $rval = "$value"; } else { $rval .= "$value"; } } elsif ($type =~ /^t\:/) { $value =~ s/\~/\n/g; $rval .= "
$value
"; } elsif ($type =~ /^s\d+\:/) { $value =~ s/\,/
/g; $rval .= "$value"; } else { $rval .= ""; } return($rval); } # # Sends the search form (populated with the values they searched for, if any) # sub SendSearchForm { # # Print search form header # print <
END ; # # Print one table entry for each searchable field in the table # my($table) = $g_form{"table"}; my($sfields) = $g_search_fields{$table}; my($fields) = $g_all_fields{$table}; my($field); my($html); print "\n" if ($debug); foreach $field (sort keys %{$sfields}) { print "\n" if $debug; $field =~ s/^.//; my($duh) = $g_form{$field}; my(@x) = $g_cgi->get_multiple_values($g_form{$field}); if ($#x) { $duh = "|"; for $y (@x) { $duh .= "$y|"; } } my($type) = $fields->{$field}; my($maxsize) = 20; my($size) = 20; print "\n" if $debug; if (($type =~ /^n(\d+)\:/) || ($type =~ /^c(\d+)\:/)) { $size = $1; $maxsize = $size; $size = 80 if ($size > 80); $html = ""; } elsif ($type =~ /^t\:/) { $size = 80; $maxsize = 200; $html = ""; } elsif ($type =~ /^(s\d+)\:/) { # # Drop down list hack # $html = "
\n"; my($rsel) = $g_drop_downs{$1}; my($sel); for $sel (@{$rsel}) { if ($duh =~ /$sel/) { $html .= "$sel\n"; } $html .= "
\n"; } else { print ""; next; } print < END ; } # # Print table footer # $y = $g_form{"table"}; print <

$field: END ; if ($type =~ /^s\d+\:/) { print "

\n"; } print <

$html
END ; return(0); } sub MakeSearchSQL { print "\n" if ($debug); my($table) = $g_form{"table"}; my($sfields) = $g_search_fields{$table}; my($rfields) = $g_results_fields{$table}; my($sql) = "select * from "; my($var); my($val); my($sfield); my($qval); my($x); my($connector); # # Sanity check the table field and add it to the SQL # if ((defined($g_all_fields{$table})) && ($table =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$table where "; } else { print "

Access denied.

\n"; return; } # # Look at all variables the user filled in on the search form # for $var (sort keys(%g_form)) { # # Can't search for nothing # next if ($g_form{$var} =~ /^\s*$/); # # Skip over crap vars (field names) # #next if ($g_form{$var} !~ /^[0-9a-zA-Z \"]+$/); # # Search fields must appear in $sfields # for $sfield (keys %{$sfields}) { $old = $sfield; $sfield =~ s/^.//; if ($var eq $sfield) { # # Add this term's restrictions to the search # $val = $g_form{$var}; @foo = $g_cgi->get_multiple_values($g_form{$var}); if ($#foo) { $val = "|"; for $f (@foo) { $val .= "$f|"; } $f = $var; $f .= "_connector"; $connector = $g_form{$f}; if (($connector ne "OR") && ($connector ne "AND")) { $connector = "OR"; } } $val =~ tr/A-Z/a-z/; print "\n" if ($debug); # # Skip over crap search values (field values) # if ($val =~ /^[0-9a-zA-Z\,\:\!\.\?\$\%\"\'\| ]+$/) { if ($val =~ /\|/) { $val =~ s/\|$//; $sql .= " ( "; while($val =~ /\|([^\|]+)/) { $qval = &SqlQuote($1); $r = "(lcase($var) REGEXP '$qval') $connector "; $val =~ s/\|[^\|]+/$r/; } $val =~ s/ $connector $/\)/; $sql .= "$val and "; } else { $qval = &SqlQuote($val); $sql .= "lcase($var) " . $sfields->{$old} . " and "; $sql =~ s/\~/$qval/; } } last; } } } # # Remove the last " where " or " and " from $sql because there # will be no more terms tacked on the end. This means that if they # searched for nothing then they will get back _all_ records from # the table. Change this if you don't like that behavior. # $sql =~ s/ [a-z]+ $//; # # Make sure the SQL doesn't have an unquoted semi-colon somehow # $x = $sql; $x =~ s/\'[^\']*\'//g; if ($x =~ /;/) { print "

Access denied.

\n"; return; } $sql; } sub SendSearchResults { my($table) = $g_form{"table"}; my($sfields) = $g_search_fields{$table}; my($rfields) = $g_results_fields{$table}; my($num_hits) = 0; my($severity) = 0; my(@time) = ( 0, 0, 1, 2, 5, 10 ); my($sth); my($field); my($sql) = @_; # # Do it # print "\n" if ($debug); $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr); if ($sth->execute) { # # Results table header # print "
\n"; print ""; print "\n\n"; # # If it's MP3 table, make a playlist link # if ($table eq "MP3") { my(@k) = keys %{$rfields}; my($w) = $#k; $w += 2; print ""; } # # Do the table col headers # foreach $field (sort keys %{$rfields}) { $field =~ s/^.//; print "\n"; } print "\n"; # # Results table body, one result per line # while (my $record = $sth->fetchrow_hashref) { $num_hits++; if (($num_hits % 100) == 0) { $severity++; $severity = 5 if ($severity > 5); sleep($sec[$severity]); } print "\n"; for $field (sort keys %{$rfields}) { $field =~ s/^.//; $val = $record->{$field}; # # Make matching text red # if ($g_form{$field} !~ /^$/) { $val =~ s/$g_form{$field}/$g_form{$field}<\/FONT><\/B>/gi; } my $x = MakeDisplayBox($table, $field, $val); print "\n"; } # # Special action buttons per-result line # my $keyfield = $g_key_fields{$table}; print <


END ; } } else { &Error($sth->errstr); } $sth->finish; # # Table footer # print "
"; print ""; print < END ; foreach $field (keys %{g_form}) { if ($field ne "command") { my(@x) = $g_cgi->get_multiple_values($g_form{$field}); if ($#x) { for $y (@x) { print ""; } } else { print "\n"; } } } print "
"; print "$field"; print "
"; print "tools:
"; print "
$x
"; if ($num_hits == 0) { print "
No matches found.
\n"; } } sub SendPlaylist { my($table) = $g_form{"table"}; my($sfields) = $g_search_fields{$table}; my($rfields) = $g_results_fields{$table}; my($sql) = @_; my($sth); my($var); my($val); my($field); my($sfield); # # Sanity check the table field and add it to the SQL # if ((!defined($g_all_fields{$table})) || ($table !~ /^[a-zA-Z0-9]+$/)) { print "

Access denied.

\n"; return; } # # SELECT * ==> SELECT path # $sql =~ s/SELECT \*/SELECT path/i; # # Do it # print "\n" if ($debug); print "
\n";

    $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr);
    if ($sth->execute)
    {
        while (my $record = $sth->fetchrow_hashref)
        {
            for $field (sort keys %{$rfields})
            {
                $field =~ s/^.//;
                $val = $record->{$field};
                
                $val =~ s#^/usr/local/export#\\\\SCOTCH\\EXPORT#g;
                $val =~ s#/#\\#g;
                #my $x = MakeDisplayBox($table, $field, $val);
                print "$val\n" if ($val);
            }
        }
    }
    else
    {
        &Error($sth->errstr);
    }
    $sth->finish;
    print "
\n"; } sub ShowDetail { print "" if ($debug); my($table) = $g_form{"table"}; my($keyfield) = $g_key_fields{$table}; my($efields) = $g_edit_fields{$table}; my($fields) = $g_all_fields{$table}; my($sth); my($var); my($val); my($sql) = "select * from "; my($q); # # Sanity check the table field and add it to the SQL # if ((defined($g_all_fields{$table})) && ($table =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$table where "; } else { print "

Access denied.

\n"; return; } # # Sanity check the g_form{"key"} and add it to the sql # if (($g_form{"key"} =~ /^[0-9]+$/) && ($keyfield =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$keyfield=" . $g_form{"key"}; } else { print "

Access denied.

\n"; return; } # # Was the password ok? If so we are in edit mode. If not we are simply # showing details. # my($pwdok) = 0; $pwdok = 1 if ($g_form{"password"} eq $g_edit_password); # # Details header # print <Record details

END ; # # Details data, one line at a time # # # Don't process the SQL if it has a semi-colon in it somehow # if ($sql =~ /;/) { print "

Access denied.

\n"; return; } # # Do it. # print "\n" if ($debug); $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr); if ($sth->execute) { while (my $record = $sth->fetchrow_hashref) { foreach $var (sort keys %{$efields}) { $old = $var; $var =~ s/^.//; print "\n"; $val = $record->{$var}; print "\n"; print "\n"; # # Is this field editable in this view? # if (($efields->{$old} eq "+") || (($efields->{$old} eq "*") && ($pwdok == 0))) { # # Always editable but append-only # print "\n"; } elsif ($efields->{$old} eq "a") { # # Always editable # print "\n"; } elsif ((($efields->{$old} eq "p") || ($efields->{$old} eq "*")) && ($pwdok == 1)) { # # Editable with the right password... and the password # was right! # print "\n"; } else { # # Not editable, just display it. # print "\n"; } print "\n"; } } } else { &Error($sth->errstr); } $sth->finish; # # Details footer # print <
"; print ""; print " $var: \n"; my $x = &MakeDisplayBox($table, $var, $val); print "$x\n"; $x = &MakeEmptyEditBox($table, $var); print "$x"; my $x = &MakePopulatedEditBox($table, $var, $val); print "$x"; my $x = &MakePopulatedEditBox($table, $var, $val); print "$x"; my $x = &MakeDisplayBox($table, $var, $val); print "$x
END ; } sub UpdateEntry { print "\n" if ($debug); my($table) = $g_form{"table"}; my($keyfield) = $g_key_fields{$table}; my($efields) = $g_edit_fields{$table}; my($fields) = $g_all_fields{$table}; my($sql)="update "; my($var, $val, $field); my($pwdok) = 0; my($numterms) = 0; my($sth); my($re); my($x); # # Sanity check the table field and add it to the SQL # if ((defined($g_all_fields{$table})) && ($table =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$table set "; } else { print "

Access denied.

\n"; return; } # # Check the password # $pwdok = 1 if ($g_form{"password"} eq $g_edit_password); for $var (sort keys(%g_form)) { # # Safeguard: Skip over crap var data (field name) # next if ($var !~ /^[0-9a-zA-Z]+$/); # # Edit fields must appear in $efields # for $field (sort keys %{$efields}) { $old = $field; $field =~ s/^.//; if ($var eq $field) { print "\n"; # # Make sure this term is either a)lways editable or # editable with the right p)assword (and, if so, that # the password was right...) # if (($efields->{$old} eq "a") || (($efields->{$old} eq "p") && ($pwdok == 1)) || (($efields->{$old} eq "*") && ($pwdok == 1))) { # # Add this term's change to the SQL line # $val = $g_form{$var}; # # normalize this data # if ($fields->{$field} =~ /^[^:]+\:(.+)$/) { $re = $1; } else { $re = "\w"; $re = "\d" if ($fields->{$field} =~ /^n/); if ($fields->{$field} =~ /[cnt](\d+)\:/) { $re .= "{1\,$1}"; } } if ($val =~ /$re/) { $q = SqlQuote($val); # # Add it to the SQL statement # $sql .= "$field="; if (($fields->{$field} =~ /^c/) || ($fields->{$field} =~ /^t/)) { $sql .= "'" . $q . "', "; } else { $sql .= "$q, "; } $numterms++; } last; } # # It could also be + which indicates publically writable # (i.e. no need to check the password) but only appendable. # This only makes sense for character or textarea type data. # elsif (($efields->{$old} eq "+") || (($efields->{$old} eq "*") && ($pwdok == 0))) { $val = $g_form{$var}; # # normalize this data # if ($fields->{$field} =~ /^[^:]+\:(.+)$/) { $re = $1; } else { $re = "\w"; $re = "\d" if ($fields->{$field} =~ /^n/); if ($fields->{$field} =~ /[cnt](\d+)\:/) { $re .= "{1\,$1}"; } } if ($val =~ /$re/) { $q = SqlQuote($val); # # Add it to the SQL # if (($fields->{$field} =~ /^c/) || ($fields->{$field} =~ /^t/)) { $sql .= "$field=concat($field,'\n---\n','"; $sql .= $q . "'), "; $numterms++; } else { print "\n"; } } last; } else { print ""; } } } } if ($numterms > 0) { # # Drop the last ", " and add the where clause # $sql =~ s/, $//; $sql .= " where "; # # Sanity check keyfield and key # if (($keyfield =~ /^[a-zA-Z0-9]+$/) && ($g_form{"key"} =~ /^[0-9]+$/)) { $sql .= "$keyfield=" . $g_form{"key"}; } else { print "

Access denied.

\n"; return; } # # Make sure the resulting SQL doesn't somehow have a semi-colon # in it. # $x = $sql; $x =~ s/\'[^\']*\'//g; if ($x =~ /;/) { print "

Access denied.

\n"; return; } # # Do it # print "\n" if ($debug); $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr); if ($sth->execute) { print "

Record updated.

\n"; } else { &Error($sth->errstr); } } } sub DeleteEntry { print "\n" if ($debug); my($table) = $g_form{"table"}; my($keyfield) = $g_key_fields{$table}; my($sql)="delete from "; # # Sanity check the table field and add it to the SQL # if ((defined($g_all_fields{$table})) && ($table =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$table "; } else { print "

Access denied.

\n"; return; } # # Check the password # if ($g_form{"password"} eq $g_delete_password) { $sql .= " where "; # # Sanity check keyfield and key # if (($keyfield =~ /^[a-zA-Z0-9]+$/) && ($g_form{"key"} =~ /^[0-9]+$/)) { $sql .= "$keyfield=" . $g_form{"key"}; } else { print "

Access denied.

\n"; return; } # # Make sure the SQL doesn't have a semi-colon in it somehow # if ($sql =~ /;/) { print "

Access denied.

\n"; return; } # # Do it # print "\n" if ($debug); $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr); if ($sth->execute) { print "

Entry ".$g_form{"key"}." successfully deleted.

\n"; } else { &Error($sth->errstr); } } else { print "\n"; print "

Access denied.

\n"; } } sub ReadNewEntry { print "\n" if ($debug); my($table) = $g_form{"table"}; my($keyfield) = $g_key_fields{$table}; my($cfields) = $g_create_fields{$table}; my($fields) = $g_all_fields{$table}; my($var); # # Create header # print <Create a new record

END ; foreach $var (sort keys %{$cfields}) { $old = $var; $var =~ s/^.//; print "\n"; print "\n"; print "\n"; # # Is this field enterable? # if ($cfields->{$old} ne "n") { if ($cfields->{$old} eq "r") { # # required field # print "\n"; } elsif ($cfields->{$old} eq "o") { print "\n"; } else { print "\n"; } } else { # # Not editable, just display it. # print "\n"; } print "\n"; } # # Create footer # print <
"; print ""; print " $var: "; my $x = &MakeEmptyEditBox($table, $var); print "$x"; my $x = &MakeEmptyEditBox($table, $var); print "$x"; my $x = &MakeDisplayBox($table, $var, "default"); print "$x
END ; } sub CreateEntry { print "\n" if ($debug); my($table) = $g_form{"table"}; my($keyfield) = $g_key_fields{$table}; my($cfields) = $g_create_fields{$table}; my($fields) = $g_all_fields{$table}; my($sql) = "INSERT INTO "; my(@col) = (); my(@val) = (); my($v); my($re); my($field); my($x); # # Sanity check the table field and add it to the SQL # if ((defined($g_all_fields{$table})) && ($table =~ /^[a-zA-Z0-9]+$/)) { $sql .= "$table "; } else { print "

Access denied.

\n"; return; } # # Check the password # if ($g_form{"password"} ne $g_create_password) { print "

Access denied.

\n"; return; } for $field (sort keys %{$cfields}) { $old = $field; $field =~ s/^.//; print "\n"; # # If we said never create new data on this field, don't let anyone. # if (($cfields->{$old} eq "n") && (defined($g_form{$field}))) { print "\n"; next; } # # If we said this field is required, make sure they entered it. # if (($cfields->{$old} eq "r") && ((!defined($g_form{$field})) || ($g_form{$field} =~ /^\s*$/))) { print "\n"; print "

Not created, required field missing.

\n"; return; } if (($cfields->{$old} eq "r") || ($cfields->{$old} eq "o")) { $v = $g_form{$field}; # # normalize this data # if ($fields->{$field} =~ /^[^:]+\:(.+)$/) { $re = $1; } else { $re = "\w"; $re = "\d" if ($fields->{$field} =~ /^n/); if ($fields->{$field} =~ /[cnt](\d+)\:/) { $re .= "{1\,$1}"; } } print "\n"; if ($v =~ /$re/) { # # If we get here, it's ok to add this one to the SQL # $v = SqlQuote($v); print "\n"; push @col, $field; # # See what kind of data this is so we know whether to # put quotes around it. # if (($fields->{$field} =~ /^c/) || ($fields->{$field} =~ /^t/)) { $v = "'$v'"; } push @val, $v; } elsif ($cfields->{$old} eq "r") { print "\n"; return; } } } print "\n"; # # Build the rest of the SQL from the two stacks # $sql .= "("; while($a = (pop @col)) { $sql .= "$a,"; } $sql .= ") VALUES ("; while($a = (pop @val)) { $sql .= "$a,"; } $sql .= ")"; $sql =~ s/\,\)/\)/g; # # Make sure the sql doesn't somehow have an unquoted semi-colon # $x = $sql; $x =~ s/\'[^\']*\'//g; if ($x =~ /;/) { print "

Access denied.

\n"; return; } # # Do it # print "\n" if ($debug); $sth = $g_dbh->prepare($sql) || &Error($g_dbh->errstr); if ($sth->execute) { print "

Entry successfully created.

\n"; } else { &Error($sth->errstr); } }