test-bucket.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:57 2010 from test-bucket.pl 2009/03/25 3.8 KB.

# Testing my Bucket.pm
# 11/03/2009 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use Bucket; # see Bucket.pm
my ($bucket);
my $add_del_test = 0;
my $show_blank_bucket = 0;
my %bucket_pos = ( 0 => 'BL',
   1 => 'BC',
   2 => 'BR',
   3 => 'CR',
   4 => 'TR',
   5 => 'TC',
   6 => 'TL',
   7 => 'CL' );
sub prt($) {
   print shift;
}
sub show_bucket($$) {
   my ($b, $flag) = @_;
   my ($lon, $lat);
   prt( "Bucket lon:lat:x:y:base_path/index =\n" ) if ($flag & 2);
   prt( $b->bucket_info()."\n" );
   if ($flag & 1) {
      prt( "Bucket Corners:\n" );
      for (my $i = 0; $i < 4; $i++) {
         ($lon,$lat) = $b->get_corner($i);
         prt( "$i:" );
         if ($i == 0) {
            prt( "BL" );
         } elsif ($i == 1) {
            prt( "BR" );
         } elsif ($i == 2 ) {
            prt( "TR" );
         } else {
            prt( "TL" );
         }
         prt( ": $lon,$lat\n" );
      }
   }
}
$bucket = Bucket->new();   # constructor
if ($show_blank_bucket) {
   prt( "Blank bucket\n" );
   show_bucket($bucket, 0);
}
prt( "Lon,lat,x,y = 150:-30:0:0\n" );
$bucket->lon(150);    # set 'lon'
$bucket->lat(-30);    # set 'lat'
$bucket->get_x(0);    # 'x'
$bucket->get_y(0);    # 'y'
show_bucket($bucket, 3);
prt( "Lon,lat,x,y = 150:-30:1:2\n" );
$bucket->lon(150);    # set 'lon'
$bucket->lat(-30);    # set 'lat'
$bucket->get_x(1);    # 'x'
$bucket->get_y(2);    # 'y'
show_bucket($bucket, 3);
prt( "Lon,lat = 151.5:-30.234\n" );
$bucket->set_bucket(151.5, -31.234);
show_bucket($bucket, 1);
my @all_buckets = ();
my ($i, $j);
my ($b1, $b2);
prt( "Set of adjoining buckets:\n" );
for ($i = 0; $i < 8; $i++) {
   my $nb = $bucket->get_next_bucket($i);
   prt ( $i.":".$bucket_pos{$i}.": " );
   show_bucket($nb, 0);
   if ( $bucket->buckets_equal($bucket, $nb) ) {
      prt( "ERROR: These look equal???\n" );
   }
   push( @all_buckets, [$nb, $i] );
}
# test/check ALL the buckets on the adjoining corners
my $berrors = 0;
my $bcnt = scalar @all_buckets;
for ($i = 0; $i < $bcnt; $i++) {
   $b1 = $all_buckets[$i][0];
   my $bi = $b1->gen_index(); # get the INDEX
   $bucket->set_bucket_per_index($bi);
   if ( ! $bucket->buckets_equal( $b1, $bucket ) ) {
      prt( "YIKES: They do not look equal???\n" );
      show_bucket($b1, 0);
      show_bucket($bucket, 0);
      $berrors++;
   }
   for ($j = 0; $j < $bcnt; $j++) {
      $b2 = $all_buckets[$j][0];
      if ($i == $j) {
         if ( !( $bucket->buckets_equal($b1, $b2) == 1 ) ) {
            prt( "YIKES: They do not look equal???\n" );
            show_bucket($b1, 0);
            show_bucket($b2, 0);
            $berrors++;
         }
      } else {
         if ( $bucket->buckets_equal($b1, $b2) == 1 ) {
            prt( "$i:$j: YIKES: They LOOK equal??? - ".$all_buckets[$i][1].":".$all_buckets[$j][1]."\n" );
            show_bucket($b1, 0);
            show_bucket($b2, 0);
            $berrors++;
         }
      }
   }
}
if ($berrors) {
   prt( "ERRORS: Got $berrors, in testing adjoining...\n" );
} else {
   prt( "Got no errors, in testing adjoining...\n" );
}
prt( "San Francisco KSFO lat,lon 37.6208607739872,-122.381074803838 is -\n" );
$bucket->set_bucket(-122.381074803838, 37.6208607739872);
show_bucket($bucket, 1);
prt( "CYYT ST JOHNS INTL (47.6198919333333,-52.7459404666667) tile=w050n40\n" );
$bucket->set_bucket(-52.7459404666667, 47.6198919333333);
show_bucket($bucket, 1);
if ($add_del_test) {
   my %test = ( 'lat' => -30, 'lon' => 150 );
   my ($key,$val);
   foreach $key (keys %test) {
      $val = $test{$key};
      prt( "$key = $val\n" );
   }
   delete $test{'lat'};
   foreach $key (keys %test) {
      $val = $test{$key};
      prt( "$key = $val\n" );
   }
}
exit 0;

index -|- top

checked by tidy  Valid HTML 4.01 Transitional