#!/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"; Loser Plateau area : Prospecting Guide

Kataster Gruppe 1623:
Loser Augst-Eck - Prospecting Guide

END ; # 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 = ; close INPUT2; # Go down a directory chdir ".."; # While loop which reads in each line of csv file while () { chomp; do_this_line($_); } # Finish writing index file print PROS << "END";
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 = ; 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 "\n"; print PROS ""; if ($kat_status) { print PROS ""; } print PROS "\n
"; if ($kat_num) { print PROS "$kat_num"; } if ($ents) { print PROS " - $ents"; } if ($other_number) { if ($kat_num) { print PROS "
"; } print PROS " $other_number"; } print PROS "
$name"; if ($unofficial_name) { if ($name) { print PROS "
"; } print PROS " ($unofficial_name)"; } print PROS "
$kat_status
"; if ($length or $depth or $extent) { print PROS "\n\n

"; } if ($length) { print PROS "Length: $length "; } if ($depth) { print PROS "Depth: $depth "; } if ($extent) { print PROS "Extent: $extent "; } if ($length or $depth or $extent) { print PROS "

"; } # Entrance specific bit unless ($mult_ents eq "yes") { # If there is only one entrance, print PROS "\n\n

"; 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 "Entrance: "; } # 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 "

" } 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

Location: $location

"; } if ($bearings) { print PROS "\n\n

Bearings: $bearings

"; } if ($approach) { print PROS "\n\n

Approach: $approach

"; } if ($map) { print PROS "\n\n

Map: $map

"; } if ($ent_desc) { print PROS "\n\n

Entrance Description: $ent_desc

"; } if ($ent_photo) { print PROS "\n\n

Entrance Photo: $ent_photo

"; } if ($marking and $marking ne "\r" and $marking ne "\r\n" and $marking ne "\n") { # bodgelicious. print PROS "\n\n

Marking: $marking

"; } if ($references) { print PROS "\n\n

References: $references

"; } if ($u_description) { print PROS "\n\n

Underground Description: $u_description

"; } if ($equipment) { print PROS "\n\n

Equipment: $equipment

"; } if ($qmlist) { print PROS "\n\n

QM list: $qmlist

"; } if ($u_drawn_survey) { print PROS "\n\n

Survey: $u_drawn_survey

"; } if ($notes) { print PROS "\n\n

Notes: $notes

"; } if ($explorers) { print PROS "\n\n

Explorers: $explorers

"; } if ($katstatus) { print PROS "\n\n

Kataster Status: $katstatus

"; } if ($u_centre_line) { print PROS "\n\n

Centre Line: $u_centre_line

"; } if ($survex_file) { print PROS "\n\n

Survex file: $survex_file

"; } if ($footer) { print PROS "\n\n

$footer

"; } # print PROS "\n\n\n
# # # #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 "Entrance Name: $ent_name "; } if ($altitude) { print PROS "Recorded Alt: $altitude "; } if ($northing) { print PROS "Recorded as N$northing "; } if ($easting) { print PROS "Recorded as E$easting "; } if ($fix_type) { print PROS "Fix type: $fix_type "; } if ($tag_punkt) { print PROS "Tag point: $tag_punkt "; } if ($other_punkt) { print PROS "Point: $other_punkt "; if ($desc_other_punkt) { print PROS "Point description: $desc_other_punkt "; } else { print PROS "Point description: none "; } } if ($exact_punkt) { print PROS "Exact entrance: $exact_punkt "; } if ($gpspresa) { print PROS "GPS pre sa: $gpspresa "; } if ($gpspostsa) { print PROS "GPS post sa: $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 "
\nLookup values for $desc data: "; print PROS "Alt: $calc_altitude "; print PROS "N$calc_northing "; print PROS "E$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

Entrances:

\n\n"; } # Usage sub usage { print << "EOF"; USAGE: $progname [-options] -q, --quiet Be quiet about progress -h, --help Show this message EOF exit(0); }