Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

problem with require lib file

by mbonifacic (Initiate)
on Dec 12, 2001 at 08:03 UTC ( #131158=perlquestion: print w/replies, xml ) Need Help??

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

I am having a problem calling a subroutine from a separate .pl file. The code is included below. I am trying to write some information from a form to a mysql database. I am not sure that the approach I am using is the best, and would appreciate any comments. 
form (this is a temporary test to be replaced with real data later):
**********************************************************


<html>
<body>

<form method="post" action="http://www.tightboards.com/cgi-bin/collect
+Data/logOrder.cgi" name="cardForm">

[download]
<input type="hidden" name="MERCHANTID" value="tight">
<input type="hidden" name="REQUESTTYPE" value="MIN">
<input type="hidden" name="AMOUNT" value="18.75">
<input type="hidden" name="APPROVEDURL" value="http://www.tightboards.
+com/cgi-bin/BJPchkout.pl?sessionid=1008020297572&sendemail=YES">
<input type="hidden" name="deniedurl" value="http://www.tightboards.co
+m/pmtdeclined.htm">

<b><font face="Arial, Helvetica, sans-serif" size="2">Test</font></b> 
+                 

<input type="submit" value="update script">
</form>
</body>
</html>

log script:
**********************************************************
#!/usr/local/bin/perl -w -c
print "Content-type: text/html\n\n";

use diagnostics;

require "./cgi-lib.pl";

use DBI;
&ReadParse;
$MERCHANTID = $in{'MERCHANTID'};
$REQUESTTYPE = $in{'REQUESTTYPE'};
$AMOUNT = $in{'AMOUNT'};
$APPROVEDURL = $in{'APPROVEDURL'};

print $amount\n;

#$MERCHANTID = &cleanChar($MERCHANTID);
#$REQUESTTYPE = &cleanChar($REQUESTTYPE);
#$AMOUNT = &cleanChar($AMOUNT);

#open connection
$dbh = DBI->connect('DBI:mysql:tightboards:64.49.223.155', 'tight', 'b
+oards') || die('Could not open database!');

#construct SQL statement
$sqlstatement = "update tblOrders set merchantid = ". $MERCHANTID ." ,
+requesttype =".$REQUESTTYPE.",amount =".$AMOUNT.",approvedurl =".$APP
+ROVEDURL;

$sth = "$dbh->prepare($sqlstatement)";
$sth->execute || 
      die "Could not execute SQL statement ... maybe invalid?";

$newsqlstatement="SELECT \* FROM tblOrders";
$stj = "$dbh->prepare($newsqlstatement)";
$stj->execute || 
      die "Could not execute SQL statement ... maybe invalid?";  

print "content-type: text/html\n\n";
print "<html><body bgcolor=white><form>\n";

print "<FONT FACE=Verdana, Arial, Helvetica, sans-serif SIZE=2 COLOR=\
+#003399><b><font size=\+1>Thank You.</font><BR><BR>\n";

print "<form method=post action=https://secure.ecommerce.chexpedite.co
+m/ccgateway.asp name=cardForm>\n";

print "<input type=hidden name=MERCHANTID value=".$MERCHANTID.">\n";
print "<input type=hidden name=REQUESTTYPE value=".$REQUESTTYPE.">\n";
print "<input type=hidden name=AMOUNT value=".$AMOUNT.">\n";
print "<input type=hidden name=APPROVEDURL value=".$APPROVEDURL.">\n";
print "<input type=hidden name=deniedurl value=http://www.tightboards.
+com/pmtdeclined.htm>\n";

print "<input type=hidden name=customerid value=>\n";

print "<b><font face=Arial, Helvetica, sans-serif size=2>To Pay by Cre
+dit Card</font></b>\n";

print "<input type=submit value='Credit Card-Secure Checkout'></form>\
+n";
    
print "<p><input type=button value=list view></form></html>\n";     

#print <<END_OF_FILE;


lib file
***********************************************************

#!/usr/bin/perl
# Perl Routines to Manipulate CGI input
# S.E.Brenner@bioc.cam.ac.uk
# $Id: cgi-lib.pl,v 2.14 1996/10/20 12:41:02 brenner Exp $
#
# Copyright (c) 1996 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
# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews

# For more information, see:
#     http://www.bio.cam.ac.uk/cgi-lib/

$cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.14 $ =~ /(\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 {
  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, $perlwarn, $got);
    
  # Disable warnings as this code deliberately uses local and environm
+ent
  # variables which are preset to undef (i.e., not explicitly initiali
+zed)
  $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 ($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' || 
      $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 _ && -r _ && -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) {
        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, $maxbound)) != $am
+t);  
    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, 4) eq "--\r\n";
      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) { 
        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, $maxbound)) != $am
+t);  
        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 

#remove special characters from mysql database entries for administrat
+ive backend.
# Marco Bonifacic for Art of Science 05/15/01

sub cleanChar {

{$_[0] =~ s/\'/\\'/g;}
{$_[0] =~ s/\;/\\;/g;}
{$_[0] =~ s/\"/\\"/g;}
{$_[0] =~ s/\</\\</g;}
{$_[0] =~ s/\>/\\>/g;}
{$_[0] =~ s/\?/\\?/g;}
{$_[0] =~ s/\{/\\}/g;}

$_[0];
}

$location = "http://216.122.162.148"

[download]

Replies are listed 'Best First'.
Re: problem with require lib file
by bmccoy (Beadle) on Dec 12, 2001 at 09:28 UTC
    Your first order of business is to get rid of cgi-lib.pl. It's old, not supported, buggy and insecure.

    What you really want to use is Lincoln Stein's CGI.pm -- it comes standard with every distribution of Linux, has an object-oriented interface (although you can use the functional one also), and has all sorts of niceties like simple parameter parsing, multi-part forms, and so on.

    CGI.pm really will make your life a lot easier.

    -- Brett

    Go not to the Elves for counsel, for they will say both no and yes

[reply]
Re: problem with require lib file
by rob_au (Abbot) on Dec 12, 2001 at 08:15 UTC
    Okay ... I know others will say this too - but cgi-lib.pl is evil incarnate and replacing this CGI will not only save your soul, but also mean that you will no longer have issues with require in your code.

    Why is cgi-lib.pl so evil? Have a look at use CGI or die;

    As onto your specific problem with cgi-lib.pl - What errors are being returned? What is showing up in your server log when you try and run your CGI script? Is it possible that you have not set the right path or permissions for your code? Have a look at the CGI Help Guide by tachyon which provides some excellent directions for CGI code debugging.

     

    perl -e 's&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

[reply]
[d/l]
[select]

      I'm still pretty new to Perl myself, so I can't elaborate like some of the others.  However, I have noticed that when setting up a *.lib file, the last line containing text of the lib file must read simply as follows:

      1;

      I don't know why that simple arabic numeral one with a semi-colon is necessary, but it is.  Again, there are those that will probably follow my comment with an explanation.  Actually, I would be interested to hear their response to this element.

[reply]
[d/l]
        Library module files are supposed to return a true value. Having a one at the end accomplishes this. I don't recall the exact reason but I think it's because, underneath all of the fancy importing and namespace magic that 'use' does, there's a 'do FILE' deep down, and it returns the last value evaluated in a file, and you will always want that to be true.

        -- Brett

        Go not to the Elves for counsel, for they will say both no and yes

[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://131158]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (2)
As of 2023-09-24 16:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?