-----------------------------------------------------------------------
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-----------------------------------------------------------------------
#!/usr/local/bin/perl
#    
# CGI interface:  ....................................................
  require 'cgi-lib.pl';
  &ReadParse(*in);
  print &PrintHeader;

# Global Variables: ..................................................
# in{}                        # The array of arguments passed from HTML
  $T = 1;                     # Always means "true"
  $F = 0;                     # Always means "false"
#
# Main program:   ....................................................

foreach $key (keys %in) {     # Strip leading and trailing blanks
  $val = $in{$key};
  $in{$key} = &strip_blanks( $val );
}

if ( &reserved_chars ) {
   &print_errors;
} else {
   &get_tracking_nbr( $track );
   &write_xml;
   &write_acknowledge;
}
exit(0);


sub strip_blanks {  #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Purpose: strips off both leading and trailing blanks and also
# replaces multiple internal blanks with a single blank
  local($a) = @_;
  $a =~ s/(^\s*)(\w)/$2/;       # eliminate leading blanks
  $a =~ s/(\s+)/ /g;            # eliminate multiple blanks
  $a =~ s/(.*) $/$1/;           # eliminate last trailing blank
  $a;
} #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

sub reserved_chars{             # ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Purpose: checks to see if any field contains the reserved characters
# "<" or ">"
  foreach $key (keys %in) {
    $val = $in{$key};
    if ( ($val =~ /</) || ($val =~ />/) ) {
      $errs[$N_errs++] = 'Error: $key cannot contain < or > chars';
    }
  }
  if ($N_errs > 0 ) {
     $T;
  } else {
     $F;
  }
} # vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv


sub write_xml{   #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Purpose: creates an XML data file and prepends it to the existing
# XML purchase order file                                               
#
  local ($k, $v);             # 
  local ($currentDate);       # current date in ascii and numerical form

  $POstatus= 'PO sent';
  $date  = `date`;      
  chop($date);
  $currentDate = &getAsciiDate;                
  $currentDate = &numericalDate( $currentDate );
  $date = $date . ' // ' . $currentDate;
  
  open(T,'>tmp.xml');

  print T "<PO>\n";                                                        
  print T "  <Id>\n";                                           
  print T "    <login>$in{'login'}</login>\n";                              
  print T "    <trackNbr>$track</trackNbr>\n";                              
  print T "    <status>$POstatus</status>\n";                                
  print T "    <date>$date</date>\n";                                   
  print T "  </Id>\n";                                          

  print T "  <Items>\n";                                                  
  print T "  <Item>\n";                                                     
  $k = 'Description1';  $v = $in{$k};          &xml('Description',  $v);
  $k = 'quantity1';     $v = $in{$k};          &xml('quantity',     $v);
  print T "  </Item>\n";                                       
  
  $k = 'Description2';  $v = $in{$k};          if ($v) {               
  print T "  <Item>\n";
  $k = 'Description2';  $v = $in{$k};          &xml('Description',  $v);
  $k = 'quantity2';     $v = $in{$k};          &xml('quantity',     $v);
  print T "  </Item>\n";                                        
  }

  $k = 'Description3';  $v = $in{$k};          if ($v) {                
  print T "  <Item>\n";
  $k = 'Description3';  $v = $in{$k};          &xml('Description',  $v);
  $k = 'quantity3';     $v = $in{$k};          &xml('quantity',     $v);
  print T "  </Item>\n";                                       
  }
  
  print T "  </Items>\n";                                     

  print T "  <Contact>\n";                                                      
  $k = "contactName";   $v = $in{$k};          &xml('Name',         $v);
  $k = "contactEmail";  $v = $in{$k};          &xml('Email',        $v);
  print T "  </Contact>\n";                                                     
  
  print T "  <Billing>\n";                                                       
  $k = "billOrg";       $v = $in{$k};          &xml('Organization', $v);
  print T "    <Addresses>\n";
  $k = "billAddr1";     $v = $in{$k};          &xml('Address',      $v);
  $k = "billAddr2";     $v = $in{$k};          &xml('Address',      $v);
  print T "    </Addresses>\n";
  $k = "billName";      $v = $in{$k};          &xml('Name',         $v);
  $k = "billPhone";     $v = $in{$k};          &xml('Phone',        $v);
  print T "  </Billing>\n";                                                     

  print T "  <Shipping>\n";                                                      
  $k = "shipOrg";       $v = $in{$k};          &xml('Organization', $v);
  print T "    <Addresses>\n";
  $k = "shipAddr1";     $v = $in{$k};          &xml('Address',      $v);
  $k = "shipAddr2";     $v = $in{$k};          &xml('Address',      $v);
  print T "    </Addresses>\n";
  $k = "shipName";      $v = $in{$k};          &xml('Name',         $v);
  $k = "shipPhone";     $v = $in{$k};          &xml('Phone',        $v);
  print T "  </Shipping>\n";                                                    
  print T "  <Payment>\n";                                                      
  $k = "payMethod";     $v = $in{$k};          &xml($k, $v);
  $k = "payNumber";     $v = $in{$k};          &xml($k, $v);
  print T "  </Payment>\n";                                                      
  
  print T "</PO>\n";                                             
  
  close(T);           

  system("cat po.xml >> tmp.xml");
  system("mv tmp.xml po.xml");

} #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv


sub xml{  #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Purpose: writes the data to an XML file                         
# 
  local ($k, $v) = @_;        # Element name and value
  if ($v) {print T "    <$k>$v</$k>\n"};
} #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

sub write_acknowledge{        # ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Writes an HTML file to acknowledge that we have entered the data
  print "<html>";
  print "<h3>Purchase Order sent and po.xml file updated </h3>";
  print "</html>";
} # vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

sub get_tracking_nbr{         #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
# Purpose: read the purchase order tracking file, and increments the        
# number in it
  local($track = @_);

  if (open(TRACKF,"<trackn.file")) {
    $track = <TRACKF>;
    close(TRACKF);
    if (open(TRACKF,">trackn.file")) {
      $track++;
      print TRACKF $track;
      close(TRACKF);
    } else {
      $F;
    }
  } else {
    $F;
  }
} #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv


sub numericalDate { #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
#  Converts a date in a variety of forms to a numerical date of the
#  form yyyymmdd, so that dates can be compared numerically.
#  The allowable input dates are of the forms:
#        8/2/2000    8/2/00         8/2    August 2,2000    August 2 2000  
#        Aug 2       August 2 2000  Today  [blank]
#  For example,  8/2/2000 is converted to 20000802
#                                             
#--Local Variables                            
   local ($inputDate) = @_;
   local ($nbrDate);
   local ($case);
   local ($d1, $d2, $d3);                         # Parts of input date     
   local ($p1, $p2, $p3, $p4, $p5, $p6, $p7);     # Parts of Perl date/time
   local (%months);
   local ($yr, $yr1, $yr2);                       # Year part of Perl date
   local %months = (
   "jan",1,    "feb",2,   "mar",3,   "apr",4,   "may",5,   "jun",6,
   "jul",7,    "aug",8,   "sep",9,   "oct",10,  "nov",11,  "dec",12 
   );

#--Start Execution
   $inputDate =~ s/^\s*//;
   $inputDate =~ s/\s+/ /g;
   $inputDate =~ s/\s*$//; 
   $inputDate =~ s/,/ /g;                         # Convert "," to blanks
   $inputDate =~ s/\// /g;                        # Convert "/" to blanks

   ($p1, $p2, $p3, $p4, $p5, $p6, $p7) = split(/ /, `date`);
   $yr1 = $p6+0;  $yr2 = $p7+0;                    # Test if day is nn or _n
   $yr = ($yr1 > $yr2) ? $yr1 : $yr2;
   ($d1, $d2, $d3) = split(/ /, $inputDate);      # Split inputDate in 3 parts
   $nbrDate = 10000 * $d3 + 100 * $d1 + $d2;
   $case = 1;
   return ($case <= 0) ? $case : $nbrDate;
}
# vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv


sub getAsciiDate{   #^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  # returns the current date in ascii mm/dd/yyyy format
  #
  # Local Variables:
  local %months = (
    "Jan",1,    "Feb",2,   "Mar",3,   "Apr",4,   "May",5,   "Jun",6,
    "Jul",7,    "Aug",8,   "Sep",9,   "Oct",10,  "Nov",11,  "Dec",12
  );
  local ($p1, $p2, $p3, $p4, $p5, $p6, $p7);                       
  local ($mo, $dy, $yr);
  
  ($p1, $p2, $p3, $p4, $p5, $p6, $p7) = split(/ /,`date`);
  if ( $p3 eq '') {
     $mo = $months{$p2};  $dy = $p4;   $yr = $p7;
  } else {
     $mo = $months{$p2};  $dy = $p3;   $yr = $p6;
  }
  return $mo . "/" . $dy . "/" . $yr;
} #vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv