@ISA = qw(Exporter);
@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 = ( );
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 () {
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 '“'.CGI::escapeHTML($_[0]).'”';
+# return '‘'.CGI::escapeHTML($_[0]).'’';
+}
+
package CommodsWeb::ExpectedError;
sub emsg ($) {