<![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_config.pl (config handling stuff)
# make sure this is syntactically clear....
use strict; use English; use diagnostics;
# ... and running under Perl5
require 5.001;
# #####################################################
# Start of nqco_getScriptDefaults(quilt_num)
sub nqco_getScriptDefaults {
]]>
This subroutine returns the default paths used in internally in
the scripts, for three machine types -- Windows 95/NT, Macintosh &
Unix/Amiga. It returns a reference to a hash (associative array) in
which these values are stored, keyed by the name of the property.
The differentiation between the systems is necessary as all have
different ways of referring to their filesystems.
<![CDATA[
my $script_ref;
if ( $OSNAME =~ /^mswin/i ) {
$script_ref =
{
# paths have trailing \\s
'S_PatchDir' =>
'd:\\Inetpub\\wwwroot\\quilt\\scripts\\patches\\',
'S_PatchInDir' =>
'd:\\Inetpub\\wwwroot\\quilt\\scripts\\patches_in\\',
'S_PatchRejectDir' =>
'd:\\Inetpub\\wwwroot\\quilt\\scripts\\patches_rejects\\',
'S_PatchCounter' =>
'd:\\Inetpub\\wwwroot\\quilt\\scripts\\_pch_cnt.dat',
'S_PatchHTMLDir', =>
'd:\\Inetpub\\wwwroot\\quilt\\patches\\',
};
} elsif ( $OSNAME =~ /^macos/i ) {
$script_ref =
{
# paths have trailing :s
# (relative to script directory)
'S_PatchDir' => '::scripts:patches:',
'S_PatchInDir' => '::scripts:patches_in:',
'S_PatchRejectDir' => '::scripts:patches_rejects:',
'S_PatchCounter' => '::scripts:_ptch_cnt.dat',
'S_PatchHTMLDir', => '::patches:',
};
} else {
# Unix or Amiga
$script_ref =
{
# (the paths have trailing /s)
# (relative to the script directory)
'S_PatchDir' => '../scripts/patches/',
'S_PatchInDir' => '../scripts/patches_in/',
'S_PatchRejectDir' => '../scripts/patches_rejects/',
'S_PatchCounter' => '../scripts/_ptch_cnt.dat',
'S_PatchHTMLDir', => '../patches/',
};
}
return $script_ref;
}
# End of nqco_getScriptDefaults()
# Start of nqco_getQuiltDefaults(quilt_num)
sub nqco_getQuiltDefaults {
]]>
This subroutine passes back values that are to be used inside the
generated HTML files, as well as a few that are used specifically
in generating these files.
<![CDATA[
my $quilt_ref = {};
my $num = $ARG[0];
if ( $OSNAME =~ /^mswin/i ) {
$quilt_ref->{'S_QuiltFile'} =
"d:\\Inetpub\\wwwroot\\quilt\\quilt_".$num.".htm";
$quilt_ref->{'S_PatchImgDir'} =
"d:\\Inetpub\\wwwroot\\quilt\\grf\\patches_".$num."\\";
$quilt_ref->{'S_SmallImgDir'} =
"d:\\Inetpub\\wwwroot\\quilt\\grf\\patches_".$num."_sm\\";
} elsif ( $OSNAME =~ /^macos/i ) {
$quilt_ref->{'S_QuiltFile'} = "::quilt_".$num."htm";
$quilt_ref->{'S_PatchImgDir'} = "::grf:patches_".$num.":";
$quilt_ref->{'S_SmallImgDir'} = "::grf:patches_".$num."_sm:";
} else {
# Unix or Amiga
$quilt_ref->{'S_QuiltFile'} = "../quilt_".$num.".htm";
$quilt_ref->{'S_PatchImgDir'} = "../grf/patches_".$num."/";
$quilt_ref->{'S_SmallImgDir'} = "../grf/patches_".$num."_sm/";
}
$quilt_ref->{'H_PatchImgDir'} = "grf/patches_".$num;
$quilt_ref->{'P_SmallImgDir'} = "../grf/patches_".$num."_sm";
$quilt_ref->{'P_StitchImageDir'} = "../grf/stitches_".$num;
$quilt_ref->{'V_SmallImgDir'} = "../grf/patches_".$num."_sm";
$quilt_ref->{'P_QuiltFile'} = "../quilt_".$num.".htm";
if ($num == 1) {
$quilt_ref->{'H_QuiltBGColour'} = "#FFF8E1";
} elsif ($num == 2) {
$quilt_ref->{'H_QuiltBGColour'} = "#D1EEFF";
} else {
$quilt_ref->{'H_QuiltBGColour'} = "#FFF8E1";
}
return $quilt_ref;
}
# End of nqco_getQuiltDefaults()
# Start of nqco_getHTMLDefaults()
sub nqco_getHTMLDefaults {
]]>
Defines the names of the two main image and patch HTML directories.
<![CDATA[
my $html_ref;
$html_ref =
{
# these are relative to the main directory
# (the paths must not have trailing /s)
'H_PatchHTMLDir' => 'patches',
'H_StitchImageDir' => 'grf',
};
return $html_ref;
}
# End of nqco_getHTMLDefaults()
# Start of nqco_getTitles()
sub nqco_getTitles {
]]>
A list of titles for the individual patches, chosen randomly.
<![CDATA[
my $titles_ref = ['arena',
'precinct',
'patch',
'plot',
'field',
'enclave',
'street',
'abode',
'zone',
'region',
'ground',
'area',
'quarter',
'district',
'beat',
'circuit',
'patch',
'bit',
'morsel',
'crumb',
'seed',
'sliver',
'offshoot',
'node',
'trace',
'particle',
'molecule',
'minutiae',
'granule',
'minim',
'fragment',
'fraction',
'place',
'section',
'snippet',
'piece',
];
return $titles_ref;
}
# End of nqco_getTitles()
# Start of nqco_getParameters()
sub nqco_getParameters {
]]>
This describes the main data structure used to store (and save/load)
the information contained in the patch submissions. It uses hashes of
hashes (see the Perl documentation for more on this topic).
<![CDATA[
my $param_ref = {
'F_UserName' => {
'Description' => '# name of the author',
'Mode' => 'string',
'Order' => 2,
'Compulsory' => 1,
'CompulsErr' => 'Name',
'Value' => '',
},
'F_UserAddress' => {
'Description' => '# email address of the author',
'Mode' => 'string',
'Order', => 5,
'Compulsory' => 1,
'CompulsErr' => 'email @ddress',
'Value' => '',
},
'F_AddressPublic' => {
'Description' => '# make the address public? (boolean)',
'Mode' => 'boolean',
'Order', => 6,
'Value' => '',
},
'F_UserLocation' => {
'Description' => '# location of the author',
'Mode' => 'text',
'End', => 'F_EndUserLoc',
'Order', => 7,
'Compulsory' => 1,
'CompulsErr' => 'Location',
'Open' => 0,
'Value' => '',
},
'F_UserSubmission' => {
'Description' => '# the author\'s submission (100 words approx.)',
'Mode' => 'text',
'End', => 'F_EndUserSubmiss',
'Order', => 8,
'Compulsory' => 1,
'CompulsErr' => 'Submission',
'Open' => 0,
'Value' => '',
},
'F_UserBiography' => {
'Description' => '# the author\'s biography (50 words approx.)',
'Mode' => 'text',
'End', => 'F_EndUserBiog',
'Order', => 9,
'Open' => 0,
'Value' => '',
},
'F_PreHTMLMode' => {
'Description' => '# whether <PRE> should be used...',
'Mode' => 'boolean',
'Order', => 10,
'Value' => '',
},
'P_ParentQuilt' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
'P_StitchDir' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
'P_SmallImage' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
'P_PrevPatch' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
'P_NextPatch' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
'I_FileName' => {
'Mode' => 'string',
'Order', => 0,
'Value' => '',
},
};
return $param_ref;
}
# End of getParameters()
# Start of nqco_readParameters(filename)
sub nqco_readParameters() {
]]>
Fills a parameters hash (described above) by reading a file
from disk.
<![CDATA[
my $params = &nqco_getParameters;
if (open(FILE_HANDLE, $_[0])) {
my @file_contents = <FILE_HANDLE>;
close(FILE_HANDLE);
PARSE: foreach my $data_line (@file_contents) {
# trim excess whitespace from start/end of line
$data_line =~ s/^[ \t]+//; $data_line =~ s/[ \t]+$//;
# are any of the text modes open?
foreach my $key ( keys %{$params} ) {
if ( ($params->{$key}{'Mode'} eq "text") &&
$params->{$key}{'Open'} ) {
if ($data_line eq $params->{$key}{'End'}."\n") {
$params->{$key}{'Open'} = 0;
} else {
$params->{$key}{'Value'} .= $data_line;
}
}
}
if ( (length($data_line) > 0) ) {
# first, check that it's not a comment
if ( ($data_line =~ m/^#/) ) { next PARSE; }
# split up the name and value from the current line
(my $name, my $value) = split(/=/, $data_line);
# trim excess whitespace (and LF) from start/end of name,
# (and value, if it actually has anything in it)
$name =~ s/^[ \t]+//; $name =~ s/[ \t\n]+$//;
if ( $value ) { $value =~ s/^[ \t]+//; $value =~ s/[ \t\n]+$//; }
# if this is a valid parameter line, set it
# according to its mode
if ( defined($params->{$name}) ) {
my $mode = $params->{$name}{'Mode'};
if (($mode eq "string") || ($mode eq "boolean")) {
$params->{$name}{'Value'} = $value;
} elsif ($mode eq "text") {
$params->{$name}{'Open'} = 1;
}
}
}
}
} else {
warn "Can't open file: '", $_[0], , "'. ", $!, "\n";
}
return $params;
}
# End of nqco_readParameters()
# Start of nqco_writeParameters(parameters, filename)
sub nqco_writeParameters() {
]]>
Writes a parameters hash (described above) to a file on disk.
<![CDATA[
my $params = $ARG[0];
my $data;
# sort the parameters array on $params->{$key}{'Order'}
my @sorted_keys =
sort { $params->{$a}{'Order'} <=> $params->{$b}{'Order'} } keys %{$params};
foreach my $key (@sorted_keys) {
if ( not(defined($params->{$key}{'Description'})) ) { next; }
$data .= "$params->{$key}{'Description'}\n";
if ($params->{$key}{'Mode'} eq "text") {
$data .= "$key\n$params->{$key}{'Value'}";
# save an extra \n *if necessary*
# (i.e. if last char of the 'value' is not a \n)
if ( not( $data =~ m/\n$/) ) { $data .= "\n"; }
$data .= "$params->{$key}{'End'}\n\n";
} else {
# bump = out to 30 across or so (??)
$data .= "$key = $params->{$key}{'Value'}\n\n";
}
}
if ( open(WRTPCH_HANDLE, ">$ARG[1]$params->{'I_FileName'}{'Value'}") ) {
print WRTPCH_HANDLE $data;
close(WRTPCH_HANDLE);
return 1;
} else {
return 0;
}
}
# required return code
1;
# End of nq_config.pl
]]>
|
