[svn r7287] added a script (copied from Martin's 204 one with trivial modifications)

This commit is contained in:
dave 2005-11-07 16:14:37 +01:00
parent 1b58583310
commit 38c64f45d6

198
smkridge/234/tablize-qms.pl Normal file
View File

@ -0,0 +1,198 @@
#!/usr/bin/perl -w
use strict;
use Getopt::Long;
((my $progname = $0) =~ s/^.*(\/|\\)//ig); # basename $0
# Parse options
my $no_verbose_progress = 0;
my $usage = 0;
GetOptions('quiet' => \$no_verbose_progress, # be quiet
'help|?' => \$usage # help!
);
# Print usage
if ($usage) {
usage();
}
unless ($ARGV[0]) {
print "Specify a CSV file name as the program's argument (e.g. qm.csv)\n";
usage();
}
open (CSV, "< $ARGV[0]");
# Start writing table file, and write table header
open TABLE, "> qm.html" or die $!;
print TABLE << "END";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<!-- *** This file is auto-generated by $progname - edit $ARGV[0] instead -->
<html lang="en" xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
<link rel="stylesheet" type="text/css" href="../../css/main2.css" />
<title>1623/234 Question Mark List</title>
</head>
<body>
<h1>Hauchh&ouml;hle Question Mark list</h1>
<div>
<a href="#qmextant">Extant QM's</a>
-- <a href="#qmdone">Finished QM's</a>
-- <a href="234.html">234 index</a>
</div>
<hr />
<h2>Conventions</h2>
<p>For question mark list conventions, see <a href="../../qm.html">here</a>.</p>
<h2>Area codes</h2>
<table>
<tr><td>Ent</td><td>Entrance passages</td></tr>
<tr><td>LH</td><td>Left-Hand Series</td></tr>
<tr><td>Trunk</td><td>Main trunk from Doesn't Go Rift to Cess Pot</td></tr>
<tr><td>Measles</td><td>Measles Inlet and Cascade Chamber area</td></tr>
<tr><td>SS</td><td>Sweet Sight</td></tr>
<tr><td>Pie</td><td>Pie Series</td></tr>
<tr><td>Under</td><td>Underhand Passage</td></tr>
<tr><td>Wowoland</td><td>2005 Wowoland / Monster's Lair level</td></tr>
</table>
<h2>Question Marks</h2>
END
<CSV>; # starting to read in csv file, eat header line
my ($number, $grade, $area, $desc, $ref, $station, $completion);
my $incomplete="";
my $complete="";
my $templine;
my $colon;
my @stationbits;
print "Progress: *";
my $thisyear = -1;
my $qmyear;
# While loop which reads in each line of csv file
while (<CSV>) {
chomp;
# Split single line into all the fields
($number, $grade, $area, $desc, $ref, $station, $completion) = &parse_csv($_);
if ($completion and $ref)
{
print "\n?? Backlink for completed $number\n";
}
$qmyear = substr($number, 1, 4);
if($qmyear != $thisyear)
{
$complete = "$complete\n<h3>$qmyear</h3>\n";
$incomplete = "$incomplete\n<h3>$qmyear</h3>\n";
$thisyear = $qmyear;
}
# Last field of CSV file can have weird form-feeds etc. Kill them
$completion =~ s/\r//;
# Construct XHTML line
if ($ref) {
$templine = "<dt><a href=\"$ref#q$number\" id=\"$number\">$number</a>";
} else {
$templine = "<dt><a id=\"$number\">$number</a>";
}
$templine = "$templine $grade</dt><dd>";
$colon = "";
if ($completion || $desc) {
$colon = ": ";
}
@stationbits = split(/\./, $station);
if ($#stationbits > 0)
{
$station = "$stationbits[-2].$stationbits[-1]";
}
if ($station) {
if ($area) {
$templine = "$templine$area, near $station$colon";
} else {
$templine = "${templine}Near $station$colon";
}
} elsif ($area) {
$templine = "$templine$area$colon"
}
if ($completion) {
$complete = "$complete$templine$completion</dd>\n";
} else {
$incomplete = "$incomplete$templine$desc</dd>\n";
}
print "*";
}
print TABLE << "END";
<h3><a id="qmextant">Extant QMs</a></h3>
<dl>
$incomplete
</dl>
<h3><a id="qmdone">Completed QMs</a></h3>
<dl>
$complete
</dl>
<hr />
<ul>
<li><a href="234.html">Back to 234 index page</a></li>
<li><a href="../../smkridge/index.html#id234">Schwarzmooskogel ridge area index and description</a></li>
<li><a href="../../indxal.htm#id234">Full Index</a></li>
<li><a href="../../areas.htm">Other Areas</a></li>
<li><a href="../../index.htm">Back to Expedition Intro page</a></li>
</ul>
</body>
</html>
END
close TABLE;
print "\nInformation: Done\n";
# Parse the CSV file
sub parse_csv {
my $line = $_[0];
my @parsedline = ();
my $field = '';
while ($line =~ m{ \G(?:^|,)
(?: "((?> [^"]*) (?> "" [^"]*)*)" | ([^",]*)) }gx) {
if ($2) {
$field = $2;
} elsif ($1) {
$field = $1;
$field =~ s/""/"/g;
} else {
$field = '';
}
push(@parsedline, $field);
}
return(@parsedline);
}
# Usage
sub usage {
print << "EOF";
USAGE: $progname [-options] <CSV file>
-q, --quiet Be quiet about progress
-h, --help Show this message
EOF
exit(0);
}