Roxen.git / server / modules / scripting / perl.pike

version» Context lines:

Roxen.git/server/modules/scripting/perl.pike:1: + // This is a roxen module. Copyright © 2000 - 2009, Roxen IS.   // Perl script and tag handler module.   // by Leif Stensson.      #include <roxen.h>   #include <module.h>    - //<locate-token project="perl_module">LOCALE</locale-token> + //<locale-token project="mod_perl">LOCALE</locale-token>   // USE_DEFERRED_LOCALE; - #define LOCALE(X,Y) _DEF_LOCALE("perl_module",X,Y) + #define LOCALE(X,Y) _DEF_LOCALE("mod_perl",X,Y)      #include <module.h>   inherit "module";   inherit "roxenlib";      string cvs_version = -  "$Id: perl.pike,v 2.19 2001/08/08 12:41:50 leif Exp $"; +  "$Id$";      constant module_type = MODULE_FILE_EXTENSION | MODULE_TAG;      constant module_name = "Scripting: Perl support";   constant module_doc =    "This module provides a faster way of running Perl scripts with Roxen. "    "The module also optionally provides a &lt;perl&gt;..&lt;/perl&gt; "    "container (and a corresponding processing instruction &lt;?perl ... "    "?&gt;) to run Perl code from inside RXML pages.";    - static string recent_error = 0; - static int parsed_tags = 0, script_calls = 0, script_errors = 0; + protected string recent_error = 0; + protected int parsed_tags = 0, script_calls = 0, script_errors = 0;    - static mapping handler_settings = ([ ]); + protected mapping handler_settings = ([ ]);    - static int cache_output; + protected int cache_output;    - static string script_output_mode; + protected string script_output_mode;      constant thread_safe = 1;      #ifdef THREADS - static object mutex = Thread.Mutex(); + protected object mutex = Thread.Mutex();   #endif      void create()   { -  defvar("extensions", "pl, perl", -  LOCALE(0,"Extensions"), TYPE_STRING, -  LOCALE(0,"Comma-separated list of URL extensions that indicate that " -  "the document is a Perl script.")); +  defvar("extensions", ({ "pl", "perl" }), +  LOCALE(1,"Extensions"), TYPE_STRING_LIST, +  LOCALE(2,"List of URL extensions that indicate that the document " +  "is a Perl script."));      #if 0    defvar("libdir", "./perl", -  LOCALE(0, "Roxen Perl Directory"), TYPE_DIR, -  LOCALE(0, "This is the name of a directory with Roxen-related Perl " +  LOCALE(3, "Roxen Perl Directory"), TYPE_DIR, +  LOCALE(4, "This is the name of a directory with Roxen-related Perl "    "stuff. It should normally point to `perl' in the Roxen server directory, "    "but you may want to point it elsewhere if you want to modify the "    "code."));   #endif       defvar("showbacktrace", 0, -  LOCALE(0, "Show Backtraces"), TYPE_FLAG, -  LOCALE(0, "This setting decides whether to deliver a backtrace in the " +  LOCALE(5, "Show Backtraces"), TYPE_FLAG, +  LOCALE(6, "This setting decides whether to deliver a backtrace in the "    "document if an error is caught while a script runs."));       defvar("tagenable", 0, -  LOCALE(0, "Enable Perl Tag"), TYPE_FLAG, -  LOCALE(0, "This setting decides whether to enable parsing of Perl code " +  LOCALE(7, "Enable Perl Tag"), TYPE_FLAG, +  LOCALE(8, "This setting decides whether to enable parsing of Perl code "    "in RXML pages, in &lt;perl&gt;..&lt;/perl&gt; containers."));       defvar("scriptout", "HTTP", -  LOCALE(0, "Script output"), TYPE_MULTIPLE_STRING, -  LOCALE(0, "How to treat script output. HTML means treat it as a plain " +  LOCALE(9, "Script output"), TYPE_MULTIPLE_STRING, +  LOCALE(10, "How to treat script output. HTML means treat it as a plain "    "HTML document. RXML is similar, but passes it through the RXML parser "    "before returning it to the client. HTTP is the traditional CGI "    "output style, where the script is responsible for producing the "    "HTTP headers before the document, as well as the main document "    "data."),    ({ "HTML", "RXML", "HTTP" })    );       defvar("rxmltag", 0, -  LOCALE(0, "RXML-parse tag results"), TYPE_FLAG, -  LOCALE(0, "Whether to RXML parse tag results or not.")); +  LOCALE(11, "RXML-parse tag results"), TYPE_FLAG, +  LOCALE(12, "Whether to RXML parse tag results or not."));      #if constant(system.NetWkstaUserEnum)    // WinNT.    defvar("helper", "perl/bin/ntperl.pl", -  LOCALE(0, "Perl Helper"), TYPE_FILE, -  LOCALE(0, "Path to the helper program used to start a Perl subprocess. " +  LOCALE(13, "Perl Helper"), TYPE_FILE, +  LOCALE(14, "Path to the helper program used to start a Perl subprocess. "    "The default for this setting is `perl/bin/ntperl.pl'."));   #else    // Assume Unix.    defvar("helper", "perl/bin/perlrun", -  LOCALE(0, "Perl Helper"), TYPE_FILE, -  LOCALE(0, "Path to the helper program used to start a Perl subprocess. " +  LOCALE(13, "Perl Helper"), TYPE_FILE, +  LOCALE(15, "Path to the helper program used to start a Perl subprocess. "    "The default for this setting is `perl/bin/perlrun'."));   #endif       defvar("parallel", 3, -  LOCALE(0, "Parallel scripts"), TYPE_MULTIPLE_INT, -  LOCALE(0, "Number of scripts/tags that may be evaluated in parallel. " +  LOCALE(16, "Parallel scripts"), TYPE_MULTIPLE_INT, +  LOCALE(17, "Number of scripts/tags that may be evaluated in parallel. "    "Don't set this higher than necessary, since it may cause the server "    "to block (by using all available threads). The default for this "    "setting is 3."),    ({ 1, 2, 3, 4, 5, 6 }) );       defvar("caching", 0, -  LOCALE(0, "Cache output"), TYPE_FLAG, -  LOCALE(0, "Whether to cache the result of scripts. This is usually " +  LOCALE(18, "Cache output"), TYPE_FLAG, +  LOCALE(19, "Whether to cache the result of scripts. This is usually "    "not desirable, so the default for this setting is No."));      #if constant(getpwnam)    defvar("identity", "nobody:*", -  LOCALE(0, "Run Perl as..."), TYPE_STRING, -  LOCALE(0, "User and group to run Perl scripts and tags as. The default " +  LOCALE(20, "Run Perl as..."), TYPE_STRING, +  LOCALE(21, "User and group to run Perl scripts and tags as. The default "    "for this option is `nobody:*'. Note that Roxen can't change user ID "    "unless it has sufficient permissions to do so. `*' means `use "    "same as Roxen'."));   #endif   }      string status()   {    string s = "<b>Script calls</b>: " + script_calls + " <br />\n" +    "<b>Script errors</b>: " + script_errors + " <br />\n" +
Roxen.git/server/modules/scripting/perl.pike:136:    s += "found: " + query("helper")+" <br />\n";    else    s += "not found.<br />\n";       if (recent_error)    s += "<b>Most recent error</b>: " + recent_error + " <br />\n";       return s;   }    - static object gethandler() + protected object gethandler()   { return ExtScript.getscripthandler(query("helper"),    query("parallel"), handler_settings);   }    - static void fix_settings() + protected void fix_settings()   { -  string u, g; +     mapping s = ([ ]);      #if constant(getpwnam) -  if (sscanf(query("identity"), "%s:%s", u, g) == 2) +  if (sscanf(query("identity"), "%s:%s", string u, string g) == 2)    {    array ua = getpwnam(u), ga = getgrnam(g);       if (!ua) ua = getpwuid((int) u);    if (!ga) ga = getgrgid((int) g);       if (ua) s->set_uid = ua[2];    if (ga) s->set_gid = ga[2];    }   #endif       handler_settings = s;       cache_output = query("caching");   }    - static void periodic() + protected void periodic()   {    fix_settings();    ExtScript.periodic_cleanup();    call_out(periodic, 900);   }      void start()   {    periodic();    script_output_mode = query("scriptout");   }    - static void add_headers(string headers, object id) + protected void add_headers(string headers, object id)   { string header, name, value;    if (headers)    foreach(headers / "\r\n", header)    { if (sscanf(header, "%[^:]:%s", name, value) == 2)    switch (name)    { case "Content-Type":    case "Content-Encoding":    case "Content-Languages":    // Might require special treatment in the future?    ;    default: -  Roxen.add_http_header(id->misc->defines[" _extra_heads"], -  name, value); +  id->add_response_header (name, value);    }    }   }    - static void do_response_callback(RequestID id, array result) + protected void do_response_callback(RequestID id, array result)   {   // werror("perl:do_response_callback: %O %O\n", id, result);    id->connection()->write("HTTP/1.0 200 OK\r\n");    if (arrayp(result) && sizeof(result) > 1)    { if (sizeof(result) > 2 && stringp(result[2]))    {    foreach(result[2] / "\r\n" - "", string s)    id->connection()->write(s + "\r\n");    id->connection()->write("\r\n");    }
Roxen.git/server/modules/scripting/perl.pike:344:   }      mixed simple_pi_tag_perl(string tag, mapping attr, string contents, object id,    RXML.Frame frame)   {    return simpletag_perl(tag, attr, contents, id, frame);   }      array(string) query_file_extensions()   { -  return (query("extensions") - " ") / ","; +  return query("extensions");   }      TAGDOCUMENTATION;   #ifdef manual   constant tagdoc=([ - "?perl":#"<desc pi='pi'><p><short hide='hide'> + "?perl":#"<desc type='pi'><p><short hide='hide'>    Perl processing instruction tag.</short>This processing intruction    tag allows for evaluating Perl code directly in the document.</p>       <p>Note: Read the installation and configuration documentation in the    Administration manual to set up the Perl support properly. If the    correct parameters are not set the Perl code might not work properly    or security issues might arise.</p>       <p>There is also a <tag>perl</tag>...<tag>/perl</tag> container tag    available.</p>   </desc>",       ]);   #endif