2004-04-06 03:08:25 +01:00
#!/usr/bin/perl -w
use strict ;
2005-01-12 17:27:38 +00:00
use Cwd ;
use File::Find ;
2004-04-20 00:37:35 +01:00
use File::Path ;
2004-04-18 19:57:30 +01:00
use Getopt::Long ;
2004-04-06 03:08:25 +01:00
2004-05-06 22:09:03 +01:00
# header column never has any info...
2005-05-31 14:10:49 +01:00
# certainly not now I've deleted it (DL)
2004-04-06 03:08:25 +01:00
2005-01-12 17:27:38 +00:00
( ( my $ progname = $ 0 ) =~ s/^.*\///ig ) ; # basename $0
my $ warnings ; # set this if we have non fatal problems
2007-02-21 15:31:51 +00:00
# my $cvsdirectories = ':'; # this gets filled with directories that should have
2005-05-31 14:10:49 +01:00
# cvsignores generated in a later pass
2004-04-06 03:08:25 +01:00
2004-04-20 00:37:35 +01:00
# Parse options
2004-04-18 19:57:30 +01:00
my $ no_verbose_progress = 0 ;
2004-04-20 00:37:35 +01:00
my $ usage = 0 ;
GetOptions ( 'quiet' = > \ $ no_verbose_progress , # be quiet
2004-04-20 01:11:21 +01:00
'help' = > \ $ usage # help!
2004-04-20 00:37:35 +01:00
) ;
# Print usage
if ( $ usage ) {
2004-04-20 01:11:21 +01:00
usage ( ) ;
2004-04-20 00:37:35 +01:00
}
2004-04-18 19:57:30 +01:00
2004-04-06 03:08:25 +01:00
unless ( $ ARGV [ 0 ] ) {
2006-09-07 03:28:22 +01:00
print STDERR "Specify a CSV file name as the program's argument (e.g. CAVETAB2.CSV)\n\n" ;
2005-01-12 17:27:38 +00:00
usage ( ) ;
}
2005-05-31 14:10:49 +01:00
# One day this may be proofed against this problem,
# but another command line parameter (location of expoweb)
# is inevitable, and unappealing
2005-01-12 17:27:38 +00:00
( $ _ = cwd ( ) ) =~ s/^.*\///ig ;
if ( $ _ ne "noinfo" ) {
print STDERR "This program expects to be run from a CWD of noinfo!\n\n" ;
2004-04-20 01:11:21 +01:00
usage ( ) ;
2004-04-06 03:08:25 +01:00
}
2004-05-06 22:09:03 +01:00
open ( CSV , "< $ARGV[0]" ) or print STDERR "That filename could not be opened. Exiting.\n" and die $! ;
2004-04-06 03:08:25 +01:00
2007-02-21 15:31:51 +00:00
open ( LENGTHS , "< lengths.dat" ) or print STDERR "No length data available! Exiting.\n" and die $! ;
2007-02-23 00:01:56 +00:00
open ( LOGFILE , "> make-indxal4.log" ) or print STDERR "Could not create log file! Exiting.\n" and die $! ;
2007-02-21 15:31:51 +00:00
my % lhash = munge_lengths ( ) ;
2005-01-12 17:27:38 +00:00
# Go down a directory
chdir ".." ;
open INDXAL , "> indxal.htm" or die $! ;
2004-04-21 14:18:29 +01:00
print INDXAL << "END" ;
2004-04-21 22:49:22 +01:00
< ! DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" >
2004-04-06 03:08:25 +01:00
< ! - - ** * This file is auto - generated by $ progname - edit cavetab2 . csv instead - - >
2004-04-27 14:47:29 +01:00
< html lang = "en" xmlns = "http://www.w3.org/1999/xhtml" xml:lang = "en" >
2004-04-06 03:08:25 +01:00
<head>
2004-04-21 22:49:22 +01:00
< meta http - equiv = "Content-Type" content = "text/html; charset=iso-8859-1" / >
2004-04-06 03:08:25 +01:00
<title> Loser Plateau area : Cave description index </title>
2004-04-21 22:49:22 +01:00
< link rel = "stylesheet" type = "text/css" href = "css/main2.css" / >
2004-04-06 03:08:25 +01:00
</head>
<body>
2004-04-21 22:49:22 +01:00
<h1> Kataster Gruppe 1623 : < br />Loser Augst-Eck - INDEX</ h1 >
2004-04-06 03:08:25 +01:00
2005-06-12 12:31:07 +01:00
<p> Note that < a href = "1626/index.html" > information on caves in the adjacent area
2005-05-17 00:11:41 +01:00
1626 ( Rauher - Sch & ouml ; nberg ) </a> is to be found elsewhere . See also the < a
href = "dplong.htm" > list of lengths and depths </a> for the caves where we have
survey data . </p>
2004-05-07 15:50:43 +01:00
2004-04-21 14:18:29 +01:00
< table border = "0" frame = "void" >
2004-04-06 03:08:25 +01:00
END
<CSV> ; # starting to read in csv file, eat header line
# Read in pos file to @pos now rather than later so we don't repeat it n times
2005-01-12 17:27:38 +00:00
open INPUT2 , "< noinfo/all.pos" or print STDERR "Could not find all.pos in the noinfo directory\n" and die $! ;
2004-04-06 03:08:25 +01:00
my @ pos = <INPUT2> ;
close INPUT2 ;
# While loop which reads in each line of csv file
while ( <CSV> ) {
chomp ;
2004-05-07 15:50:43 +01:00
do_this_line ( $ _ ) ;
2004-04-06 03:08:25 +01:00
}
2004-04-20 00:37:35 +01:00
# Finish writing index file
2004-04-21 14:18:29 +01:00
print INDXAL << "END" ;
2004-04-06 03:08:25 +01:00
</table>
< ! - - LINKS - - >
2004-04-27 14:47:29 +01:00
< hr / > <ul>
2004-04-21 22:49:22 +01:00
<li> Back to < a href = "../index.htm" > CUCC Home page </a> </li>
<li> Back to < a href = "index.htm" > Expedition Intro page </a> </li>
<li>
<h3> Main Indices: </h3>
<ul> <li> < a href = "infodx.htm" > <b> Index </b> to Expo </a> information pages </li>
<li> < a href = "areas.htm" > Description of CUCC ' s area </a> and split to subareas </li>
<li> List of ( links to ) < a href = "pubs.htm" > published reports and logbooks </a> </li> </ul>
</li>
<li>
<h3> Pictures: </h3>
<ul> <li> < a href = "gall0.htm" > Text only Index </a> </li>
<li> < a href = "gallery/0.htm" > Index pages ( with thumbnails ) </a> </li> </ul>
</li>
<li>
<h3> Other info: </h3>
<ul> <li> Table of < a href = "folk/index.htm" > members of CUCC expeditions </a> 1976 - 99 </li>
<li> < a href = "others/index.htm" > Other groups </a> who have worked in the area . </li>
2005-06-12 12:31:07 +01:00
<li> < a href = "1626/index.html" > Adjacent area 1626 </a> </li> </ul>
2004-04-21 22:49:22 +01:00
</li>
</ul>
2004-04-21 14:18:29 +01:00
< ! - - / LINKS - - >
2004-04-06 03:08:25 +01:00
</body>
</html>
END
2004-04-21 14:18:29 +01:00
close INDXAL ;
2005-01-12 17:27:38 +00:00
#print "Information: Making area indices\n";
#make_indices();
print "Information: Done" ;
if ( $ warnings ) {
print " (with warnings)"
}
unless ( $ no_verbose_progress ) {
print ". Run with -q to see what problems occurred." ;
}
print "\n" ;
2004-04-20 00:37:35 +01:00
# Process a line of the CSV file
# First argument is contents of line to process
2004-05-07 15:50:43 +01:00
# 2nd arg is the Kataster number of the cave an entrance belongs to (optional)
# 3rd arg is the Other number of the cave an entrance belongs to (optional)
# 4th arg is the basename of the cave an entrance belongs to (optional)
2004-04-20 00:37:35 +01:00
# Returns nothing
2004-04-06 03:08:25 +01:00
sub do_this_line {
# Split single line into all the fields
2005-06-01 15:10:04 +01:00
my ( $ kat_num , $ kat_status , $ ents , $ other_number , $ mult_ents , $ file , $ linkfile , undef , $ name , $ unofficial_name , $ comment , $ area , $ explorers , $ u_description , $ equipment , $ qmlist , $ katstatus , $ references , $ u_centre_line , $ u_drawn_survey , $ survex_file , $ length , $ depth , $ extent , $ notes , $ ent_name , $ tag_punkt , $ other_punkt , $ desc_other_punkt , $ exact_punkt , $ fix_type , $ gpspresa , $ gpspostsa , $ northing , $ easting , $ altitude , $ bearings , $ map , $ location , $ approach , $ ent_desc , $ ent_photo , $ marking , $ marking_comment , $ findability , $ findability_comment ) = & parse_csv ( $ _ [ 0 ] ) ;
2004-05-07 15:50:43 +01:00
my $ parents_name ;
2005-01-12 17:27:38 +00:00
2004-04-20 00:37:35 +01:00
# If we have been called to process an entrance, we may have been given the cave's Kataster number or Other number
2004-05-07 15:50:43 +01:00
if ( $ _ [ 1 ] and ! $ kat_num ) {
$ kat_num = $ _ [ 1 ] ;
}
if ( $ _ [ 2 ] and ! $ other_number ) {
$ other_number = $ _ [ 2 ] ;
2004-04-06 03:08:25 +01:00
}
2004-05-07 15:50:43 +01:00
if ( $ _ [ 3 ] ) {
$ parents_name = $ _ [ 3 ] ;
2004-04-06 03:08:25 +01:00
}
2005-01-12 17:27:38 +00:00
# Bitch if a link file has too much information.
if ( $ linkfile && $ file ) {
print STDERR "Warning: both a file ($file) and a linkfile ($linkfile) specified. This makes no sense.\n\n" ;
$ warnings = 1 ;
}
2005-05-28 00:13:40 +01:00
if ( $ linkfile && ( $ kat_status || $ name || $ unofficial_name || $ comment || $ area || $ explorers || $ u_description || $ equipment || $ qmlist || $ katstatus || $ references || $ u_centre_line || $ u_drawn_survey || $ survex_file || $ length || $ depth || $ extent || $ notes || $ ent_name || $ tag_punkt || $ other_punkt || $ desc_other_punkt || $ exact_punkt || $ fix_type || $ gpspresa || $ gpspostsa || $ northing || $ easting || $ altitude || $ bearings || $ map || $ location || $ approach || $ ent_desc || $ ent_photo || ( $ marking and $ marking ne "\r" and $ marking ne "\r\n" and $ marking ne "\n" ) ) ) {
2005-05-07 21:33:35 +01:00
print STDERR "Warning: In the link cave $kat_num($ents) -> $other_number there is extraneous information provided that will not be used. Please merge it into the description of the cave to which it links. The only information allowed in a link file is Kataster Number,\nEntrances, Other Number, Multiple Entrances, and the name of the linkfile\n\n" ;
2005-01-12 17:27:38 +00:00
$ warnings = 1 ;
}
2004-04-22 12:20:31 +01:00
# Generate $linkid which will be kataster no., or other no. if no kataster no. present. Per HTML4 (and XHTML etc.) ID and NAME tokens must begin with alpha characters - hence "id" prepend
my $ linkid = "id$kat_num" ;
2004-04-06 03:08:25 +01:00
my $ other_number_no_brackets = $ other_number ;
if ( $ kat_num and $ other_number ) {
$ other_number = "($other_number)" ; # wrap it in brackets, so it doesn't appear to be official
} elsif ( $ other_number and ! $ kat_num ) {
2004-04-22 12:20:31 +01:00
$ linkid = "id$other_number" ;
2004-04-06 03:08:25 +01:00
}
2004-04-21 16:24:24 +01:00
# Under XHTML 1.0, link ids must not have '(', '?', ' ', or '/'
$ linkid =~ s/\//-/g ;
$ linkid =~ s/\?/q/ ;
$ linkid =~ s/\(/:/ ;
$ linkid =~ s/\)/:/ ;
$ linkid =~ s/ /_/ ;
2004-04-29 18:43:49 +01:00
$ linkid = lc ( $ linkid ) ;
2004-04-06 03:08:25 +01:00
2007-02-21 15:31:51 +00:00
my $ dslen = ( $ lhash { $ linkid } [ 0 ] or "" ) ;
my $ dsdepth = ( $ lhash { $ linkid } [ 1 ] or "" ) ;
my $ dsext = ( $ lhash { $ linkid } [ 2 ] or "" ) ;
if ( $ dslen ne "" ) { $ dslen = $ dslen . "m" } ;
if ( $ dsdepth ne "" ) { $ dsdepth = $ dsdepth . "m" } ;
if ( $ dsext ne "" ) { $ dsext = $ dsext . "m" } ;
if ( $ dslen and $ length ) { $ dslen = "$dslen ($length)" ; } ;
if ( $ dsdepth and $ depth ) { $ dsdepth = "$dsdepth ($depth)" ; } ;
if ( $ dsext and $ extent ) { $ dsext = "$dsext ($extent)" ; } ;
if ( $ dslen eq "" ) { $ dslen = $ length } ;
if ( $ dsdepth eq "" ) { $ dsdepth = $ depth } ;
if ( $ dsext eq "" ) { $ dsext = $ extent } ;
# Determine the number of directories deep the cave's main page is, in order to link to area descriptions and indxal
2004-04-06 03:08:25 +01:00
my $ toroot = 'Q' ; # hey; it's magic
my $ counter = ( $ file =~ tr /\// / ) ;
while ( $ counter ) {
$ toroot = join ( '' , $ toroot , "/.." ) ;
$ counter - - ;
}
$ toroot =~ s/Q\/// ;
2004-05-07 15:50:43 +01:00
# If it's not an entrance, and it's not in 1626, insert it in the index file
if ( $ mult_ents !~ /entrance/ && $ area ne 1626 ) {
2004-04-06 03:08:25 +01:00
my $ e = $ ents ;
$ e =~ s/ +/ /g ;
2004-04-21 16:24:24 +01:00
print INDXAL "<tr><td><a name=\"$linkid\">$kat_num $other_number" ;
2004-04-06 03:08:25 +01:00
if ( $ e ) {
2004-04-21 14:18:29 +01:00
print INDXAL "<small> - $e</small>" ;
2004-04-06 03:08:25 +01:00
}
2004-04-21 14:18:29 +01:00
print INDXAL "</a></td><td>" ;
2004-04-06 03:08:25 +01:00
if ( $ file ) {
2004-04-21 14:18:29 +01:00
print INDXAL "<a href=\"$file\">" ;
2004-04-06 03:08:25 +01:00
} elsif ( $ linkfile ) {
2004-04-21 14:18:29 +01:00
print INDXAL "<a href=\"$linkfile\">" ;
2004-04-06 03:08:25 +01:00
}
if ( $ name ) {
2004-04-21 14:18:29 +01:00
print INDXAL $ name ;
2004-04-06 03:08:25 +01:00
} else {
2004-04-21 14:18:29 +01:00
print INDXAL "?" ;
2004-04-06 03:08:25 +01:00
}
if ( $ unofficial_name ) {
2004-04-21 14:18:29 +01:00
print INDXAL " ($unofficial_name)" ;
2004-04-06 03:08:25 +01:00
}
if ( $ file or $ linkfile ) {
2004-04-21 14:18:29 +01:00
print INDXAL "</a>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ comment ) {
2004-04-21 14:18:29 +01:00
print INDXAL " - $comment" ;
2004-04-06 03:08:25 +01:00
}
2004-04-21 14:18:29 +01:00
print INDXAL "</td></tr>\n" ;
2004-04-06 03:08:25 +01:00
}
2005-01-12 17:27:38 +00:00
# If the cave does not have a filename allocated, but does have multiple entrances, keep going through the CSV file until we are at the last entrance, before we return. This could go wrong if we ever did a linkfile for an entire cave (not just an entrance), which possessed multiple entrances. Until we do it stays like this
2004-04-06 03:08:25 +01:00
unless ( $ file ) { # this IS necessary
if ( $ mult_ents eq "yes" ) {
2005-01-12 17:27:38 +00:00
die "Umm, this code hasn't been tested recently and may be wrong (specifically using the file snarfer without assigning the return). Comment this death out to see what happens" ;
2004-04-06 03:08:25 +01:00
my $ e_mult_ents ;
do {
2005-01-12 17:27:38 +00:00
<CSV> ;
2004-04-06 03:08:25 +01:00
chomp ;
2005-01-12 17:27:38 +00:00
my $ emult_ents = ( & parse_csv ( $ _ ) ) [ 4 ] ;
2004-04-06 03:08:25 +01:00
$ e_mult_ents = $ emult_ents ;
} while ( $ e_mult_ents ne "last entrance" ) ;
}
return ;
}
2004-04-20 00:37:35 +01:00
# If command line option is set, then be quiet
2004-04-18 19:57:30 +01:00
unless ( $ no_verbose_progress ) {
2004-04-06 03:08:25 +01:00
print "Progress: $file\n" ;
}
2005-01-12 17:27:38 +00:00
# Determine $file's basename and dirname
( my $ fn = $ file ) =~ s/^.*\///ig ;
2004-04-20 00:37:35 +01:00
my $ path = $ file ;
$ path =~ s/\/$fn//g ;
2005-01-12 17:27:38 +00:00
2007-02-21 15:31:51 +00:00
# Make the directory that the file is in, in case it doesn't exist yet
2007-02-23 00:01:56 +00:00
#mkpath($path);
# this is considered harmful now creation of directories is versioned - DL
2004-04-20 00:37:35 +01:00
# Open the file and start writing to it
open FILE , "> $file" or die $! ;
2007-02-23 00:01:56 +00:00
print LOGFILE "Created $file\n" ;
2004-04-06 03:08:25 +01:00
print FILE << "END" ;
2004-04-21 22:49:22 +01:00
< ! DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" >
2004-04-06 03:08:25 +01:00
< ! - - ** * This file is auto - generated by $ progname - edit cavetab2 . csv instead - - >
2004-04-27 14:47:29 +01:00
< html lang = "en" xmlns = "http://www.w3.org/1999/xhtml" xml:lang = "en" >
2004-04-06 03:08:25 +01:00
<head>
2004-04-21 22:49:22 +01:00
< meta http - equiv = "Content-Type" content = "text/html; charset=iso-8859-1" / >
< link rel = "stylesheet" type = "text/css" href = "$toroot/css/main2.css" / >
2004-04-06 03:08:25 +01:00
END
if ( $ kat_num ) {
2004-05-07 15:50:43 +01:00
if ( $ area ne 1626 ) {
print FILE "<title>1623:$kat_num" ;
} else {
print FILE "<title>1626:$kat_num" ;
}
2004-04-06 03:08:25 +01:00
} else {
2004-04-21 16:24:24 +01:00
print FILE "<title>$other_number" ;
2004-04-06 03:08:25 +01:00
}
print FILE << "END" ;
</title>
</head>
<body>
END
2004-04-21 22:49:22 +01:00
print FILE "<table id=\"cavepage\">\n" ;
2005-05-11 17:46:18 +01:00
print FILE "<tr><th id=\"kat_no\">" ;
if ( $ kat_num ) { print FILE "$kat_num" } else { print FILE "$other_number" }
if ( $ ents ) { print FILE " - $ents" }
if ( $ other_number && $ kat_num ) { print FILE "<br />$other_number" }
2004-04-21 22:49:22 +01:00
print FILE "</th><th id=\"name\">$name" ;
2004-04-06 03:08:25 +01:00
if ( $ unofficial_name ) {
2004-04-22 11:26:19 +01:00
if ( $ name ) {
print FILE "<br />" ;
}
print FILE " ($unofficial_name)" ;
2004-04-06 03:08:25 +01:00
}
2005-01-12 17:27:38 +00:00
print FILE "</th><th id=\"status\">$kat_status</th></tr>\n</table>" ; # if no $kat_status, no problem
2004-04-06 03:08:25 +01:00
2007-02-21 15:31:51 +00:00
if ( $ dslen or $ dsdepth or $ dsext ) {
2004-04-06 03:08:25 +01:00
print FILE "\n\n<p>" ;
}
2007-02-21 15:31:51 +00:00
if ( $ dslen ) {
print FILE "<b>Length:</b> ${dslen} " ;
2004-04-06 03:08:25 +01:00
}
2007-02-21 15:31:51 +00:00
if ( $ dsdepth ) {
print FILE "<b>Depth:</b> ${dsdepth} " ;
2004-04-06 03:08:25 +01:00
}
2007-02-21 15:31:51 +00:00
if ( $ dsext ) {
print FILE "<b>Extent:</b> ${dsext} " ;
2004-04-06 03:08:25 +01:00
}
2007-02-21 15:31:51 +00:00
if ( $ dslen or $ dsdepth or $ dsext ) {
2004-04-21 16:24:24 +01:00
print FILE "</p>" ;
}
2004-04-06 03:08:25 +01:00
# Entrance specific bit
unless ( $ mult_ents eq "yes" ) {
2004-04-21 16:24:24 +01:00
# If there is only one entrance,
print FILE "\n\n<p>" ;
2004-04-27 14:47:29 +01:00
if ( $ tag_punkt || $ other_punkt || $ exact_punkt || $ gpspostsa || $ gpspresa || $ easting || $ northing || $ altitude || $ fix_type || $ desc_other_punkt && ! $ ent_name ) { # basically, if do_ent is going to do anything, print "Entrance:"
print FILE "<b>Entrance: </b>" ;
2004-04-06 03:08:25 +01:00
}
2004-04-20 00:37:35 +01:00
# Process the location data for the entrance
2004-04-06 03:08:25 +01:00
do_ent ( $ tag_punkt , $ other_punkt , $ exact_punkt , $ gpspostsa , $ gpspresa , $ easting , $ northing , $ altitude , $ ent_name , $ fix_type , $ desc_other_punkt ) ;
2004-04-21 16:24:24 +01:00
print FILE "</p>"
2004-04-06 03:08:25 +01:00
} else {
# If there are multiple entrances
multi_ents ( $ file , $ kat_num , $ other_number , $ other_number_no_brackets , $ toroot ) ;
}
# Cave general bit
2005-01-12 17:27:38 +00:00
if ( $ area ) {
print FILE "\n\n<p><b>Nominal area:</b> " ;
foreach $ _ ( split ( / / , $ area ) ) { # deal with caves allocated multiple areas
if ( expandarea ( $ _ , 0 ) ) { # drop junk words in $area such as "or"
2005-06-12 12:31:07 +01:00
print FILE "$_ - <a href=\"$toroot\/" , ( expandarea ( $ _ , 0 ) ) [ 1 ] , "\/index.html#$linkid\">" , ( expandarea ( $ _ , 0 ) ) [ 0 ] , "</a> " ; # this sucketh mightily. How can I get a horizontal tab? FIXME
2005-01-12 17:27:38 +00:00
}
}
print FILE "</p>" ;
}
2004-04-06 03:08:25 +01:00
if ( $ location ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Location:</b> $location</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ bearings ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Bearings:</b> $bearings</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ approach ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Approach:</b> $approach</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ map ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Map:</b> $map</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ ent_desc ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Entrance Description:</b> $ent_desc</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ ent_photo ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Entrance Photo:</b> $ent_photo</p>" ;
2004-04-06 03:08:25 +01:00
}
2005-06-01 15:10:04 +01:00
if ( $ marking or $ marking_comment ) {
print FILE "\n\n<p><b>Marking:</b> "
}
if ( $ marking ) {
print FILE "$marking" ;
}
if ( $ marking and $ marking_comment ) { print FILE ". (" }
if ( $ marking_comment )
{
print FILE "$marking_comment"
}
if ( $ marking and $ marking_comment ) { print FILE ")" }
if ( $ marking or $ marking_comment ) {
print FILE "</p>"
2004-04-06 03:08:25 +01:00
}
2005-06-01 15:10:04 +01:00
2004-04-06 03:08:25 +01:00
if ( $ references ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>References:</b> $references</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ u_description ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Underground Description:</b> $u_description</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ equipment ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Equipment:</b> $equipment</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ qmlist ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>QM list:</b> $qmlist</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ u_drawn_survey ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Survey:</b> $u_drawn_survey</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ notes ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Notes:</b> $notes</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ explorers ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Explorers:</b> $explorers</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ katstatus ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Kataster Status:</b> $katstatus</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ u_centre_line ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Centre Line:</b> $u_centre_line</p>" ;
2004-04-06 03:08:25 +01:00
}
if ( $ survex_file ) {
2004-04-21 16:24:24 +01:00
print FILE "\n\n<p><b>Survex file:</b> $survex_file</p>" ;
2004-04-06 03:08:25 +01:00
}
2004-04-27 14:47:29 +01:00
print FILE "\n\n<!-- LINKS -->\n<hr /><ul>\n" ;
2004-04-21 22:49:22 +01:00
2005-01-12 17:27:38 +00:00
# Count how many times the filename for FILE is in the CSV
my $ storedoffset ;
$ counter = 0 ;
$ storedoffset = tell ( CSV ) ;
seek ( CSV , 0 , 0 ) ;
while ( <CSV> ) {
chomp ;
if ( grep ( /,\"$file\",/ , $ _ ) ) {
$ counter + + ;
}
}
seek ( CSV , $ storedoffset , 0 ) ;
# If it is more than once, it is being linked to in some fashion, so provide a method to go back
if ( $ counter > 1 ) {
print FILE "<li><a href=\"javascript:history.back(1)\">Go Back (Javascript)</a></li>\n" ; # ACCK! ACCK! Evil JavaScript! - this is done for linkfiles (mainly), where the reader could have got there by numerous routes, and we don't know how to return them whence they came in advance
}
2004-05-07 15:50:43 +01:00
if ( $ mult_ents =~ /entrance/ ) {
print FILE "<li><a href=\"$parents_name\">Go up to overall cave description for this entrance</a></li>\n" ;
2004-04-27 14:47:29 +01:00
}
2004-04-20 00:37:35 +01:00
# Find the area the cave is in, and add appropriate links
2005-01-12 17:27:38 +00:00
foreach $ _ ( split ( / / , $ area ) ) { # deal with caves allocated multiple areas
if ( expandarea ( $ _ , 1 ) ) { # drop junk words in $area such as "or"
2005-06-12 12:31:07 +01:00
print FILE "<li><a href=\"$toroot\/" , ( expandarea ( $ _ , 1 ) ) [ 1 ] , "\/index.html#$linkid\">" , ( expandarea ( $ _ , 1 ) ) [ 0 ] , " area index and description</a></li>\n" ;
2005-01-12 17:27:38 +00:00
}
2004-05-07 15:50:43 +01:00
}
2004-04-06 03:08:25 +01:00
2005-06-12 13:53:52 +01:00
if ( $ area ne "1626" )
{
print FILE "<li><a href=\"$toroot/indxal.htm#$linkid\">Full Index of 1623 Caves</a></li>" ;
}
2004-04-20 00:37:35 +01:00
# Finish writing to file
2004-04-06 03:08:25 +01:00
print FILE << "END" ;
2004-04-21 22:49:22 +01:00
<li> < a href = "$toroot/areas.htm" > Other Areas </a> </li>
<li> < a href = "$toroot/index.htm" > Back to Expedition Intro page </a> </li>
</ul>
2004-04-21 14:18:29 +01:00
< ! - - / LINKS - - >
2004-04-06 03:08:25 +01:00
</body>
</html>
END
2005-01-12 17:27:38 +00:00
if ( tell ( FILE ) > 15000 ) {
print STDERR "Warning: File $file is bigger than 15kb; consider splitting its contents up\n\n" ;
}
2004-04-06 03:08:25 +01:00
close FILE ;
}
2004-04-20 00:37:35 +01:00
# Parse a line of CSV data
# Argument is the line of data to be processed
# Returns array of the separated variables
2004-04-06 03:08:25 +01:00
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 ) ;
}
2005-01-12 17:27:38 +00:00
# Find the entrance information, from the entrance the link points at
# 1st arg - the filename (as in the CSV) to which the link goes
# 2nd arg - the entrance of the cave to which the link goes
# Returns nothing
sub do_link_ent {
my $ linkfile = $ _ [ 0 ] ;
my $ linkent = $ _ [ 1 ] ;
my $ linkname = $ _ [ 2 ] ;
my $ storedoffset ;
$ storedoffset = tell ( CSV ) ;
seek ( CSV , 0 , 0 ) ;
while ( <CSV> ) {
chomp ;
if ( grep ( /,\"$linkfile\",/ , $ _ ) ) {
if ( ( & parse_csv ( $ _ ) ) [ 5 ] eq $ linkfile ) {
if ( ( & parse_csv ( $ _ ) ) [ 4 ] eq "yes" ) {
while ( ( & parse_csv ( $ _ ) ) [ 2 ] ne $ linkent ) {
$ _ = <CSV> ;
chomp ;
if ( ( & parse_csv ( $ _ ) ) [ 4 ] eq "last entrance" && ( & parse_csv ( $ _ ) ) [ 2 ] ne $ linkent ) {
print STDERR "Warning: Link entrance for $linkname not found\n\n" ;
$ warnings = 1 ;
seek ( CSV , $ storedoffset , 0 ) ;
return ;
}
}
}
2005-06-01 15:10:04 +01:00
my ( undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , $ lent_name , $ ltag_punkt , $ lother_punkt , $ ldesc_other_punkt , $ lexact_punkt , $ lfix_type , $ lgpspresa , $ lgpspostsa , $ lnorthing , $ leasting , $ laltitude , undef , undef , undef , undef , undef , undef , $ lmarking ) = & parse_csv ( $ _ ) ;
do_ent ( $ ltag_punkt , $ lother_punkt , $ lexact_punkt , $ lgpspostsa , $ lgpspresa , $ leasting , $ lnorthing , $ laltitude , $ lent_name , $ lfix_type , $ ldesc_other_punkt , $ lmarking ) ;
2005-01-12 17:27:38 +00:00
seek ( CSV , $ storedoffset , 0 ) ;
return ;
}
}
}
}
2004-04-20 00:37:35 +01:00
# Process the location data for the entrance
# Returns nothing
2004-04-06 03:08:25 +01:00
sub do_ent {
my $ punkt ;
my $ calc_easting ;
my $ calc_northing ;
my $ calc_altitude ;
my $ desc ;
my $ tag_punkt = $ _ [ 0 ] ;
my $ other_punkt = $ _ [ 1 ] ;
my $ exact_punkt = $ _ [ 2 ] ;
my $ gpspostsa = $ _ [ 3 ] ;
my $ gpspresa = $ _ [ 4 ] ;
my $ easting = $ _ [ 5 ] ;
my $ northing = $ _ [ 6 ] ;
my $ altitude = $ _ [ 7 ] ;
my $ ent_name = $ _ [ 8 ] ;
my $ fix_type = $ _ [ 9 ] ;
my $ desc_other_punkt = $ _ [ 10 ] ;
2005-06-01 15:10:04 +01:00
my $ marking = $ _ [ 11 ] ;
2004-04-06 03:08:25 +01:00
# Write out info for entrance
if ( $ ent_name ) {
2004-04-21 16:24:24 +01:00
print FILE "<b>Entrance Name:</b> $ent_name " ;
2004-04-06 03:08:25 +01:00
}
if ( $ altitude ) {
print FILE "<b>Recorded Alt:</b> $altitude " ;
}
if ( $ northing ) {
print FILE "<b>Recorded as N</b>$northing " ;
}
if ( $ easting ) {
print FILE "<b>Recorded as E</b>$easting " ;
}
if ( $ fix_type ) {
print FILE "<b>Fix type:</b> $fix_type " ;
}
if ( $ tag_punkt ) {
print FILE "<b>Tag point:</b> $tag_punkt " ;
}
if ( $ other_punkt ) {
print FILE "<b>Point:</b> $other_punkt " ;
if ( $ desc_other_punkt ) {
print FILE "<b>Point description:</b> $desc_other_punkt " ;
} else {
print FILE "<b>Point description:</b> none " ;
}
}
if ( $ exact_punkt ) {
print FILE "<b>Exact entrance:</b> $exact_punkt " ;
}
if ( $ gpspresa ) {
print FILE "<b>GPS pre sa:</b> $gpspresa " ;
}
if ( $ gpspostsa ) {
print FILE "<b>GPS post sa:</b> $gpspostsa " ;
}
# Decide which punkt to lookup
if ( $ tag_punkt ) {
$ punkt = $ tag_punkt ;
$ desc = "tag point" ;
} elsif ( $ other_punkt ) {
$ punkt = $ other_punkt ;
$ desc = "point" ;
} elsif ( $ exact_punkt ) {
$ punkt = $ exact_punkt ;
$ desc = "exact point" ;
} elsif ( $ gpspostsa ) {
$ punkt = $ gpspostsa ;
2006-09-07 03:28:22 +01:00
$ desc = "GPS (post SA)" ;
2004-04-06 03:08:25 +01:00
} elsif ( $ gpspresa ) {
$ punkt = $ gpspresa ;
2006-09-07 03:28:22 +01:00
$ desc = "GPS (pre SA)" ;
2004-04-06 03:08:25 +01:00
}
# Find the position of that punkt
if ( $ punkt ) {
for my $ surveypoint ( @ pos ) {
if ( $ surveypoint =~ m/\( *([0-9\.\-]*), *([0-9\.\-]*), *([0-9\.\-]*) \) $punkt(\r\n|\n|\r)/ ) {
$ calc_easting = $ 1 ;
$ calc_northing = $ 2 ;
$ calc_altitude = $ 3 ;
}
}
if ( $ calc_easting ) {
2004-04-21 22:49:22 +01:00
print FILE "<br />\nLookup values for $desc data: " ;
2004-04-06 03:08:25 +01:00
print FILE "<b>Alt:</b> $calc_altitude " ;
print FILE "<b>N</b>$calc_northing " ;
print FILE "<b>E</b>$calc_easting " ;
2005-01-12 17:27:38 +00:00
} else {
print STDERR "Warning: Lookup point for $desc data not found: $punkt\n\n" ;
$ warnings = 1 ;
}
2004-04-06 03:08:25 +01:00
}
2005-06-01 15:10:04 +01:00
if ( $ marking ) { print FILE "<b>Marking:</b> $marking " } ;
2004-04-06 03:08:25 +01:00
}
2004-04-20 00:37:35 +01:00
# Handle multiple entrances
# 1st arg is the file name of the cave to which the entrance belongs
# 2nd arg is the Kataster number of the cave
# 3rd arg is the Other number of the cave (which may have been put in brackets)
# 4th arg is the Other number of the cave without any brackets
# 5th arg is the path to return to the root from the cave
2004-04-06 03:08:25 +01:00
sub multi_ents {
my $ file = $ _ [ 0 ] ;
my $ kat_num = $ _ [ 1 ] ;
my $ other_number = $ _ [ 2 ] ;
my $ other_number_no_brackets = $ _ [ 3 ] ;
my $ toroot = $ _ [ 4 ] ;
2004-04-21 22:49:22 +01:00
print FILE "\n\n<p><b>Entrances:</b></p>\n\n<ul>" ;
2004-04-06 03:08:25 +01:00
my $ e_mult_ents ;
2004-04-20 00:37:35 +01:00
# Process each entrance
2004-04-06 03:08:25 +01:00
do {
my $ e = <CSV> ;
2005-01-12 17:27:38 +00:00
chomp ( $ e ) ;
2004-04-06 03:08:25 +01:00
2005-06-01 15:10:04 +01:00
my ( $ ekat_num , undef , $ eents , $ eother_number , $ emult_ents , $ efile , $ elinkfile , $ elinkent , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , undef , $ eent_name , $ etag_punkt , $ eother_punkt , $ edesc_other_punkt , $ eexact_punkt , $ efix_type , $ egpspresa , $ egpspostsa , $ enorthing , $ eeasting , $ ealtitude , undef , undef , undef , undef , undef , undef , $ emarking ) = & parse_csv ( $ e ) ;
2004-04-06 03:08:25 +01:00
if ( $ eother_number ) {
$ eother_number = "($eother_number)" ; # wrap it in brackets, so it doesn't appear to be official
}
2004-04-21 14:18:29 +01:00
print FILE "\n<li>" ;
2004-04-06 03:08:25 +01:00
2004-04-20 00:37:35 +01:00
if ( $ elinkfile ) { # this is a link to another cave - add link to entrance into cave file but don't generate another file for the entrance
2004-04-06 03:08:25 +01:00
print FILE "<a href=\"$toroot\/$elinkfile\">$eents $eother_number</a> " ;
2004-05-07 15:50:43 +01:00
do_this_line ( $ e , $ kat_num , $ other_number_no_brackets ) ;
2005-01-12 17:27:38 +00:00
# Process the location data for the entrance
do_link_ent ( $ elinkfile , $ elinkent , join ( '' , $ ekat_num , $ eents ) ) ;
2004-04-20 00:37:35 +01:00
} elsif ( $ efile ) { # call ourselves recursively to create a file for the entrance
2004-04-06 03:08:25 +01:00
print FILE "<a href=\"$toroot\/$efile\">$eents $eother_number</a> " ;
close FILE ; # perl filehandles are not recursively safe (when hacking at 4 in the morning). thus do this.
2005-01-12 17:27:38 +00:00
do_this_line ( $ e , $ kat_num , $ other_number_no_brackets , ( ( $ _ = $ file ) =~ s/^.*\///ig ) && $ _ ) ;
2004-04-06 03:08:25 +01:00
open FILE , ">> $file" or die $! ;
2005-01-12 17:27:38 +00:00
# Process the location data for the entrance
2005-06-01 15:10:04 +01:00
do_ent ( $ etag_punkt , $ eother_punkt , $ eexact_punkt , $ egpspostsa , $ egpspresa , $ eeasting , $ enorthing , $ ealtitude , $ eent_name , $ efix_type , $ edesc_other_punkt , $ emarking ) ;
2004-04-20 00:37:35 +01:00
} else { # no entrance file needed, and no link to another cave
2004-04-06 03:08:25 +01:00
print FILE "$eents $eother_number" ;
2005-01-12 17:27:38 +00:00
# Process the location data for the entrance
2005-06-01 15:10:04 +01:00
do_ent ( $ etag_punkt , $ eother_punkt , $ eexact_punkt , $ egpspostsa , $ egpspresa , $ eeasting , $ enorthing , $ ealtitude , $ eent_name , $ efix_type , $ edesc_other_punkt , $ emarking ) ;
2004-04-06 03:08:25 +01:00
}
2004-04-21 22:49:22 +01:00
print FILE "</li>" ;
2004-04-06 03:08:25 +01:00
$ e_mult_ents = $ emult_ents ;
} while ( $ e_mult_ents ne "last entrance" ) ;
2004-04-21 22:49:22 +01:00
print FILE "\n</ul>" ;
2004-04-06 03:08:25 +01:00
}
2004-04-20 01:11:21 +01:00
2005-01-12 17:27:38 +00:00
# Return detailed area name when handed area code
# 1st arg - area code
# 2nd arg - generalise subareas
sub expandarea {
if ( $ _ [ 1 ] == 1 && $ _ [ 0 ] =~ /1[a-z]/ && $ _ [ 0 ] ne 1626 ) {
return ( "Plateau" , "plateau" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "1a" ) {
2005-06-01 15:10:04 +01:00
return ( "Nearer plateau (access from Top Camp)" , "plateau" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "1b" ) {
2005-06-01 15:10:04 +01:00
return ( "Western plateau (Puffball area)" , "plateau" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "1c" ) {
2005-06-01 15:10:04 +01:00
return ( "Eastern plateau area near Steinbrücken path" , "plateau" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "1d" ) {
2005-06-01 15:10:04 +01:00
return ( "Further plateau near Eislufthöhle" , "plateau" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 1 ] == 1 && $ _ [ 0 ] =~ /2[a-z]/ && $ _ [ 0 ] ne 1626 ) {
return ( "Schwarzmooskogel ridge" , "smkridge" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "2a" ) {
2005-06-01 15:10:04 +01:00
return ( "Southern Schwarzmooskogel ridge – Stellerweg / Weiße Warze area" , "smkridge" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "2b" ) {
2005-06-01 15:10:04 +01:00
return ( "South-east slopes of Vorderer Schwarzmooskogel – Eishöhle area" , "smkridge" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "2c" ) {
return ( "Vorderer to Hinterer Schwarzmooskogel – Kaninchenhöhle area" , "smkridge" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "2d" ) {
return ( "Northern Schwarzmooskogel ridge (access from Steinbrücken)" , "smkridge" ) ;
2005-01-12 17:27:38 +00:00
}
if ( $ _ [ 0 ] eq 3 ) {
return ( "Bräuning Alm" , "br-alm" ) ;
}
if ( $ _ [ 0 ] eq 4 ) {
return ( "Kratzer valley" , "kratzer" ) ;
}
if ( $ _ [ 0 ] eq 5 ) {
return ( "Schwarzmoos-Wildensee" , "wilden" ) ;
}
if ( $ _ [ 0 ] eq 6 ) {
return ( "Far plateau" , "remote" ) ;
}
if ( $ _ [ 0 ] eq 7 ) {
return ( "Egglgrube" , "egglgrub" ) ;
}
if ( $ _ [ 1 ] == 1 && $ _ [ 0 ] =~ /8[a-z]/ ) {
return ( "Loser/Augst See" , "loser" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "8a" ) {
return ( "South face of Loser - reached from Loser Hütte path" , "loser" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "8b" ) {
return ( "Ammerich and Höllgraben - below Dimmelwand and the last part of toll road" , "loser" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "8c" ) {
return ( "Around Augst See" , "loser" ) ;
}
if ( $ _ [ 1 ] == 0 && $ _ [ 0 ] eq "8d" ) {
return ( "Loser - Hochanger ridge area" , "loser" ) ;
}
if ( $ _ [ 0 ] eq 9 ) {
return ( "Gschwandt" , "gschwand" ) ;
}
if ( $ _ [ 0 ] eq 10 ) {
return ( "N & NE shore of Altauseer See" , "aaussee" ) ;
}
if ( $ _ [ 0 ] eq 11 ) {
return ( "Augstbach" , "augstb" ) ;
}
if ( $ _ [ 0 ] eq 1626 ) {
return ( "1626 (Rauher - Schönberg)" , "1626" ) ;
}
}
2004-04-20 01:11:21 +01:00
# Usage
sub usage {
print << "EOF" ;
USAGE: $ progname [ - options ] < CSV file >
- q , - - quiet Be quiet about progress
- h , - - help Show this message
2005-01-12 17:27:38 +00:00
$ progname must be run from noinfo directory of expoweb hierarchy .
2004-04-20 01:11:21 +01:00
EOF
exit ( 0 ) ;
}
2005-01-12 17:27:38 +00:00
# Parent function for making per area tables from CAVETAB2, which may then be included in some fashion
# Returns nothing
sub make_indices {
make_table ( 1 , "1a" , "plateau" , "Around Top Camp and below Bräuning Wall" ) ;
make_table ( 0 , "1b" , "plateau" , ""Nearer" plateau - including holes found on "geologists' walk"" , "Note that this area probably overlaps the last one - I found 171 whilst looking for 190 (as B9)..." ) ;
make_table ( 0 , "1c" , "plateau" , ""Nearer" plateau northeast of the col" ) ;
make_table ( 0 , "1d" , "plateau" , ""Middle" plateau" ) ;
make_table ( 1 , "2a" , "smkridge" , "Caves known or expected to link into the Stellerweg - Eishöhle and Kaninchenhöhle systems" ) ;
make_table ( 0 , "2b" , "smkridge" , "Caves in the same area - but not yet linked" ) ;
make_table ( 1 , "3" , "br-alm" ) ;
make_table ( 1 , "4" , "kratzer" ) ;
make_table ( 1 , "5" , "wilden" ) ;
make_table ( 1 , "6" , "remote" ) ;
make_table ( 1 , "7" , "egglgrub" ) ;
make_table ( 1 , "8a" , "loser" , "South face of Loser - reached from Loser Hütte path" ) ;
make_table ( 0 , "8b" , "loser" , "Ammerich and Höllgraben - below Dimmelwand and the last part of toll road" ) ;
make_table ( 0 , "8c" , "loser" , "Around Augst See" ) ;
make_table ( 0 , "8d" , "loser" , "Loser - Hochanger ridge area" ) ;
make_table ( 1 , "9" , "gschwand" ) ;
make_table ( 1 , "10" , "aaussee" ) ;
make_table ( 1 , "11" , "augstb" ) ;
make_table ( 1 , "1626" , "1626" ) ;
}
# Output the blurb for the index table
# 1st argument specifies whether to overwrite output file
# 2nd argument specifies area id
# 3rd argument specifies area directory
# 4rd argument (optional) gives a title to the table
# 5th argument (optional) specifies a comment to the table
# Returns nothing
sub make_table {
my @ caves ;
my $ i = 0 ;
if ( $ _ [ 0 ] == 1 ) {
open TAB , "> $_[2]/index.html.table" or die $! ;
} else {
open TAB , ">> $_[2]/index.html.table" or die $! ;
}
@ caves = area_grep ( "$_[1]" ) ;
if ( $ _ [ 3 ] ) {
print TAB "<h3 style=\"text-align:center\">$_[3]</h3>\n" ;
}
if ( $ _ [ 4 ] ) {
print TAB "<p style=\"text-align:center; font-size: 80%\">$_[4]</p>\n" ;
}
print TAB "<table class=\"trad centre\">\n" ;
while ( $ caves [ $ i ] [ 0 ] ) {
print TAB "<tr><td><a id=\"$caves[$i][0]\">$caves[$i][1]</a></td><td><a href=\"..\/$caves[$i][2]\">$caves[$i][3]</a></td></tr>\n" ;
$ i + + ;
}
print TAB "</table>\n\n" ;
close TAB ;
}
# Goes through CSV, looking in area column for the area id passed to it in the first argument
# Returns array, 1 x 1st dimension per matching area, 4 x 2nd dimension for linkid, number, file link, and name
sub area_grep {
my $ givenarea = $ _ [ 0 ] ;
my @ return ;
seek ( CSV , 0 , 0 ) ;
while ( <CSV> ) {
chomp ;
my ( $ kat_num , undef , undef , $ other_number , undef , $ file , $ linkfile , undef , $ name , undef , undef , $ area ) = & parse_csv ( $ _ ) ;
if ( $ area eq $ givenarea ) {
my $ linkid = "id$kat_num" ;
my $ number = $ kat_num ;
my $ link = $ file ;
if ( $ other_number ) {
if ( $ kat_num ) {
$ number = "$kat_num ($other_number)" ;
} else {
$ linkid = "id$other_number" ;
$ number = $ other_number ;
}
}
if ( $ linkfile && ! $ file ) {
$ link = $ linkfile ;
}
# Sanitise linkid
$ linkid =~ s/\//-/g ;
$ linkid =~ s/\?/q/ ;
$ linkid =~ s/\(/:/ ;
$ linkid =~ s/\)/:/ ;
$ linkid =~ s/ /_/ ;
$ linkid = lc ( $ linkid ) ;
push ( @ return , [ $ linkid , $ number , $ link , $ name ] ) ;
}
}
return ( @ return ) ;
}
2007-02-21 15:31:51 +00:00
sub munge_lengths {
print "Munging lengths\n" ;
my % return ;
while ( <LENGTHS> ) {
chomp ;
my ( $ id , $ len , $ depth , $ ext ) = split ( "\t" , $ _ ) ;
$ return { "id" . lc ( $ id ) } = [ $ len , $ depth , $ ext ] ;
}
return ( % return ) ;
}
