#!/usr/bin/perl ############################################# # # File: CEINewBorn.cgi # By: Tim Coston # Date: 28 Sep 99 # Last Hacked: 03 Oct 99 tlc # # # # # Copyright 1999: Coston Enterprises,Inc. # http://www.coston.net # ############################################### $scriptname = "Coston Enterprises"; $ver = "1.00"; ########################################################## # # This is NOT FREEWARE!! To use this program - you # MUST REGISTER it. # ########################################################### eval { ($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX / or Windows / ($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \ # Use the Setup File require "ceinewborn.setup"; require "ceinb_vars.pl"; require "ceinb_html.pl"; require "ceinb_styles.pl"; }; #eval if ($@) { print_header(); print "Make sure these files exist, permissions are set properly, and paths are set correctly.\n"; print "Error including required files: $@\n"; exit; } #if ############################ # Pull in the Variables ############################ local (*in) = shift if @_; # CGI input local (*incfn, # Client's filename (may not be provided) *inct, # Client's content-type (may not be provided) *insfn) = @_; # Server's filename (for spooled files) local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got); # Disable warnings as this code deliberately uses local and environment # variables which are preset to undef (i.e., not explicitly initialized) $perlwarn = $^W; $^W = 0; binmode(STDIN); # we need these for DOS-based systems binmode(STDOUT); # and they shouldn't hurt anything else binmode(STDERR); # Get several useful env variables $type = $ENV{'CONTENT_TYPE'}; $len = $ENV{'CONTENT_LENGTH'}; $meth = $ENV{'REQUEST_METHOD'}; if (!defined $meth || $meth eq '' || $meth eq 'GET' || $type eq 'application/x-www-form-urlencoded') { local ($key, $val, $i); # Read in text if (!defined $meth || $meth eq '') { $in = $ENV{'QUERY_STRING'}; $cmdflag = 1; # also use command-line options } elsif($meth eq 'GET' || $meth eq 'HEAD') { $in = $ENV{'QUERY_STRING'}; } elsif ($meth eq 'POST') { if (($got = read(STDIN, $in, $len) != $len)) {$errflag="Short Read: wanted $len, got $got\n"}; } else { &CgiDie("cgi-lib.pl: Unknown request method: $meth\n"); } @in = split(/[&;]/,$in); push(@in, @ARGV) if $cmdflag; # add command-line parameters foreach $i (0 .. $#in) { # Convert plus to space $in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; $$key = $val; # Add a 'push' for if they want to delete more than one baby... if ($key eq "nobaby") { $val = $val . "
"; push(@nobaby,$val); } # Uncoment for debugging #print " Setting \$$key to $$key\n"; } } # Uncomment, as well, for debugging #exit; ################################### # Quick Check On Admin Validity ################################### open(ACHK, "$cgipath/admin.pl"); $adminstuff = (); close(ACHK); ($Aname,$Apass,$Atr) = split(/\|/,$adminstuff,3); if($AdminNameCheck eq "$Aname") { $goodname = 1; if($PasswordCheck eq "$Apass") { $goodpass = 1; } } #if$AdminName if($goodname == 1 && $goodpass == 1) { $ga =1; } else { $ga == 0; } ############### # DO NOT EDIT ############### $scriptlink = qq~$scriptname~; # Make-up variables $printed = 0; # Initially set to zero because no header has been printed. $goodpass = 0; # Initaially set to zero because the Password hasn't been checked $goodname = 0; # Initaially set to zero because the AdminName hasn't been checked $varfile = "$cgipath/ceinb_vars.pl"; ######/\/\/\/\/\/\/\/\##############/\/\/\/\/\/\/\/\######## # # # MAIN PROGRAM! # # # ######/\/\/\/\/\/\/\/\##############\/\/\/\/\/\/\/\/######## #&get_cookie; if ( $do eq "checkin" ) { &checkin; } # - Check Admin Login elsif ( $do eq "add" ) { &add_screen; } # - Go to the Add Screen ( ceinb_html.pl ) elsif ( $do eq "del" ) { &del_screen; } # - Go to the Delete Screen ( ceinb_html.pl ) elsif ( $do eq "vue" ) { &vue_screen; } # - Go to the View Screen ( ceinb_html.pl ) elsif ( $do eq "view" ) { &view_baby; } # - Go to the Baby View Screen ( ceinb_html.pl ) elsif ( $do eq "search" ) { &search_screen;} # - Go the the Search Screen ( ceinb_html.pl ) elsif ( $do eq "searchit" ) { &search_it; } # - Perform a Search ( version 2.0 ) elsif ( $do eq "addme" ) { &add_me; } # - Perform an Addition elsif ( $do eq "reset" ) { &reset_me; } # - Reset the Entire Database elsif ( $do eq "admin" ) { &admin; } # - Go to the Admin Screen ( ceinb_html.pl ) elsif ( $do eq "variables") { &variables; } # - Go to the Variables Screen ( ceinb_html.pl ) elsif ( $do eq "SetVars" ) { &SetVars; } # - Set the Variables ( version 2.0 ) elsif ( $do eq "styles" ) { &styles; } # - Go to the Styles Screen ( ceinb_html.pl ) ( version 2.0 ) elsif ( $do eq "setstyles") { &SetStyles; } # - Set the Styles ( version 2.0 ) elsif ( $do eq "setup" ) { &new_setup; } # - First Time Setup... else { &usr_screen; } # - Go to the User Screen ( ceinb_html.pl ) exit; ###/\/\/\/\/\/\/\/\##############/\/\/\/\/\/\/\/\###### # SUB ROUTINES! # ###/\/\/\/\/\/\/\/\##############\/\/\/\/\/\/\/\/###### ####################################################### # Check The Admin Password ####################################################### sub checkin { if(-e "$cgipath/admin.pl") { open(ACHK, "$cgipath/admin.pl"); $adminstuff = (); close(ACHK); ($Aname,$Apass,$Atr) = split(/\|/,$adminstuff,3); if($AdminName eq "$Aname") { $goodname = 1; if($Password eq "$Apass") { $goodpass = 1; } } #if$AdminName if($goodname == 1 && $goodpass == 1) { $ga =1; } else { $ga == 0; } } #if-e else { unless($Password eq $Password2) { &error('Passwords Did Not Match!','P01'); } open(ANEW,">$cgipath/admin.pl"); print ANEW "$AdminName|$Password|"; close(ANEW); $ga=1; } #else if($menu eq "vars") { &variables; } #elsif( $menu eq " " ) { & ; } else { &admin_screen; } exit; } #subcheckin ####################################################### # Search For An Entry ####################################################### sub search_it { print_header(); print qq~ Variables - $scriptname Version $ver - C.E.I.

This function is coming in Version 2.0
Please contact www.Coston.net for more info.




Copyright © 1999 $scriptlink Version $ver
~; exit; } #subsearch_it ####################################################### # Add An Entry ####################################################### sub add_me { # $getpic = yes no - if yes then transfer to upload script # $babycode = id number - go with upload script. # Add the baby,and then show a confirm screen with ADD ANOTHER open(DT,"$cgipath/$nbdb"); while (
) { if($_ =~ /^$babycode/) { $notfound=0; &error('Baby Code already exists.
Please use the BACK button and re-enter an new Baby Code.','EX08'); } else { $notfound=1; } } #while close(DT); if($notfound==1) { open(NDT,">>$cgipath/$nbdb"); print NDT "$babycode|$momfirst|$momlast|$babywt|$babylength|$babyhair|$babyrace|"; close(NDT); $added=1; } #if$notfound if($added==1) { &add_confirm; } exit; } #subadd_me ####################################################### # Reset the Database ####################################################### sub reset_me { print_header(); if($rst eq "str") { unless($ga==1) { &error('Administrator Use Only','RS05'); } open(NWDB, ">$cgipath/$nbdb"); print NWDB ""; close(NWDB); opendir(NPX,"$picpath"); @oldpix = readdir(NPX); close(NPX); foreach $nofil (@oldpix) { unlink("$picpath/$nofil" ); } &reset_complete; } #if$rst else { &resetpage; } #else exit; } #subreset_me ####################################################### # Delete an entry ####################################################### sub SetVars { open(VARS,">$varfile"); print VARS qq~ ################################################# # File: ceinb_vars.pl # By: Tim Coston # This is the User Variables File used # to install CEINewBorn! ################################################# \$mothersname=$mothersname; \$babyweight=$babyweight; \$babywtunit="$babywtunit"; \$babysize=$babysize; \$babylenunit="$babylenunit"; \$babyhaircolor=$babyhaircolor; \$babytype=$babytype; return 1; ~; close(VARS); &setvars_good; exit; } #subSetVars ####################################################### # Set the Styles of the CEINewBorn ####################################################### sub SetStyles { print_header(); print qq~ Variables - $scriptname Version $ver - C.E.I.

This function is coming in Version 2.0
Please contact www.Coston.net for more info.




Copyright © 1999 $scriptlink Version $ver
~; exit; } #subSetStyles ####################################################### # Admin Entry ####################################################### sub admin { print_header(); if($ga == 1) { &admin_screen; } else { &admin_login; } exit; } #subadmin ####################################################### # First Time Setup Procedure ####################################################### sub new_setup { print_header(); print qq~ Setup - $scrtipname - C.E.I.


This feature coming in Version 2.0
Please contact C.E.I. for installation procedure.
cgi\@coston.net






Copyright © 1999 $scriptlink Version $ver
~; exit; } #subnew_setup #######/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\########## # # Necessary Sub-Routines - Standards # #######\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/########## sub print_header { unless($printed == 1) { print "Content-type:text/html\n\n"; print ""; $printed=1; } } #subprint_header ############################## # Error Page ############################## sub error { $code = "001"; $msg = $_[0]; $code = $_[1]; print_header(); print qq~ ERROR - $scriptname Version $ver - C.E.I.

ERROR!!

$scriptname has found an ERROR.
$msg

CODE: $code
 
Please report this code to the System Administrator
~; exit; } #suberror #################################### # Make the variable HTML friendly #################################### sub HTMLIFY { $_ = shift; $_ =~ s/"/\|QUT\|/g; $_ =~ s/&/\|AMP\|/g; $_ =~ s/"/\|QUT\|/g; $_ =~ s/\?/\|QUS\|/g; $_ =~ s/=/\|EQUL\|/g; $_ =~ s/'/\|APO\|/g; $_ =~ s/\+/\|PLS\|/g; $_ =~ s/\#/\|NMB\|/g; return($_); } #subHTMLIFY #################################### # Make the variable PERL friendly #################################### sub UNHTMLIFY { $_ = shift; $_ =~ s/\|AMP\|/\&/g; $_ =~ s/\|QUT\|/"/g; $_ =~ s/\|QUS\|/\?/g; $_ =~ s/\|EQUL\|/=/g; $_ =~ s/\|APO\|/'/g; $_ =~ s/\|PLS\|/\+/g; $_ =~ s/\|NMB\|/\#/g; return($_); } #subUNHTMLIFY #################################### # Set a list of variables equal to # the same thing #################################### sub setall { @vars = @_; $val = $vars[0]; shift(@vars); foreach $lin (@vars) { $$lin = "$val"; } #foreach@vars return 1; } # subsetall