<![CDATA[
#!/usr/bin/perl -w
# This script is part of the NoonQuilt project:
#
# <insert URL>
#
# © Ali Graham, 1998 <mailto:agraham@hal9000.net.au>
#
# (See makeQuilt.pl for the version history, etc.)
#
# Start of nq_mkpatch.pl (Outputs page for an individual patch)
# Start of main()
# make sure this is syntactically clear...
use strict; use English;
# ...and running under Perl5...
require 5.001;
# include the external files...
my $path = "";
if ( $OSNAME =~ /^mswin/i ) {
$path = "d:\\Inetpub\\wwwroot\\quilt\\scripts\\";
chdir($path);
}
]]>
(I needed to add the above lines to the start of every script, otherwise
the Perl interpreter on Windows NT would not change to the directory the
scripts were running in -- this is inconsistent with the behaviour on Unix,
Amiga & Macintosh Perl, which did.)
<![CDATA[
(require $path."nq_config.pl") or (die "Can't open \"nq_config.pl\": $!\n");
# #####################################################
# Start of nqmp_makePatch(parameter_ref, file_handle)
sub nqmp_makePatch {
# initialise the variables
my $params = $ARG[0];
my $original_fh = select($ARG[1]);
]]>
In the following section of the code, all of the parameters that
are to be used in the construction of the HTML page passed back as
the patch page are obtained from the $params hash reference passed
in by makeQuilt.pl. (The structure
of the $params hash is detailed in nq_config.pl.)
<![CDATA[
my $prev_patch = $params->{'P_PrevPatch'}{'Value'};
my $next_patch = $params->{'P_NextPatch'}{'Value'};
my $titles = &nqco_getTitles;
my $title = $titles->[rand(scalar(@$titles))];
my $image;
if ( length($params->{'P_SmallImage'}{'Value'}) ) {
$image = "<IMG SRC=\"$params->{'P_SmallImage'}{'Value'}\" ALT=\"ptch\" ";
$image .= "WIDTH=18 HEIGHT=18 BORDER=0>";
} else {
$image = " ";
}
# do name and email
my $name;
my $use_email = ($params->{'F_AddressPublic'}{'Value'} eq "on") &&
(length($params->{'F_UserAddress'}{'Value'}) > 0);
if ( $use_email ) {
$name = "<A HREF=\"mailto:$params->{'F_UserAddress'}{'Value'}\">";
}
$name .= $params->{'F_UserName'}{'Value'};
if ( $use_email ) { $name .= "</A>"; }
my $submission; my $biography; my $location;
if ( $params->{'F_PreHTMLMode'}{'Value'} eq "on" ) {
$submission = "<PRE>\n$params->{'F_UserSubmission'}{'Value'}\n<PRE>\n";
} else {
# un-line-wrap text & add HTMl <BR>'s
# (uses ASCII 'BEL' \a as a substitution char)
$submission = $params->{'F_UserSubmission'}{'Value'};
&nqmp_lineFilter($submission);
}
if ( length($params->{'F_UserBiography'}{'Value'})>0 ) {
$biography = ": $params->{'F_UserBiography'}{'Value'}";
&nqmp_lineFilter($biography);
} else {
$biography = "";
}
if ( length($params->{'F_UserLocation'}{'Value'})>0 ) {
$location = "Location: $params->{'F_UserLocation'}{'Value'}";
&nqmp_lineFilter($location);
} else {
$location = "";
}
]]>
This prints out the obtained values in the desired HTML page.
<![CDATA[
print <<End_Patch;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE>$title</TITLE>
<SCRIPT LANGUAGE="JavaScript"><!--
function other_win(url) {
if ( (!opener) || opener.closed ) {
opener = window.open(url, 'main')
} else {
opener.location.href = url
}
opener.focus()
}
function store_screenxy(evnt) {
p_screenx = evnt.screenX
p_screeny = evnt.screenY
}
function store_winxy(evnt) {
p_width = evnt.width
p_height = evnt.height
}
// -->
</SCRIPT>
</HEAD>
<BODY onMove="store_screenxy(event)" onResize="store_winxy(event)"
BACKGROUND="../grf/ptch_bg01.jpg">
<DIV ALIGN=CENTER>
<TABLE WIDTH="95%" ALIGN=CENTER CELLSPACING=2 CELLPADDING=10>
<TR>
<TD WIDTH="33%" ALIGN=CENTER>
$image
</TD>
<TD WIDTH="33%" ALIGN=CENTER>
$image
</TD>
<TD WIDTH="33%" ALIGN=CENTER>
$image
</TD>
</TR>
<TR>
</TR>
<TR>
<TD WIDTH=80% COLSPAN=3>
<FONT FACE="HELVETICA,ARIAL,VERDANA,TIMES" SIZE="+1" COLOR="#313131">
<P>
<B>
$submission
</B>
</P>
</FONT>
</TD>
</TR>
<TR>
<TD WIDTH=80% COLSPAN=3>
<FONT FACE="HELVETICA,ARIAL,VERDANA,TIMES" COLOR="#313131">
<P>
<B>$name</B>$biography
</P>
</FONT>
</TD>
</TR>
<TR>
<TD WIDTH=80% COLSPAN=3>
<FONT FACE="HELVETICA,ARIAL,VERDANA,TIMES" COLOR="#313131">
<P>
$location
</P>
</FONT>
</TD>
</TR>
</TABLE>
</DIV>
End_Patch
print "<DIV ALIGN=CENTER>\n\n",
"<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=1>\n\n",
"<TR>\n\n";
print "<TD>";
if ( defined($prev_patch) && (length($prev_patch)>0) ) {
print "\n<A HREF=\"$prev_patch.htm\" ",
"onMouseOver=\"window.status='previous patch';return true\" ",
"onMouseOut=\"window.status='';return true\">\n",
"<IMG SRC=\"$params->{'P_StitchDir'}{'Value'}/prev.gif\" "
"WIDTH=62 HEIGHT=18 BORDER=0 ALT=\"previous\">\n",
"</A>\n";
} else {
print " ";
}
print "</TD>\n\n";
print "<TD> </TD>\n\n";
print "<TD ALIGN=CENTER>\n";
print "<A HREF=\"javascript:other_win('$params->{'P_ParentQuilt'}{'Value'}')\" ",
"onMouseOver=\"window.status='go noon quilt';return true\" ",
"onMouseOut=\"window.status='';return true\">\n",
"<IMG SRC=\"$params->{'P_StitchDir'}{'Value'}/quilt.gif\" ",
"WIDTH=62 HEIGHT=20 BORDER=0 ALT=\"go quilt\">\n",
"</A>\n";
print "</TD>\n\n";
print "<TD> </TD>\n\n";
print "<TD>";
if ( defined($next_patch) && (length($next_patch)>0) ) {
print "\n<A HREF=\"$next_patch.htm\" ",
"onMouseOver=\"window.status='next patch';return true\" ",
"onMouseOut=\"window.status='';return true\">\n",
"<IMG SRC=\"$params->{'P_StitchDir'}{'Value'}/next.gif\"",
" WIDTH=56 HEIGHT=20 BORDER=0 ALT=\"next\">\n",
"</A>\n";
} else {
print " ";
}
print "</TD>\n";
print <<End_Lower;
</TR>
<TR>
<TD> </TD>
<TD>
<A HREF="javascript:other_win('../info.htm')"
onMouseOver="window.status='initial';return true"
onMouseOut="window.status='';return true">
<IMG SRC="$params->{'P_StitchDir'}{'Value'}/info.gif"
WIDTH=57 HEIGHT=19 BORDER=0 ALT="info">
</A>
</TD>
<TD> </TD>
<TD>
<A HREF="javascript:other_win('../submit.htm')"
onMouseOver="window.status='submit writing';return true"
onMouseOut="window.status='';return true">
<IMG SRC="$params->{'P_StitchDir'}{'Value'}/submit.gif"
WIDTH=59 HEIGHT=18 BORDER=0 ALT="submit">
</A>
</TD>
<TD> </TD>
</TR>
</TABLE>
</DIV>
</BODY>
</HTML>
End_Lower
# restore original filehandle
select($original_fh);
}
# End of nqmp_makePatch()
# Start of nqmp_lineFilter()
]]>
This subroutine attempts to unwrap text (i.e. eliminate single
line breaks while preserving double ones). I'm still not entirely
sure that it's completely cross-platform safe -- there's no reliable
way of knowing how various browsers treat their <TEXTAREA> fields --
but it seems to work OK.
<![CDATA[
sub nqmp_lineFilter {
$ARG[0] =~ s/\x0d\x0a\x0d\x0a/\a/g;
$ARG[0] =~ s/\x0d\x0a/ /g;
$ARG[0] =~ s/\a/\x0d\x0a\x0d\x0a/g;
$ARG[0] =~ s/\x0d\x0a/<BR>\x0d\x0a/g;
}
# End of nqmp_lineFilter()
#required return code
1;
# End of nq_mkpatch.pl
]]>
|
