#!/usr/bin/perl -w use strict; use File::Path; use Getopt::Long; # header column never has any info... ((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 STDERR "Specify a CSV file name as the program's argument(e.g. CAVETAB2.CSV)\n"; usage(); } open (CSV, "< $ARGV[0]") or print STDERR "That filename could not be opened. Exiting.\n" and die $!; # Start writing prospecting file open PROS, ">..\/prospecting.htm" or die $!; print PROS << "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 cavetab2.csv 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" /> <title>Loser Plateau area : Prospecting Guide</title> <link rel="stylesheet" type="text/css" href="css/main2.css" /> </head> <body> <h1>Kataster Gruppe 1623:<br />Loser Augst-Eck - Prospecting Guide</h1> <table border="0" frame="void"> 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 open INPUT2, "< all.pos" or print STDERR "Could not find all.pos in the current directory\n" and die $!; my @pos = <INPUT2>; close INPUT2; # Go down a directory chdir ".."; # While loop which reads in each line of csv file while (<CSV>) { chomp; do_this_line($_); } # Finish writing index file print PROS << "END"; </table> </body> </html> END close PROS; print "Information: Done\n"; # Process a line of the CSV file # First argument is contents of line to process # 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) # Returns nothing sub do_this_line { # Split single line into all the fields my ($kat_num, $kat_status, $ents, $other_number, $mult_ents, $file, $linkfile, $name, $unofficial_name, $comment, $area, $explorers, $u_description, $equipment, $qmlist, $katstatus, $references, $u_centre_line, $u_drawn_survey, $survex_file, $length, $depth, $extent, $header, $footer, $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) = &parse_csv($_[0]); my $parents_name; # If we have been called to process an entrance, we may have been given the cave's Kataster number or Other number if ($_[1] and ! $kat_num) { $kat_num = $_[1]; } if ($_[2] and ! $other_number) { $other_number = $_[2]; } if ($_[3]) { $parents_name = $_[3]; } # 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"; 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) { $linkid = "id$other_number"; } # Under XHTML 1.0, link ids must not have '(', '?', ' ', or '/' $linkid =~ s/\//-/g; $linkid =~ s/\?/q/; $linkid =~ s/\(/:/; $linkid =~ s/\)/:/; $linkid =~ s/ /_/; $linkid = lc($linkid); # Determine the number of directorys deep the cave's main page is, in order to link to area descriptions and indxal my $toroot = 'Q'; # hey; it's magic my $counter = ($file =~ tr/\///); while ($counter) { $toroot = join('', $toroot, "/.."); $counter--; } $toroot =~ s/Q\///; my $tocavesfolder = ""; if ($file =~ m/^(.*[\\\/])([^\\\/]+$)/){ $tocavesfolder=$1; } # 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 unless ($file) { # this IS necessary if ($mult_ents eq "yes") { my $e_mult_ents; do { my $e = <CSV>; chomp; my (undef, undef, undef, undef, $emult_ents) = &parse_csv($e); $e_mult_ents = $emult_ents; } while ($e_mult_ents ne "last entrance"); } return; } # If command line option is set, then be quiet unless ($no_verbose_progress) { print "Progress: $file\n"; } #fix broken links, due to this file being in a different directory to the intended cave html file $comment =~ s/href\=\"/href\=\"$tocavesfolder/g; $explorers =~ s/href\=\"/href\=\"$tocavesfolder/g; $u_description =~ s/href\=\"/href\=\"$tocavesfolder/g; $equipment =~ s/href\=\"/href\=\"$tocavesfolder/g; $qmlist =~ s/href\=\"/href\=\"$tocavesfolder/g; $references =~ s/href\=\"/href\=\"$tocavesfolder/g; $u_drawn_survey =~ s/href\=\"/href\=\"$tocavesfolder/g; $notes =~ s/href\=\"/href\=\"$tocavesfolder/g; $desc_other_punkt =~ s/href\=\"/href\=\"$tocavesfolder/g; $exact_punkt =~ s/href\=\"/href\=\"$tocavesfolder/g; $bearings =~ s/href\=\"/href\=\"$tocavesfolder/g; $map =~ s/href\=\"/href\=\"$tocavesfolder/g; $location =~ s/href\=\"/href\=\"$tocavesfolder/g; $approach =~ s/href\=\"/href\=\"$tocavesfolder/g; $ent_desc =~ s/href\=\"/href\=\"$tocavesfolder/g; $ent_photo =~ s/href\=\"/href\=\"$tocavesfolder/g; $marking =~s /href\=\"/href\=\"$tocavesfolder/g; $comment =~s/src\=\"/src\=\"$tocavesfolder/g; $explorers =~s/src\=\"/src\=\"$tocavesfolder/g; $u_description =~s/src\=\"/src\=\"$tocavesfolder/g; $equipment =~s/src\=\"/src\=\"$tocavesfolder/g; $qmlist =~s/src\=\"/src\=\"$tocavesfolder/g; $references =~s/src\=\"/src\=\"$tocavesfolder/g; $u_drawn_survey =~s/src\=\"/src\=\"$tocavesfolder/g; $notes =~s/src\=\"/src\=\"$tocavesfolder/g; $desc_other_punkt =~s/src\=\"/src\=\"$tocavesfolder/g; $exact_punkt =~s/src\=\"/src\=\"$tocavesfolder/g; $bearings =~s/src\=\"/src\=\"$tocavesfolder/g; $map =~s/src\=\"/src\=\"$tocavesfolder/g; $location =~s/src\=\"/src\=\"$tocavesfolder/g; $approach =~s/src\=\"/src\=\"$tocavesfolder/g; $ent_desc =~s/src\=\"/src\=\"$tocavesfolder/g; $ent_photo =~s/src\=\"/src\=\"$tocavesfolder/g; $marking =~s/src\=\"/src\=\"$tocavesfolder/g; print PROS "<table id=\"cavepage\">\n"; print PROS "<tr><th id=\"kat_no\">"; if ($kat_num) { print PROS "$kat_num"; } if ($ents) { print PROS " - $ents"; } if ($other_number) { if ($kat_num) { print PROS "<br />"; } print PROS " $other_number"; } print PROS "</th><th id=\"name\">$name"; if ($unofficial_name) { if ($name) { print PROS "<br />"; } print PROS " ($unofficial_name)"; } print PROS "</th>"; if ($kat_status) { print PROS "<th id=\"status\">$kat_status</th>"; } print PROS "</tr>\n</table>"; if ($length or $depth or $extent) { print PROS "\n\n<p>"; } if ($length) { print PROS "<b>Length:</b> $length "; } if ($depth) { print PROS "<b>Depth:</b> $depth "; } if ($extent) { print PROS "<b>Extent:</b> $extent "; } if ($length or $depth or $extent) { print PROS "</p>"; } # Entrance specific bit unless ($mult_ents eq "yes") { # If there is only one entrance, print PROS "\n\n<p>"; 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 PROS "<b>Entrance: </b>"; } # Process the location data for the entrance do_ent($tag_punkt,$other_punkt,$exact_punkt,$gpspostsa,$gpspresa,$easting,$northing,$altitude,$ent_name,$fix_type,$desc_other_punkt); print PROS "</p>" } else { # If there are multiple entrances multi_ents($file, $kat_num, $other_number, $other_number_no_brackets, $toroot); } # Cave general bit if ($location) { print PROS "\n\n<p><b>Location:</b> $location</p>"; } if ($bearings) { print PROS "\n\n<p><b>Bearings:</b> $bearings</p>"; } if ($approach) { print PROS "\n\n<p><b>Approach:</b> $approach</p>"; } if ($map) { print PROS "\n\n<p><b>Map:</b> $map</p>"; } if ($ent_desc) { print PROS "\n\n<p><b>Entrance Description:</b> $ent_desc</p>"; } if ($ent_photo) { print PROS "\n\n<p><b>Entrance Photo:</b> $ent_photo</p>"; } if ($marking and $marking ne "\r" and $marking ne "\r\n" and $marking ne "\n") { # bodgelicious. print PROS "\n\n<p><b>Marking:</b> $marking</p>"; } if ($references) { print PROS "\n\n<p><b>References:</b> $references</p>"; } if ($u_description) { print PROS "\n\n<p><b>Underground Description:</b> $u_description</p>"; } if ($equipment) { print PROS "\n\n<p><b>Equipment:</b> $equipment</p>"; } if ($qmlist) { print PROS "\n\n<p><b>QM list:</b> $qmlist</p>"; } if ($u_drawn_survey) { print PROS "\n\n<p><b>Survey:</b> $u_drawn_survey</p>"; } if ($notes) { print PROS "\n\n<p><b>Notes:</b> $notes</p>"; } if ($explorers) { print PROS "\n\n<p><b>Explorers:</b> $explorers</p>"; } if ($katstatus) { print PROS "\n\n<p><b>Kataster Status:</b> $katstatus</p>"; } if ($u_centre_line) { print PROS "\n\n<p><b>Centre Line:</b> $u_centre_line</p>"; } if ($survex_file) { print PROS "\n\n<p><b>Survex file:</b> $survex_file</p>"; } if ($footer) { print PROS "\n\n<p>$footer</p>"; } # print PROS "\n\n<!-- LINKS -->\n<hr /><ul>\n"; # # if ($mult_ents =~ /entrance/) { # print PROS "<li><a href=\"javascript:history.back(1)\">Go Back (Javascript)</a></li>\n"; # ACCK! ACCK! Evil JavaScript! - this HAS to be done, for things like 78a, where the reader could have got there either via 78 OR 40 (and we have NO way of knowing # print PROS "<li><a href=\"$parents_name\">Go up to overall cave description for this entrance</a></li>\n"; # } # # Find the area the cave is in, and add appropriate links # if ($area =~ /(1a|1b|1c|1d)/) { # print PROS "<li><a href=\"$toroot\/plateau\/index.htm#$linkid\">Plateau area index and description</a></li>\n"; # } # if ($area =~ /(2a|2b)/) { # print PROS "<li><a href=\"$toroot\/smkridge\/index.htm#$linkid\">Schwarzmooskogel ridge area index and description</a></li>\n"; # } # if ($area =~ /3/) { # print PROS "<li><a href=\"$toroot\/br-alm\/index.htm#$linkid\">Bräuning Alm area index and description</a></li>\n"; # } # if ($area =~ /4/) { # print PROS "<li><a href=\"$toroot\/kratzer\/index.htm#$linkid\">Kratzer valley index and description</a></li>\n"; # } # if ($area =~ /5/) { # print PROS "<li><a href=\"$toroot\/wilden\/index.htm#$linkid\">Schwarzmoos-Wildensee area index and description</a></li>\n"; # } # if ($area =~ /6/) { # print PROS "<li><a href=\"$toroot\/remote\/index.htm#$linkid\">Far plateau area index and description</a></li>\n"; # print PROS "<li><a href=\"$toroot\/1626\/index.htm\">Adjacent area 1626</a></li>\n"; # } # if ($area =~ /7/) { # print PROS "<li><a href=\"$toroot\/egglgrub\/index.htm#$linkid\">Egglgrube area index and description</a></li>\n"; # } # if ($area =~ /(8a|8b|8c|8d)/) { # print PROS "<li><a href=\"$toroot\/loser\/index.htm#$linkid\">Loser/Augst See area index and description</a></li>\n"; # } # if ($area =~ /9/) { # print PROS "<li><a href=\"$toroot\/gschwand\/index.htm#$linkid\">Gschwandt area index and description</a></li>\n"; # } # if ($area =~ /10/) { # print PROS "<li><a href=\"$toroot\/aaussee\/index.htm#$linkid\">N & NE shore of Altauseer See</a></li>\n"; # } # if ($area =~ /11/) { # print PROS "<li><a href=\"$toroot\/augstb\/index.htm#$linkid\">Augstbach area index and description</a></li>\n"; # } # if ($area =~ /1626/) { # print PROS "<li><a href=\"$toroot\/1626\/index.htm#$linkid\">1626 (Rauher - Schönberg) area index and description</a></li>\n"; # } # Finish writing to file # print PROS << "END"; #<li><a href="$toroot/indxal.htm#$linkid">Full Index</a></li> #<li><a href="$toroot/areas.htm">Other Areas</a></li> #<li><a href="$toroot/index.htm">Back to Expedition Intro page</a></li> #</ul> #<!-- /LINKS --> #</body> #</html> #END } # Parse a line of CSV data # Argument is the line of data to be processed # Returns array of the separated variables 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); } # Process the location data for the entrance # Returns nothing 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]; # Write out info for entrance if ($ent_name) { print PROS "<b>Entrance Name:</b> $ent_name "; } if ($altitude) { print PROS "<b>Recorded Alt:</b> $altitude "; } if ($northing) { print PROS "<b>Recorded as N</b>$northing "; } if ($easting) { print PROS "<b>Recorded as E</b>$easting "; } if ($fix_type) { print PROS "<b>Fix type:</b> $fix_type "; } if ($tag_punkt) { print PROS "<b>Tag point:</b> $tag_punkt "; } if ($other_punkt) { print PROS "<b>Point:</b> $other_punkt "; if ($desc_other_punkt) { print PROS "<b>Point description:</b> $desc_other_punkt "; } else { print PROS "<b>Point description:</b> none "; } } if ($exact_punkt) { print PROS "<b>Exact entrance:</b> $exact_punkt "; } if ($gpspresa) { print PROS "<b>GPS pre sa:</b> $gpspresa "; } if ($gpspostsa) { print PROS "<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; $desc = "GPS (pre SA)"; } elsif ($gpspresa) { $punkt = $gpspresa; $desc = "GPS (post SA)"; } # 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) { print PROS "<br />\nLookup values for $desc data: "; print PROS "<b>Alt:</b> $calc_altitude "; print PROS "<b>N</b>$calc_northing "; print PROS "<b>E</b>$calc_easting "; } else { print STDERR "Warning: Lookup point for $desc data not found: $punkt\n"; } } } # 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 sub multi_ents { my $file = $_[0]; my $kat_num = $_[1]; my $other_number = $_[2]; my $other_number_no_brackets = $_[3]; my $toroot = $_[4]; print PROS "\n\n<p><b>Entrances:</b></p>\n\n<ul>"; my $e_mult_ents; # Process each entrance do { my $e = <CSV>; chomp; my ($ekat_num, undef, $eents, $eother_number, $emult_ents, $efile, $elinkfile, undef, undef, 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) = &parse_csv($e); if ($eother_number) { $eother_number = "($eother_number)"; # wrap it in brackets, so it doesn't appear to be official } print PROS "\n<li>"; 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 print PROS "<a href=\"$toroot\/$elinkfile\">$eents $eother_number</a> "; do_this_line($e, $kat_num, $other_number_no_brackets); } elsif ($efile) { # call ourselves recursively to create a file for the entrance print PROS "<a href=\"$toroot\/$efile\">$eents $eother_number</a> "; #close PROS; # perl filehandles are not recursively safe (when hacking at 4 in the morning). thus do this. do_this_line($e, $kat_num, $other_number_no_brackets, (($_ = $file) =~ s/^.*(\/|\\)//ig) && $_); #open PROS, ">> $file" or die $!; } else { # no entrance file needed, and no link to another cave print PROS "$eents $eother_number"; } # Process the location data for the entrance do_ent($etag_punkt,$eother_punkt,$eexact_punkt,$egpspostsa,$egpspresa,$eeasting,$enorthing,$ealtitude,$eent_name,$efix_type,$edesc_other_punkt); print PROS "</li>"; $e_mult_ents = $emult_ents; } while ($e_mult_ents ne "last entrance"); print PROS "\n</ul>"; } # Usage sub usage { print << "EOF"; USAGE: $progname [-options] <CSV file> -q, --quiet Be quiet about progress -h, --help Show this message EOF exit(0); }