X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2FCommodsWeb.pm;h=9a608365d88ffb31f7f6059731770e7ea7aa2f30;hp=24ee53e92f2c580930ff772a2720cd77738be95e;hb=ea09579bdbec295cfe7735a262e06055a1f69835;hpb=422fab9f34f08090bca02f67cb41bba31f816c7e

diff --git a/yarrg/CommodsWeb.pm b/yarrg/CommodsWeb.pm
index 24ee53e..9a60836 100644
--- a/yarrg/CommodsWeb.pm
+++ b/yarrg/CommodsWeb.pm
@@ -48,10 +48,11 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(&dbw_connect &ocean_list &sourcebasedir
+    @EXPORT      = qw(&dbw_connect &dbw_filename &ocean_list &sourcebasedir
 		      &to_json_shim &to_json_protecttags
-		      &set_ctype_utf8
+		      &set_ctype_utf8 &webdatadir
 		      &expected_error &dbw_lookup_string
+		      &printable &tr_datarow &tr_datarow_s &escerrq
 		      &prettyprint_age &meta_prettyprint_age);
     %EXPORT_TAGS = ( );
 
@@ -73,20 +74,25 @@ sub sourcebasedir () {
     return dotperllibdir().'/..';
 }
 
-sub datadir () {
-    my $edir= $ENV{'YARRG_DATA_DIR'};
+sub some_datadir ($) {
+    my ($what) = @_;
+    my $edir= $ENV{"YARRG_${what}_DIR"};
     return $edir if defined $edir;
     my $dir= dotperllibdir();
-    if (stat "$dir/DATA") {
-	return "$dir/DATA";
+    my $dirwhat= "$dir/$what";
+    if (stat $dirwhat) {
+	return $dirwhat;
     } elsif ($!==&ENOENT) {
 	return "$dir";
     } else {
-	die "stat $dir/DATA $!";
+	die "stat $dirwhat $!";
     }
     return '.';
 }
 
+sub webdatadir () { return some_datadir('WEBDATA'); }
+sub datadir () { return some_datadir('DATA'); }
+
 my @ocean_list;
 
 sub ocean_list () {
@@ -106,11 +112,17 @@ sub ocean_list () {
     return @ocean_list;
 }
 
-sub dbw_connect ($) {
+sub dbw_filename ($) {
     my ($ocean) = @_;
     die "unknown ocean $ocean ?"
 	unless grep { $_ eq $ocean } ocean_list();
-    return dbr_connect(datadir(), $ocean);
+    return dbr_filename(datadir(), $ocean);
+}
+
+sub dbw_connect ($) {
+    my ($ocean) = @_;
+    my $fn= dbw_filename($ocean);
+    return db_connect_core($fn);
 }
 
 sub to_json_shim ($) {
@@ -160,7 +172,7 @@ sub dbw_lookup_string ($$$$$$$$) { # => ( $emsg, @dbresults )
     $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
     my %m;
     my $results;
-    my @pats= ("$each", "$each\%", "\%$each\%");
+    my @pats= ("$each", "$each \%", "$each\%", "\%$each\%");
     if ($abbrev_initials) {
 	push @pats, join ' ', map { "$_%" } split //, $each;
     }
@@ -189,6 +201,39 @@ sub expected_error ($) {
     die $r;
 }
 
+sub printable ($) { # printable($m)  where $m is the Mason request object
+    my ($m) = @_;
+    my $a= scalar $m->caller_args(-1);
+    foreach my $t (qw(pdf ps html pdf2 ps2)) {
+	return $t if $a->{"printable_$t"};
+    }
+    return 0;
+}
+
+sub tr_datarow_s ($$) {
+    my ($m, $lineno) = @_;
+    $lineno &= 1;
+    if (!printable($m)) {
+	return "<tr class=\"datarow$lineno\">";
+    } else {
+	return "<tr bgcolor=\"".
+	       ($lineno ? "#ffffff" : "#e3e3e3" ).
+	       "\">";
+    }
+}
+
+sub tr_datarow ($$) {
+    my ($m, $lineno) = @_;
+    $m->print(tr_datarow_s($m, $lineno));
+}
+
+sub escerrq ($) {
+    return '"'.CGI::escapeHTML($_[0]).'"';
+    # Prettier qotes as below are not in HTML 3.2:
+#    return '&#8220;'.CGI::escapeHTML($_[0]).'&#8221;';
+#    return '&#8216;'.CGI::escapeHTML($_[0]).'&#8217;';
+}
+
 package CommodsWeb::ExpectedError;
 
 sub emsg ($) {