From 64cd39bf690c3f06a573ceac3a4f24281bf923f4 Mon Sep 17 00:00:00 2001 From: mjg54 Date: Fri, 27 Aug 2004 00:18:33 +0200 Subject: [PATCH] [svn r6441] Make a prospecting guide from CAVETAB2.CSV --- noinfo/make-prospectingguide.pl | 536 ++++++++++++++++++++++++++++++++ 1 file changed, 536 insertions(+) create mode 100755 noinfo/make-prospectingguide.pl diff --git a/noinfo/make-prospectingguide.pl b/noinfo/make-prospectingguide.pl new file mode 100755 index 000000000..eda8468ca --- /dev/null +++ b/noinfo/make-prospectingguide.pl @@ -0,0 +1,536 @@ +#!/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); +}