source: trunk/npemap.org.uk/scripts/tile-processing/countSheets.pl @ 712

Last change on this file since 712 was 712, checked in by Nick Burch, 11 years ago

Per-decade support in tile scripts

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 2.6 KB
Line 
1#!/usr/bin/perl
2#
3# Copyright (c) 2006-2007 David Sheldon and Nick Burch
4# Permission is hereby granted, free of charge, to any person obtaining a
5# copy of this software and associated documentation files (the "Software"),
6# to deal in the Software without restriction, including without limitation
7# the rights to use, copy, modify, merge, publish, distribute, sublicense,
8# and/or sell copies of the Software, and to permit persons to whom the
9# Software is furnished to do so, subject to the following conditions:
10#
11# The above copyright notice and this permission notice shall be included in
12# all copies or substantial portions of the Software.
13#
14# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
17# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20# IN THE SOFTWARE.
21#
22#
23# This script reports how many different sheets were used for each
24#  decade
25#
26use List::Util qw[min max];
27use strict;
28
29foreach my $decade (1900, 1910, 1920, 1930, 1940, 1950, 1960) {
30    print "For the ${decade}s\n";
31
32    my $decade_match = substr($decade,0,3)."?";
33    my $dir_glob = "*-tiles-$decade_match";
34    #print "\tFiles come from $dir_glob\n";
35
36    my %sheets = ();
37    my %tiles = ();
38    my @files = glob("$dir_glob/tile-*.jpg");
39
40    # Sort the tiles by directory name
41    # (If we have two copies of the same tile, we want the newest one)
42    @files = sort {
43        my ($adate) = ($a =~ /^.*?\-(\d\d\d\d)\//);
44        my ($bdate) = ($b =~ /^.*?\-(\d\d\d\d)\//);
45        if(!$adate && !$bdate) { return $a cmp $b; }
46        if($adate && !$bdate) { return 1; }
47        if($bdate && !$adate) { return -1; }
48        return $adate <=> $bdate;
49    } @files;
50
51    # Process the files into a hash, based on easting and northing
52    foreach my $f (@files) {
53      $f =~ m/-(\d+)-(\-?\d+)\./;
54      my ($x, $y) = ($1 +0, $2 +0);
55      $tiles{$x} ||= {};
56      $tiles{$x}{$y} = $f;
57    }
58
59    # Now see what sheets (directories) we found
60    foreach my $x (keys %tiles) {
61        foreach my $y (keys %{$tiles{$x}}) {
62            my $f = $tiles{$x}{$y};
63            my ($dir) = ($f =~ /^(.*?-tiles-\d+)\//);
64
65            unless($sheets{$dir}) {
66                #print "$dir\n";
67                $sheets{$dir} = $dir;
68            }
69        }
70    }
71
72    # Summarise
73    my @s = keys %sheets;
74    print "\t".(scalar @s)." sheet directories present\n";
75}
76exit;
Note: See TracBrowser for help on using the repository browser.