Location: PHPKode > scripts > PHPerl Application > phperl-application/phperl.php
<?
//  phperl.php - PHP glue routines for calling the PHPerl API
//  Copyright (C) 2000 Zanshin.
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

if (!isset($GLOBALS['included_phperl_php'])) {
  $GLOBALS['included_phperl_php'] = true;

  function phperl_register($caller, $file = "")
  {
    if (!isset($GLOBALS['phperl_register'])) {
      if (phperl_setup($caller, $file)) {
	register_shutdown_function('phperl_shutdown');
	$GLOBALS['phperl_register'] = $caller;
      }
    } else {
      $GLOBALS['phperl_register'] = $caller;
      if ($file) {    
	phperl_eval("do '$file';");
      }
    }
  }

  function phperl_export_env($var, $dummy = "")
  {
    #echo ("<PRE>\$ENV{'$var'} = '$GLOBALS[$var]';</PRE>");
    phperl_eval("\$ENV{'$var'} = '$GLOBALS[$var]';");
  }

  function phperl_export_urlencoded_vars(&$arr, $vars, $multi)
  {
    foreach ($vars as $var => $val)
    {
      if (is_array($val))
      {
	phperl_export_urlencoded_vars($arr, $val, $var . "[]");
      }
      else
      {
	$arr[] = sprintf("%s=%s", $multi ? $multi : $var, urlencode($val));
      }
    }
  }

  function phperl_export_urlencoded($fp)
  {
    if (is_array($GLOBALS[HTTP_POST_VARS]))
    {
      phperl_export_urlencoded_vars($arr, $GLOBALS[HTTP_POST_VARS]);
      fputs($fp, join("&", $arr));
    }
  }

  function phperl_export_multipart_vars($fp, $boundary, $vars, $multi)
  {
    foreach ($vars as $var => $val)
    {
      if (is_array($val))
      {
	phperl_export_multipart_vars($fp, $boundary, $val, $var . "[]");
      }
      else
      {
	fputs($fp, sprintf("%s\r\nContent-Disposition: form-data; name=\"%s\"\r\n\r\n%s\r\n",
			   $boundary, $multi ? $multi : $var, $val));
      }
    }
  }

  function phperl_export_multipart($fp, $boundary, $upload)
  {
    if (is_array($GLOBALS[HTTP_POST_VARS]))
    {
      phperl_export_multipart_vars($fp, $boundary, $GLOBALS[HTTP_POST_VARS]);
    }
    if ($upload && $GLOBALS[$upload] && $GLOBALS[$upload] != "none")
    {
      fputs($fp, sprintf("%s\r\nContent-Disposition: form-data; name=\"%s\"; filename=\"%s\"\r\nContent-Type: %s\r\n\r\n",
			 $boundary, $upload, $GLOBALS[$upload . "_name"],
			 $GLOBALS[$upload . "_type"]));
      $upfile = fopen($GLOBALS[$upload], "r");
      $bytesleft = $GLOBALS[$upload . "_size"];
      while ($bytesleft)
      {
	$nbytes = ($bytesleft > 4096) ? 4096 : $bytesleft;
	$buf = fread($upfile, $nbytes);
	fputs($fp, $buf, $nbytes);
	$bytesleft -= $nbytes;
      }
      fputs($fp, "\r\n");
    }
    fputs($fp, sprintf("%s--\r\n", $boundary));
  }

  function phperl_export($upload)
  {
    # TMPDIR in the environment takes precedence over the dir argument
    $tmpfn = tempnam("/tmp", "phperl");
    #echo "tmpfn is $tmpfn<BR>\n";
    $fp = fopen($tmpfn, "w");

    # first export environment variables of interest
    $arr = array("QUERY_STRING", "REQUEST_METHOD", "REQUEST_URI",
         	 "HTTP_USER_AGENT", "CONTENT_TYPE");
    array_walk($arr, "phperl_export_env");

    # now output data for the CGI to read from stdin, i.e. POST data or
    # multipart/form-data content
    if (ereg('multipart/form-data;.*boundary="?([^";,]+)"?',
	     $GLOBALS[CONTENT_TYPE], $regs))
    {
      $boundary = $regs[1];
      # per CGI.pm, IE 3.01 on the Mac just uses the boundary without the
      # two extra hyphens.  Prepend -- in all other cases.
      if (!ereg('MSIE\s+3\.0[12];\s*Mac', $HTTP_USER_AGENT))
      {
	$boundary = "--" . $boundary;
      }
      phperl_export_multipart($fp, $boundary, $upload);
    }
    else
    {
      phperl_export_urlencoded($fp);
    }
    fclose($fp);
    return $tmpfn;
  }

  function phperl_do_cgi($cgi, $upload)
  {
    $tmpfn = phperl_export($upload);
    $cmd ="use PHPerl::PHPerl qw(do parse_http_response);
           \$stdout = &do('$cgi', '$tmpfn');
           @resp = &parse_http_response(\$stdout) if \$stdout;
           \$resp[2] if (@resp);";
    #echo "<PRE>$cmd</PRE>";
    $html = phperl_eval($cmd);
    unlink($tmpfn);
    if ($html)
    {
      return $html;
    }
    else
    {
      return "phperl_do_cgi($cgi) failed<BR>" . phperl_eval('$stdout;');
    }
  }

}
?>
Return current item: PHPerl Application