#!/usr/bin/perl -w use strict; #Change to autogen directory, meking directory as nescessary -d "autogen" or mkdir "autogen", 0755; #Read in pos file to @pos open INPUT2, "; close INPUT2; #Start writing index file open IDXALL, ">..\/indxal.htm" or die $!; print IDXALL < Loser Plateau area : Cave description index

Kataster Gruppe 1623:
Loser Augst-Eck - INDEX

END #Starting to read in csv file, eat header line <>; #While loop which reads in each line of csv file while (<>) { chomp; #get rid of any tabs y/\t/ /; #replace single quotes by double quotes s/\"\"/\"/g; #split one line of csv file into fragments which were seperated by commas my @fields = split(/,/, $_); #print "$_\n"; #print @fields; # turn fragments back into one line, where fields are seperated by \t $_ = "\"\t"; my $statement; foreach $statement (@fields) { #print "$_ z\n"; #print "$statement\n"; if ($_ =~ /\t$/) { if ($statement =~ /^"/) { if ($statement =~ /"$/) { $_ = "$_$statement\t"; } else { $_ = "$_$statement,"; } } else { $_ = "$_\"$statement\"\t"; } } else { if ($statement =~ /"$/) { $_ = "$_$statement\t"; } else { $_ = "$_$statement,"; } } } #print "$_\n\n"; s/"\t"/\t/g; s/\\"/"/g; #print "$_\n\n"; #split single line into all the fields my ($dummy, $kat_num, $kat_status, $ents, $other_number, $mult_ents, $file, $name, $unofficial_name, $comment, $area, $no_info, $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) = split /\t/, $_; #It is an ugly world out here. The last entry does not work the same as the rest so here is a bodge to fix it. if ($marking =~ m/(.*)...$/) { $marking = $1; } else{ $marking=""; } #print "$marking\n"; #generate $number variable to hold kataster no. or other no. then empty other number if both are not present my $number = $kat_num; if ($number eq "") { $number = $other_number; $other_number = ""; } my $e = $ents; $e =~ s/ +/ /g; #print IDXALL "

$number $e

"; print IDXALL "

END if ($other_number ne "") { if ($unofficial_name ne "") { print FILE ""; } else { print FILE ""; } } else { if ($unofficial_name ne "") { print FILE ""; } } print FILE <

END if ($length ne "") { print FILE "Length: $length "; } if ($depth ne "") { print FILE "Depth: $depth "; } if ($extent ne "") { print FILE "Extent: $extent "; } print FILE "\n

\n"; # Entrance specific bit # If there are multiple entrances if($mult_ents eq "yes"){ print FILE "

"; my $e_mult_ents; do{ my $e = <>; chomp; $e =~ y/\t/ /; $e =~ s/\"\"/\"/g; my @fields = split(/,/, $e); #print "$e\n"; #print @fields; $e = "\"\t"; my $statement; foreach $statement (@fields) { #print "$_ z\n"; #print "$statement\n"; if ($e =~ /\t$/) { if ($statement =~ /^"/) { if ($statement =~ /"$/) { $e = "$e$statement\t"; } else { $e = "$e$statement,"; } } else { $e = "$e\"$statement\"\t"; } } else { if ($statement =~ /"$/) { $e = "$e$statement\t"; } else { $e = "$e$statement,"; } } } #print "$e\n\n"; $e =~ s/"\t"/\t/g; $e =~ s/\\"/"/g; #print "$_\n\n"; my ($edummy, $ekat_num, $ekat_status, $eents, $eother_number, $emult_ents, $efile, $ename, $eunofficial_name, $ecomment, $earea, $eno_info, $eexplorers, $eu_description,$eequipment, $eqmlist, $ekatstatus, $ereferences, $eu_centre_line, $eu_drawn_survey, $esurvex_file, $elength, $edepth, $eextent, $eheader, $efooter, $enotes, $eent_name, $etag_punkt, $eother_punkt, $edesc_other_punkt, $eexact_punkt, $efix_type, $egpspresa, $egpspostsa, $enorthing, $eeasting, $ealtitude, $ebearings, $emap, $elocation, $eapproach, $eent_desc, $eent_photo, $emarking) = split /\t/, $e; #It is an ugly world out here. The last entry does not work the same as the rest so here is a bodge to fix it. if ($marking =~ m/(.*)...$/) { $marking = $1; } else{ $marking=""; } my $enumber = $ekat_num; if ($enumber eq "") { $enumber = $eother_number; $eother_number = ""; } print FILE "\n

"; if ($efile ne ""){ print FILE ""; } print FILE "$enumber$eents"; if ($efile ne ""){ print FILE ""; } print FILE " "; # decide which epunkt to quote my $epunkt; if ($etag_punkt ne "") { $epunkt=$etag_punkt; } elsif ($eother_punkt ne "") { $epunkt = $eother_punkt; } elsif ($eexact_punkt ne "") { $epunkt = $eexact_punkt; } else { $epunkt = ""; } #Find the position of that punkt if ($epunkt ne "") { #print "Looking for $epunkt\n"; for my $surveypoint ( @pos ) { #print "b$surveypoint"; #print "e"; if ($surveypoint =~ m/$ *([0-9.\-]*), *([0-9.\-]*), *([0-9.\-]*) $ $epunkt(\r\n|\n|\r)/){ $eeasting=$1; $enorthing=$2; $ealtitude=$3; #print "Found for $epunkt at $eeasting\n"; } } } #Write out info for entrance if ($eent_name ne "") { print FILE "$eent_name"; } if ($ealtitude ne "") { print FILE "Alt: $ealtitude "; } if ($enorthing ne "") { print FILE "N$enorthing "; } if ($eeasting ne "") { print FILE "E$eeasting "; } if ($efix_type ne "") { print FILE "Fix type: $efix_type "; } if ($etag_punkt ne "") { print FILE "Fix position: tag "; } else{ if ($eother_punkt ne "") { if ($edesc_other_punkt ne "") { print FILE "Fix position: $edesc_other_punkt "; } else{ print FILE "Fix position: Do not know "; } } else{ if ($eexact_punkt ne "") { print FILE "Fix position: exact point "; } } } if ($epunkt ne "") { print FILE "Point name: $epunkt "; } if ($egpspresa ne "") { print FILE "GPS pre sa: $egpspresa "; } if ($egpspostsa ne "") { print FILE "GPS pre sa: $egpspostsa "; } $e_mult_ents = $emult_ents; } while($e_mult_ents ne "last entrance"); print FILE "

"; } #If there is only one entrance else{ # decide which punkt to quote my $punkt; if ($tag_punkt ne "") { $punkt=$tag_punkt; } elsif ($other_punkt ne "") { $punkt = $other_punkt; } elsif ($exact_punkt ne "") { $punkt = $exact_punkt; } else { $punkt = ""; } #Find the position of that punkt if ($punkt ne "") { #print "Looking for $punkt\n"; for my $surveypoint ( @pos ) { #print "b$surveypoint"; #print "e"; if ($surveypoint =~ m/$ *([0-9\.\-]*), *([0-9\.\-]*), *([0-9\.\-]*) $ $punkt(\r\n|\n|\r)/){ $easting=$1; $northing=$2; $altitude=$3; #print "Found for $punkt at $easting\n"; } } } #Write out info for entrance if ($ent_name ne "") { print FILE "Entrance Name: $ent_name

"; } if ($altitude ne "") { print FILE "Alt: $altitude "; } if ($northing ne "") { print FILE "N$northing "; } if ($easting ne "") { print FILE "E$easting "; } if ($fix_type ne "") { print FILE "Fix type: $fix_type "; } if ($tag_punkt ne "") { print FILE "Fix position: tag "; } else{ if ($other_punkt ne "") { if ($desc_other_punkt ne "") { print FILE "Fix position: $desc_other_punkt "; } else{ print FILE "Fix position: Do not know "; } } else{ if ($exact_punkt ne "") { print FILE "Fix position: exact point "; } } } if ($punkt ne "") { print FILE "Point name: $punkt "; } if ($gpspresa ne "") { print FILE "GPS pre sa: $gpspresa "; } if ($gpspostsa ne "") { print FILE "GPS pre sa: $gpspostsa "; } } # Cave general bit #print FILE "\n

\n"; if ($location ne "") { print FILE "\n

Location: $location"; } if ($bearings ne "") { print FILE "\n

Bearings: $bearings"; } if ($approach ne "") { print FILE "\n

Approach: $approach"; } if ($map ne "") { print FILE "\n

Map: $map"; } if ($ent_desc ne "") { print FILE "\n

Entrance Description: $ent_desc"; } if ($ent_photo ne "") { print FILE "\n

Entrance Photo: $ent_photo"; } if ($marking ne "") { print FILE "\n

Marking: $marking"; } if ($references ne "") { print FILE "\n

References: $references"; } if ($u_description ne "") { print FILE "\n

Underground Description: $u_description"; } if ($equipment ne "") { print FILE "\n

Equipment: $equipment"; } if ($qmlist ne "") { print FILE "\n

QM list: $qmlist"; } if ($u_drawn_survey ne "") { print FILE "\n

Survey: $u_drawn_survey"; } if ($notes ne "") { print FILE "\n

Notes: $notes"; } if ($explorers ne "") { print FILE "\n

Explorers: $explorers"; } if ($katstatus ne "") { print FILE "\n

Kataster Status: $katstatus"; } if ($u_centre_line ne "") { print FILE "\n

Centre Line: $u_centre_line"; } if ($survex_file ne "") { print FILE "\n

Survex file: $survex_file"; } print FILE "\n

"; print FILE "\n"; if ($footer ne "") { print FILE "\n

$footer"; } my $toroot; $toroot = ""; print "\n$file has no slash"; if ($file =~ /.*\/.*/) { $toroot = "../"; print "one slash"; } if ($file =~ /.*\/.*\/.*/) { $toroot = '../../'; print "two slash"; } if ($file =~ /.*\/.*\/.*\/.*/) { $toroot = '../../../'; } if ($area =~ /(1a|1b|1c|1d)/) { print FILE "\n $\">\"$ "; print FILE "\nPlateau area index and description
"; } if ($area =~ /(2a|2b)/) { print FILE "\n $\">\"$ "; print FILE "\nSchwarzmooskogel ridge area index and description
"; } if ($area =~ /3/) { print FILE "\n $\">\"$ "; print FILE "\nBräuning Alm area index and description
"; } if ($area =~ /4/) { print FILE "\n $\">\"$ "; print FILE "\nKratzer valley index and description
"; } if ($area =~ /5/) { print FILE "\n $\">\"$ "; print FILE "\nSchwarzmoos-Wildensee area index and description
"; } if ($area =~ /6/) { print FILE "\n $\">\"$ "; print FILE "\nFar plateau area index and description
"; } if ($area =~ /7/) { print FILE "\n $\">\"$ "; print FILE "\nEgglgrube area index and description
"; } if ($area =~ /(8a|8b|8c|8d)/) { print FILE "\n $\">\"$ "; print FILE "\nLoser/Augst See area index and description
"; } if ($area =~ /9/) { print FILE "\n $\">\"$ "; print FILE "\nGschwandt area index and description
"; } if ($area =~ /10/) { print FILE "\n $\">\"$ "; print FILE "\nN & NE shore of Altauseer See
"; } if ($area =~ /11/) { print FILE "\n $\">\"$ "; print FILE "\nAugstbach area index and description
"; } print FILE < Full Index
Other Areas
Back to Expedition Intro page END close FILE; } if ($name eq "") { $name = "?"; } if ($file ne "") { print IDXALL ""; } print IDXALL $name; if (length $unofficial_name) { print IDXALL " ($unofficial_name)"; } if (length $other_number) { print IDXALL " ($other_number)"; } if (length $file) { print IDXALL ""; } if (length $comment) { print IDXALL " - $comment"; } #print IDXALL "\n"; print IDXALL "\n"; } print IDXALL <-->

$number $ents	$name	$kat_status
$number $e	"; if ($file ne "") { $number =~ s/\//-/g; $number =~ s/\?/q/; #print "$file\n"; open FILE, ">..\/$file" or die $!; print FILE < END if ($kat_num ne "") { print FILE "1623:$kat_num\n"; } else { print FILE "$number\n"; } print FILE <<END; END print FILE "$header\n"; print FILE <
	= $other_number ($unofficial_name)
	= $other_number
	($unofficial_name)