Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Basic script help

by zealf (Novice)
on Feb 20, 2010 at 01:23 UTC ( #824303=perlquestion: print w/replies, xml ) Need Help??

zealf has asked for the wisdom of the Perl Monks concerning the following question:

Hi there, can I please get some advice on a website I am currently building.

themaninthecharcoalsuit.com.au

I have been learing the basics of pearl and have finally got my hello world running.

I really need some advice on where my current test scripts are going wrong. ie /cgi-bin/fig56.cgi The tutorials are lacking some vital information. Like what to name the files and how to execute them.

Replies are listed 'Best First'.
Re: Basic script help
by Corion (Pope) on Feb 20, 2010 at 08:09 UTC

    As you don't show any of your code, it's kinda hard to help you here. Either show the minimal code, and how it fails to work for you, or look in your webserver error logs to see the error message for yourself.

      Thank you for looking into it though! Here is one I am trying to execute.
      #!/usr/bin/perl -wT push(@Inc,"/cgi-bin"); require("cgi-lib.pl"); &ReadParse(*input); #Determine the base price based on the system variable if($input{'system'}eq"486d66"){ #set 486 only variables $computer_name = "486DX2-66"; $price = 1099; $memory = 4; $video = "VLB"; } else{ #not a 486 must be a pentium system $computer_name = "Pentium"; $memory=8; $video="pcl"; $cache="256K Cache"; if ($input{'system'}eq"P100"){$price=1799;$ptype=100} elsif($input{'system'}eq"15inch"){$price;$ptype=75} elsif($input{'system'}eq"P60"){$price=1450;$ptype=60} } #add extra price for monitors over 14 inch $monitor=$input{'monitor'}; if ($input{'monitor'}eq"17inch"){$price+=650;} elsif($input{'monitor'}eq"15inch"){$price+=200;} #add multimedia system if(defined($input{'sound'})){ $price+=190; $multimedia="Multimedia System"; } #add 14.4 modem price if (defined($input{'modem'})){ $price+=69; $modem="14.4 modem"; } print&PrintHeader; print <<print_tag; <html> <head> <title>$computer_name Systems from Austin Computer Center North</title +> </head> <body> <h1 align=center>Austin Computer Center North<br>Austin Texas!</h1> <center> <img src="/accn.jpg: align=left> <table border=5> <th colspan=2 align=center> <h2> ${computer_name}$ptype for only /$$price </h2> <tr><td><ul> <li>$memory megs of RAM <li>$cache <li>Enhanced IDE In/Out Controller <li>$monitor NIL SVGA Monitor <li>1 Meg $video SVGA Video Card <li>$multimedia </ul> <td><ul> <li>1.44 Floppy Drive <li>500+ meg Hard Drive <li>Mouse <li>Windows 95 <li>$modem </ul> <tr> <td align=right colspan=2><h2>1 YEAR WARRANTY PARTS & LABOUR!</h2> <tr> </table> </center> </body> </html> print_tag
      And this time I remembered the extra lines at the end. Here is the cgi-lib.pl which I have in the same directory.
      #!/usr/bin/perl -wT # Perl Routines to Manipulate CGI input # cgi-lib@pobox.com # $Id: cgi-lib.pl,v 2.18 1999/02/23 08:16:43 brenner Exp $ # # Copyright (c) 1993-1999 Steven E. Brenner # Unpublished work. # Permission granted to use and modify this library so long as the # copyright above is maintained, modifications are documented, and # credit is given for any use of the library. # # Thanks are due to many people for reporting bugs and suggestions # For more information, see: # http://cgi-lib.stanford.edu/cgi-lib/ $cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.18 $ =~ /(\d+)\.(\ +d+)/); # Parameters affecting cgi-lib behavior # User-configurable parameters affecting file upload. $cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - +2^17 $cgi_lib'writefiles = 0; # directory to which to write files, +or # 0 if files should not be written $cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory +above # Do not change the following parameters unless you have special reaso +ns $cgi_lib'bufsize = 8192; # default buffer size when reading multi +part $cgi_lib'maxbound = 100; # maximum boundary length to be encounte +rd $cgi_lib'headerout = 0; # indicates whether the header has been +printed # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # key/value pairs in %in, using "\0" to separate multiple selections # Returns >0 if there was input, 0 if there was no input # undef indicates some failure. # Now that cgi scripts can be put in the normal file space, it is usef +ul # to combine both the form and the script in one place. If no paramet +ers # are given (i.e., ReadParse returns FALSE), then a form could be outp +ut. # If a reference to a hash is given, then the data will be stored in t +hat # hash, but the data from $in and @in will become inaccessable. # If a variable-glob (e.g., *cgi_input) is the first parameter to Read +Parse, # information is stored there, rather than in $in, @in, and %in. # Second, third, and fourth parameters fill associative arrays analago +us to # %in with data relevant to file uploads. # If no method is given, the script will process both command-line arg +uments # of the form: name=value and any text that is in $ENV{'QUERY_STRING'} # This is intended to aid debugging and may be changed in future relea +ses sub ReadParse { # Disable warnings as this code deliberately uses local and environm +ent # variables which are preset to undef (i.e., not explicitly initiali +zed) local ($perlwarn); $perlwarn = $^W; $^W = 0; local (*in) = shift if @_; # CGI input local (*incfn, # Client's filename (may not be provid +ed) *inct, # Client's content-type (may not be provid +ed) *insfn) = @_; # Server's filename (for spooled files) local ($len, $type, $meth, $errflag, $cmdflag, $got, $name); 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 ($len > $cgi_lib'maxdata) { #' &CgiDie("cgi-lib.pl: Request to receive too much data: $len byte +s\n"); } if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' || $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; } } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) { # for efficiency, compile multipart code only if needed $errflag = !(eval <<'END_MULTIPART'); local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $ +blen); local ($bpos, $lpos, $left, $amt, $fn, $ser); local ($bufsize, $maxbound, $writefiles) = ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles); # The following lines exist solely to eliminate spurious warning m +essages $buf = ''; ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary; &CgiDie ("Boundary not provided: probably a bug in your server") unless $boundary; $boundary = "--" . $boundary; $blen = length ($boundary); if ($ENV{'REQUEST_METHOD'} ne 'POST') { &CgiDie("Invalid request method for multipart/form-data: $meth\ +n"); } if ($writefiles) { local($me); stat ($writefiles); $writefiles = "/tmp" unless -d _ && -w _; # ($me) = $0 =~ m#([^/]*)$#; $writefiles .= "/$cgi_lib'filepre"; } # read in the data and split into parts: # put headers in @in and data in %in # General algorithm: # There are two dividers: the border and the '\r\n\r\n' between # header and body. Iterate between searching for these # Retain a buffer of size(bufsize+maxbound); the latter part is # to ensure that dividers don't get lost by wrapping between two b +ufs # Look for a divider in the current batch. If not found, then # save all of bufsize, move the maxbound extra buffer to the front + of # the buffer, and read in a new bufsize bytes. If a divider is fo +und, # save everything up to the divider. Then empty the buffer of eve +rything # up to the end of the divider. Refill buffer to bufsize+maxbound # Note slightly odd organization. Code before BODY: really goes + with # code following HEAD:, but is put first to 'pre-fill' buffers. B +ODY: # is placed before HEAD: because we first need to discard any 'pre +face,' # which would be analagous to a body without a preceeding head. $left = $len; PART: # find each part of the multi-part while reading data while (1) { die $@ if $errflag; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf): $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $a +mt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; $in{$name} .= "\0" if defined $in{$name}; $in{$name} .= $fn if $fn; $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted if (defined $1) { $insfn{$1} .= "\0" if defined $insfn{$1}; $insfn{$1} .= $fn if $fn; } BODY: while (($bpos = index($buf, $boundary)) == -1) { if ($left == 0 && $buf eq '') { foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib.pl: reached end of input while seeking boundary + " . "of multipart. Format of CGI input is wrong.\n"); } die $@ if $errflag; if ($name) { # if no $name, then it's the prologue -- discard if ($fn) { print FILE substr($buf, 0, $bufsize); } else { $in{$name} .= substr($buf, 0, $bufsize); } } $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==leng +th($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != +$amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } if (defined $name) { # if no $name, then it's the prologue -- d +iscard if ($fn) { print FILE substr($buf, 0, $bpos-2); } else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill l +ast \r\n } close (FILE); last PART if substr($buf, $bpos + $blen, 2) eq "--"; substr($buf, 0, $bpos+$blen+2) = ''; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf) : $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $a +mt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; undef $head; undef $fn; HEAD: while (($lpos = index($buf, "\r\n\r\n")) == -1) { if ($left == 0 && $buf eq '') { foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib: reached end of input while seeking end of " . "headers. Format of CGI input is wrong.\n$buf"); } die $@ if $errflag; $head .= substr($buf, 0, $bufsize); $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==leng +th($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != +$amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } $head .= substr($buf, 0, $lpos+2); push (@in, $head); @heads = split("\r\n", $head); ($cd) = grep (/^\s*Content-Disposition:/i, @heads); ($ct) = grep (/^\s*Content-Type:/i, @heads); ($name) = $cd =~ /\bname="([^"]+)"/i; #"; ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name; ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be + null-str ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname +; $incfn{$name} .= (defined $in{$name} ? "\0" : "") . (defined $fname ? $fname : ""); ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #"; ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defin +ed $ctype; $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype; if ($writefiles && defined $fname) { $ser++; $fn = $writefiles . ".$$.$ser"; open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n"); binmode (FILE); # write files accurately } substr($buf, 0, $lpos+4) = ''; undef $fname; undef $ctype; } 1; END_MULTIPART if ($errflag) { local ($errmsg, $value); $errmsg = $@ || $errflag; foreach $value (values %insfn) { unlink(split("\0",$value)); } &CgiDie($errmsg); } else { # everything's ok. } } else { &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n" +); } # no-ops to avoid warnings $insfn = $insfn; $incfn = $incfn; $inct = $inct; $^W = $perlwarn; return ($errflag ? undef : scalar(@in)); } # PrintHeader # Returns the magic line which tells WWW that we're an HTML document sub PrintHeader { return "Content-type: text/html\n\n"; } # HtmlTop # Returns the <head> of a document and the beginning of the body # with the title and a body <h1> header as specified by the parameter sub HtmlTop { local ($title) = @_; return <<END_OF_TEXT; <html> <head> <title>$title</title> </head> <body> <h1>$title</h1> END_OF_TEXT } # HtmlBot # Returns the </body>, </html> codes for the bottom of every HTML page sub HtmlBot { return "</body>\n</html>\n"; } # SplitParam # Splits a multi-valued parameter into a list of the constituent param +eters sub SplitParam { local ($param) = @_; local (@params) = split ("\0", $param); return (wantarray ? @params : $params[0]); } # MethGet # Return true if this cgi call was using the GET request, false otherw +ise sub MethGet { return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq +"GET"); } # MethPost # Return true if this cgi call was using the POST request, false other +wise sub MethPost { return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq +"POST"); } # MyBaseUrl # Returns the base URL to the script (i.e., no extra path or query str +ing) sub MyBaseUrl { local ($ret, $perlwarn); $perlwarn = $^W; $^W = 0; $ret = 'http://' . $ENV{'SERVER_NAME'} . ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') . $ENV{'SCRIPT_NAME'}; $^W = $perlwarn; return $ret; } # MyFullUrl # Returns the full URL to the script (i.e., with extra path or query s +tring) sub MyFullUrl { local ($ret, $perlwarn); $perlwarn = $^W; $^W = 0; $ret = 'http://' . $ENV{'SERVER_NAME'} . ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') . $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} . (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '' +); $^W = $perlwarn; return $ret; } # MyURL # Returns the base URL to the script (i.e., no extra path or query str +ing) # This is obsolete and will be removed in later versions sub MyURL { return &MyBaseUrl; } # CgiError # Prints out an error message which which containes appropriate header +s, # markup, etcetera. # Parameters: # If no parameters, gives a generic error message # Otherwise, the first parameter will be the title and the rest will # be given as different paragraphs of the body sub CgiError { local (@msg) = @_; local ($i,$name); if (!@msg) { $name = &MyFullUrl; @msg = ("Error: script $name encountered fatal error\n"); }; if (!$cgi_lib'headerout) { #') print &PrintHeader; print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n"; } print "<h1>$msg[0]</h1>\n"; foreach $i (1 .. $#msg) { print "<p>$msg[$i]</p>\n"; } $cgi_lib'headerout++; } # CgiDie # Identical to CgiError, but also quits with the passed error message. sub CgiDie { local (@msg) = @_; &CgiError (@msg); die @msg; } # PrintVariables # Nicely formats variables. Three calling options: # A non-null associative array - prints the items in that array # A type-glob - prints the items in the associated assoc array # nothing - defaults to use %in # Typical use: &PrintVariables() sub PrintVariables { local (*in) = @_ if @_ == 1; local (%in) = @_ if @_ > 1; local ($out, $key, $output); $output = "\n<dl compact>\n"; foreach $key (sort keys(%in)) { foreach (split("\0", $in{$key})) { ($out = $_) =~ s/\n/<br>\n/g; $output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n"; } } $output .= "</dl>\n"; return $output; } # PrintEnv # Nicely formats all environment variables and returns HTML string sub PrintEnv { &PrintVariables(*ENV); } # The following lines exist only to avoid warning messages $cgi_lib'writefiles = $cgi_lib'writefiles; $cgi_lib'bufsize = $cgi_lib'bufsize ; $cgi_lib'maxbound = $cgi_lib'maxbound; $cgi_lib'version = $cgi_lib'version; $cgi_lib'filepre = $cgi_lib'filepre; 1; #return true
      Trying to execute the first code returns a 500error while on cpanel I'm not getting anything. regards, Gavyn
        push(@Inc,"/cgi-bin");

        I haven't looked at the rest of your code, but @Inc should definitely be @INC (Perl is case-sensitive).

        Also, note that the path you'd have to specify here is a physical path in the filesystem, not the logical path as shown in the URI — so /cgi-bin is likely incorrect, as it would denote a directory at the root of the filesystem.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://824303]
Approved by AnomalousMonk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (7)
As of 2020-01-20 15:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?