Add rudimentary perl cgi handler

git-svn-id: http://svn.mythtv.org/svn/trunk@9649 7dbf422c-18fa-0310-86e9-fd20926502f2

.htaccess

@@ -35,7 +35,7 @@
     AddType image/x-icon        .ico
 
 # Some special instructions for the PHP files of MythWeb.
-    <FilesMatch "\.php$">
+    <Files mythweb.*>
 
     #
     # Use the following environment settings to tell MythWeb where you want it to
@@ -103,7 +103,13 @@
         php_flag output_handler                 "NULL"
         php_flag short_open_tag                 "On"
 
-    </FilesMatch>
+    </Files>
+
+# Execute perl scripts in cgi mode (so we can stream properly)
+    <Files *.pl>
+        SetHandler cgi-script
+        Options    +ExecCGI
+    </Files>
 
 #
 # The settings below relate specifically to mod_rewrite and the rewrite engine
@@ -122,15 +128,19 @@
 
 # Skip out early if we've already been through rewrites,
 # or if this is a /css/, /js/ or /cache/ directory request.
-    RewriteRule    ^(css|data|images|js|themes|skins|[a-z_]+\.php)(/|$)     -     [L]
+    RewriteRule    ^(css|data|images|js|themes|skins|[a-z_]+\.(php|pl))(/|$)     -     [L]
+
+# Redirect /pl/ requests to the perl cgi handler.
+    RewriteRule     ^(pl(/.*)?)$            mythweb.pl/$1               [QSA,L]
 
 # Redirect most of the remaining URL requests to the main mythweb script.
 # It will then handle any requests given to it.
     RewriteRule     ^(.+)$                  mythweb.php/$1              [QSA,L]
 
-# If you're experiencing trouble with the previous line in your copy of apache,
-# you could instead use something like:
-#    RewriteRule     ^([\w\-]+(/.*)?)?$      mythweb.php?PATH_INFO=/$1   [L,QSA]
+# If you're experiencing trouble with the previous two lines in your copy of
+# apache, you could instead use something like:
+#    RewriteRule     ^(pl(/.*)?)$           mythweb.pl?PATH_INFO=/$1    [L,QSA]
+#    RewriteRule     ^(.+)$                 mythweb.php?PATH_INFO=/$1   [L,QSA]
 
 # Catch anything else that comes through and send it to mythweb.php with no parameters.
     RewriteRule     ^(.*)$                  mythweb.php                 [QSA,L]

mythweb.pl

@@ -0,0 +1,122 @@
+#!/usr/bin/perl -w
+#
+# This is the perl-based module handler.  It is the counterpart of mythweb.php
+#
+# @url       $URL$
+# @date      $Date$
+# @version   $Revision$
+# @author    $Author$
+#
+
+# Load some required modules
+    use CGI qw/:standard/;
+    use DBI;
+    use File::Basename;
+
+# Create a cgi object;
+    our $cgi = new CGI;
+
+# Extract the requested path
+    our @Path;
+    $Path[0] = ($ENV{'PATH_INFO'} or url_param('PATH_INFO'));
+    $Path[0] =~ s#^/+##sg;
+    $Path[0] =~ s#\s+$##sg;
+    @Path = split('/', $Path[0]);
+    shift @Path if ($Path[0] eq 'pl');
+
+# Figure out the root web directory
+    our $web_root = dirname($ENV{'SCRIPT_NAME'}).'/';
+    $web_root =~ s#//#/#g;
+
+# Add a directory to the search path?
+    if ($ENV{'include_path'}) {
+        $ENV{'PATH'} .= ':'.$ENV{'include_path'};
+    }
+
+# Connect to the database
+    END { $dbh->disconnect() if ($dbh); }
+    our $dbh = DBI->connect("dbi:mysql:database=$ENV{'db_name'}:host=$ENV{'db_host'}",
+                           $ENV{'db_user'},
+                           $ENV{'db_pass'})
+               or die "Content-type: text/html\n\nCannot connect to database: $!\n\n";
+
+# Find the path to the modules directory
+    our $modules_dir = dirname(dirname(find_in_path('modules/tv/init.php')));
+
+# Figure out what the user is trying to do
+    if ($Path[0]) {
+        if (-e "$modules_dir/$Path[0]") {
+            if (-e "$modules_dir/$Path[0]/handler.pl") {
+                require "modules/$Path[0]/handler.pl";
+            }
+            else {
+                print header(),
+                      "Module '$Path[0]' doesn't have a perl handler.";
+            }
+        }
+        elsif ($Path[0] =~ /\w/) {
+                print header(),
+                      "Unknown module:  $Path[0]";
+        }
+    }
+    else {
+        print header(-location => $web_root);
+        print " \n";
+        exit;
+    }
+
+# Exit nicely
+    exit;
+
+################################################################################
+
+# Find a file in the current include path
+    sub find_in_path {
+        my $file = shift;
+    # Split out each of the search paths
+        foreach my $path (@INC, split(/:/, $ENV{'PATH'})) {
+        # Formulate the absolute path
+            my $full_path = "$path/$file";
+        # Exists?
+            return $full_path if (-e $full_path);
+        }
+        return undef;
+    }
+
+=pod
+
+
+print "Content-type: text/html\n\n";
+
+print $web_root;exit;
+
+print <<EOF;
+<form method="post" action="mythweb.cgi?foo=bar">
+<input type="text" name="test" value="test1">
+<input type="submit" name="submit" value="submit">
+</form>
+EOF
+
+print "<hr>";
+
+print join(' :: ', @Path), "<br>\n";
+
+foreach my $k (sort keys %ENV) {
+    print "$k: $ENV{$k}<br>\n";
+}
+
+
+
+open DATA, "/var/video/1004_20060330195900.mpg" or die "Content-type: text/html\n\ncan't open file.";
+
+print "Content-type: video/mpeg\n",
+      "Content-length: ", (-s "/var/video/1004_20060330195900.mpg"), "\n",
+      "\n\n";
+
+my $buf;
+while (!eof DATA) {
+    read DATA, $buf, 262144;
+    print $buf;
+}
+
+close DATA;