From: wosch <wosch>
Date: Wed, 15 Apr 2009 18:16:45 +0000 (+0000)
Subject: Add support for apache2
X-Git-Tag: CPAN-v1.02~223
X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=5be3dea6bacf251661cfa9b3317b3b62e01da295

Add support for apache2
Add cfspy - IRSpy for the connector framework.
---

diff --git a/lib/ZOOM/IRSpy/Utils.pm b/lib/ZOOM/IRSpy/Utils.pm
index d5bc7b4..7853d20 100644
--- a/lib/ZOOM/IRSpy/Utils.pm
+++ b/lib/ZOOM/IRSpy/Utils.pm
@@ -1,4 +1,4 @@
-# $Id: Utils.pm,v 1.37 2007-12-12 11:02:37 mike Exp $
+# $Id: Utils.pm,v 1.38 2009-04-15 18:16:45 wosch Exp $
 
 package ZOOM::IRSpy::Utils;
 
@@ -28,9 +28,60 @@ use Encode qw(is_utf8);
 
 our $IRSPY_NS = 'http://indexdata.com/irspy/1.0';
 
+# Under Apache 2/mod_perl 2, the ubiquitous $r is no longer and
+# Apache::Request object, nor even an Apache2::Request, but an
+# Apache2::RequestReq ... which, astonishingly, doesn't have the
+# param() method.  So if we're given one of these things, we need to
+# make an Apache::Request out of, which at least isn't too hard.
+# However *sigh* this may not be a cheap operation, so we keep a cache
+# of already-made Request objects.
+#
+my %_apache2request;
+my %_paramsbyrequest;           # Used for Apache2 only
+sub utf8param {
+    my($r, $key, $value) = @_;
+
+    if ($r->isa('Apache2::RequestRec')) {
+        # Running under Apache2
+        if (defined $_apache2request{$r}) {
+            #warn "using existing Apache2::RequestReq for '$r'";
+            $r = $_apache2request{$r};
+        } else {
+            require Apache2::Request;
+            #warn "making new Apache2::RequestReq for '$r'";
+            $r = $_apache2request{$r} = new Apache2::Request($r);
+        }
+    }
+
+    if (!defined $key) {
+        return map { decode_utf8($_) } $r->param();
+    }
+
+    my $raw = undef;
+    $raw = $_paramsbyrequest{$r}->{$key} if $r->isa('Apache2::Request');
+    $raw = $r->param($key) if !defined $raw;
+
+    if (defined $value) {
+        # Argh!  Simply writing through to the underlying method
+        # param() won't work in Apache2, where param() is readonly.
+        # So we have to keep a hash of additional values, which we
+        # consult (above) before the actual parameters.  Ouch ouch.
+        if ($r->isa('Apache2::Request')) {
+            $_paramsbyrequest{$r}->{$key} = encode_utf8($value);
+        } else {
+            $r->param($key, encode_utf8($value));
+        }
+    }
+
+    return undef if !defined $raw;
+    my $cooked = decode_utf8($raw);
+    warn "converted '$raw' to '", $cooked, "'\n" if $cooked ne $raw;
+    return $cooked;
+}
+
 
 # Utility functions follow, exported for use of web UI
-sub utf8param {
+sub utf8param_apache1 {
     my($r, $key, $value) = @_;
     die "utf8param() called with value '$value'" if defined $value;
 
diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc
index 1e64568..be35470 100644
--- a/web/htdocs/details/edit.mc
+++ b/web/htdocs/details/edit.mc
@@ -1,4 +1,4 @@
-%# $Id: edit.mc,v 1.39 2008-10-29 11:04:44 mike Exp $
+%# $Id: edit.mc,v 1.40 2009-04-15 18:16:46 wosch Exp $
 <%args>
 $op
 $id => undef ### should be extracted using utf8param()
@@ -46,7 +46,7 @@ if ((!defined $port || $port eq "") &&
     # Port-guessing based on defaults for each protocol
     $port = $protocol eq "Z39.50" ? 210 : 80;
     warn "guessed port $port";
-    $r->param(port => $port);
+    &utf8param($r, port => $port);
 }
 
 my $newid;
@@ -340,7 +340,7 @@ my @fields =
 # Update record with submitted data
 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
 my %data;
-foreach my $key ($r->param()) {
+foreach my $key (&utf8param($r)) {
     next if grep { $key eq $_ } qw(op id update);
     $data{$key} = utf8param($r, $key);
 }
diff --git a/web/htdocs/details/find.mc b/web/htdocs/details/find.mc
index e56bc1a..024437a 100644
--- a/web/htdocs/details/find.mc
+++ b/web/htdocs/details/find.mc
@@ -1,5 +1,5 @@
-%# $Id: find.mc,v 1.11 2007-03-29 17:14:47 mike Exp $
-% if ($r->param("_search")) {
+%# $Id: find.mc,v 1.12 2009-04-15 18:16:46 wosch Exp $
+% if (&utf8param($r,"_search")) {
 %     $m->comp("found.mc");
 % } else {
      <p>
diff --git a/web/htdocs/details/found.mc b/web/htdocs/details/found.mc
index f1540ea..231f4d1 100644
--- a/web/htdocs/details/found.mc
+++ b/web/htdocs/details/found.mc
@@ -1,4 +1,4 @@
-%# $Id: found.mc,v 1.32 2007-07-16 14:55:21 mike Exp $
+%# $Id: found.mc,v 1.33 2009-04-15 18:16:46 wosch Exp $
 <%once>
 sub print_navlink {
     my($params, $cond, $caption, $skip) = @_;
@@ -39,7 +39,7 @@ sub calc_reliability2 {
 our $conn = undef;
 </%once>
 <%perl>
-my %params = map { ( $_, utf8param($r, $_)) } grep { $r->param($_) } $r->param();
+my %params = map { ( $_, utf8param($r, $_)) } grep { &utf8param($r, $_) } &utf8param($r);
 my $query;
 if ($params{_query}) {
     $query = $params{_query};
diff --git a/zebra/init-script b/zebra/init-script
index 9d295e4..4f9b223 100755
--- a/zebra/init-script
+++ b/zebra/init-script
@@ -1,6 +1,6 @@
 #! /bin/sh
 
-# $Id: init-script,v 1.7 2007-03-23 09:30:31 mike Exp $
+# $Id: init-script,v 1.8 2009-04-15 18:16:46 wosch Exp $
 #
 # This is a startup/shutdown script for IRSpy's Zebra server, suitable
 # for use in a SysV-style init directory such as /etc/init.d (on
@@ -21,6 +21,11 @@ pidfile=/var/run/irspy-zebra.pid
 case "`hostname`" in
     xeno|rafa|test) IRSPYDIR=/usr/local/src/cvs/irspy/;;
     shawarma|kafta) IRSPYDIR=/home/mike/cvs/irspy/;;
+    us2| us2.*) 
+	IRSPYDIR=/home/wosch/indexdata/irspy/
+	logfile=$IRSPYDIR/irspy-zebra
+	pidfile=$IRSPYDIR/irspy-zebra.pid
+	;;
     *) echo "$0: unsupported host `hostname`" >&2
 	exit 1;;
 esac