mirror of
https://expo.survex.com/repositories/expoweb/.git/
synced 2024-11-22 15:21:55 +00:00
178 lines
5.0 KiB
Perl
178 lines
5.0 KiB
Perl
|
#!/usr/bin/perl -w
|
||
|
|
use strict;
|
||
|
|
use Getopt::Long;
|
||
|
|
|
||
|
|
# sort algorithm on png entries should be improved. but then, shouldn't they always.
|
||
|
|
|
||
|
|
((my $progname = $0) =~ s/^.*(\/|\\)//ig); # basename $0
|
||
|
|
|
||
|
|
# Parse options
|
||
|
|
my $no_verbose_progress = 0;
|
||
|
|
my $usage = 0;
|
||
|
|
my $thisyear = 0;
|
||
|
|
GetOptions('quiet' => \$no_verbose_progress, # be quiet
|
||
|
|
'help|?' => \$usage, # help!
|
||
|
|
'thisyear' => \$thisyear # this year's stuff only
|
||
|
|
);
|
||
|
|
|
||
|
|
# Print usage
|
||
|
|
if ($usage) {
|
||
|
|
usage();
|
||
|
|
}
|
||
|
|
|
||
|
|
unless ($ARGV[0]) {
|
||
|
|
print "Specify a CSV file name as the program's argument (e.g. Surveys.csv)\n";
|
||
|
|
usage();
|
||
|
|
}
|
||
|
|
|
||
|
|
open (CSV, "< $ARGV[0]");
|
||
|
|
|
||
|
|
# Start writing table file, and write table header
|
||
|
|
open TABLE, "> surveytable.html" or die $!;
|
||
|
|
print TABLE << "END";
|
||
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0//EN">
|
||
|
|
<!-- *** This file is auto-generated by $progname - edit surveys.csv instead -->
|
||
|
|
<html lang="en">
|
||
|
|
|
||
|
|
<head>
|
||
|
|
<title>Austrian surveying status</title>
|
||
|
|
<style type="text/css">
|
||
|
|
tr.done { background-color: #dfd }
|
||
|
|
tr.notdone { background-color: #f88}
|
||
|
|
</style>
|
||
|
|
</head>
|
||
|
|
|
||
|
|
<body>
|
||
|
|
|
||
|
|
<h1>Austrian Survey Status Sheet</h1>
|
||
|
|
<FONT SIZE="-3">
|
||
|
|
<table border=1>
|
||
|
|
END
|
||
|
|
|
||
|
|
<CSV>; # starting to read in csv file, eat header line
|
||
|
|
|
||
|
|
my ($year, $surveyno, $date, $cave_surf, $caveno, $cave_name, $location, $svx_file, $instruments, $tape, $notes, $photos, $comments, $finished, $sketch_wo_CL);
|
||
|
|
my ($newsurveyno, @dir, @plans, @notesimg, @elev, @misc);
|
||
|
|
print "Progress: *";
|
||
|
|
|
||
|
|
# While loop which reads in each line of csv file
|
||
|
|
|
||
|
|
#$n allows the title of the table to be displayed every 10 lines
|
||
|
|
my $n=0;
|
||
|
|
while (<CSV>) {
|
||
|
|
chomp;
|
||
|
|
# Split single line into all the fields
|
||
|
|
($year, $surveyno, $date, $cave_surf, $caveno, $cave_name, $location, $svx_file, $instruments, $tape, $notes, $photos, $comments, $finished, $sketch_wo_CL) = &parse_csv($_);
|
||
|
|
|
||
|
|
# Last field of CSV file can have weird form-feeds etc. Kill them
|
||
|
|
$sketch_wo_CL =~ s/\r//;
|
||
|
|
|
||
|
|
# Make survey number pure numeric. Pad numbers less than 10 with a zero
|
||
|
|
#$surveyno =~ s/[a-zA-Z]//g;
|
||
|
|
$newsurveyno = $surveyno;
|
||
|
|
if ($surveyno < 10) {
|
||
|
|
$newsurveyno = join("", "0", $surveyno);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($thisyear && ($year ne 2006))
|
||
|
|
{
|
||
|
|
next;
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# Get the directory contents, do a numeric sort on the files
|
||
|
|
if (opendir(DIR, "${year}/${year}#$newsurveyno")) {
|
||
|
|
@dir = sort numericsort grep(!/CVS/ && !/^\./, readdir(DIR));
|
||
|
|
# HTMLize the files
|
||
|
|
foreach ($_, @dir) {
|
||
|
|
my $href = "<a href=\"${year}\/${year}\#$newsurveyno\/$_\">";
|
||
|
|
$href =~ s/#/%23/g;
|
||
|
|
$_ = join('', $href, "$_<\/a><br>");
|
||
|
|
}
|
||
|
|
# Split the files into their respective categories
|
||
|
|
@plans = grep(/plan/i, @dir);
|
||
|
|
@notesimg = grep(/notes/i, @dir);
|
||
|
|
@elev = grep(/elev/i || /extend/i, @dir);
|
||
|
|
@misc = grep(!/plan/i && !/notes/i && !/extend/i && !/elev/i, @dir);
|
||
|
|
} else {
|
||
|
|
# Directory for this survey does not exist
|
||
|
|
unless ($no_verbose_progress) {
|
||
|
|
print "\nWarning: ${year}/${year}#$newsurveyno does not exist ";
|
||
|
|
}
|
||
|
|
(@plans, @notesimg, @elev, @misc) = undef;
|
||
|
|
($plans[0], $notesimg[0], $elev[0], $misc[0]) = ("<b>Survey</b>", "<b>directory</b>", "<b>does not</b>", "<b>exist</b>");
|
||
|
|
}
|
||
|
|
|
||
|
|
closedir(DIR);
|
||
|
|
|
||
|
|
my $done = (($finished eq "Yes" and "done") or "notdone");
|
||
|
|
# Write line out to table
|
||
|
|
if (($n++) %10 == 0){
|
||
|
|
print TABLE "<tr align=\"center\"><th>Year</th><th>Survey Number</th><th>Date</th><th>Cave/Surface</th><th>Cave Number</th><th>Cave Name</th><th>Location</th><th>Survex file</th><th>Instruments</th><th>Tape</th><th>Notes</th><th>Photos</th><th>Comments</th><th>Finished</th><th>Sketches without centre lines</th><th>Plans</th><th>Notes</th><th>*elev* and *extend</th><th>Anything else</th></tr>"
|
||
|
|
}
|
||
|
|
print TABLE "<tr class=\"$done\" align=\"center\"><td>$year</td><td>$surveyno</td><td>$date</td><td>$cave_surf</td>";
|
||
|
|
print TABLE "<td>$caveno</td><td>$cave_name</td><td>$location</td><td>$svx_file</td><td>$instruments</td>";
|
||
|
|
print TABLE "<td>$tape</td><td>$notes</td><td>$photos</td><td>$comments</td><td>$finished</td>";
|
||
|
|
print TABLE "<td>$sketch_wo_CL</td><td>@plans</td><td>@notesimg</td><td>@elev</td><td>@misc</td></tr>\n";
|
||
|
|
print "*";
|
||
|
|
}
|
||
|
|
|
||
|
|
print TABLE << "END";
|
||
|
|
</table>
|
||
|
|
</FONT>
|
||
|
|
</body>
|
||
|
|
</html>
|
||
|
|
END
|
||
|
|
|
||
|
|
close TABLE;
|
||
|
|
print "\nInformation: Done\n";
|
||
|
|
|
||
|
|
# Parse the CSV file
|
||
|
|
sub parse_csv {
|
||
|
|
my $line = $_[0];
|
||
|
|
my @parsedline = ();
|
||
|
|
my $field = '';
|
||
|
|
|
||
|
|
while ($line =~ m{ \G(?:^|[,\t])
|
||
|
|
(?: "((?> [^"]*) (?> "" [^"]*)*)" | ([^"\t,]*)) }gx) {
|
||
|
|
if ($2) {
|
||
|
|
$field = $2;
|
||
|
|
} elsif ($1) {
|
||
|
|
$field = $1;
|
||
|
|
$field =~ s/""/"/g;
|
||
|
|
} else {
|
||
|
|
$field = '';
|
||
|
|
}
|
||
|
|
|
||
|
|
push(@parsedline, $field);
|
||
|
|
}
|
||
|
|
|
||
|
|
return(@parsedline);
|
||
|
|
}
|
||
|
|
|
||
|
|
# A singularly crap numeric sort
|
||
|
|
sub numericsort {
|
||
|
|
my ($moda, $modb);
|
||
|
|
$moda = $a;
|
||
|
|
$modb = $b;
|
||
|
|
# remove alpha characters, ".", "#" "_" and "-" to enable filenames to be purely numeric (hopefully)
|
||
|
|
$moda =~ s/[a-zA-Z\.\\_#-]//g;
|
||
|
|
$modb =~ s/[a-zA-Z\.\\_#-]//g;
|
||
|
|
if ($moda and $modb) {
|
||
|
|
$moda <=> $modb;
|
||
|
|
} else {
|
||
|
|
# No characters left (no numerics chars in filename. Who cares where it ends up in search order.
|
||
|
|
0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Usage
|
||
|
|
sub usage {
|
||
|
|
print << "EOF";
|
||
|
|
USAGE: $progname [-options] <CSV file>
|
||
|
|
-q, --quiet Be quiet about progress
|
||
|
|
-h, --help Show this message
|
||
|
|
EOF
|
||
|
|
exit(0);
|
||
|
|
}
|