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;