Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also .

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also .
...
  • 8 commits
  • 8 files changed
  • 0 commit comments
  • 1 contributor
Commits on Apr 17, 2012
@eserte * constructor/factory refactoring in Strassen::Core
  Now there are:
  * new (working as before, really a factory method)
  * new_by_magic (does a magic check instead of a suffix check, works
    only for some types, may return undef)
  * new_by_magic_or_suffix (does a magic check, and if this fails,
    does a fallback to the old filename suffix checks)
  * new_bbd (constructor for just bbd data)
7a503f7
@eserte * gpsman/gpx/kml tests: now with magic tests
  There's also an -all switch for the gpsman test.
2b702a4
@eserte * GpsmanData: fixed a bug in UTM/UPS support 581fc01
@eserte * strassen-gpsman.t: additional test with UTM/UPS data and position
  format changes in file
b755f51
@eserte * Strassen::KML: removed an unused variable d49e362
@eserte * Strassen::Core: new method set_global_directive 2551bdc
@eserte * tests for new set_global_directive 4c0e18b
@eserte * any2bbd: don't use set_global_directives, as it overwrites existing
  global directives

  Rather use the new set_global_directive multiple times.
beae931
Showing with 228 additions and 38 deletions.
  1. +6 −6 GPS/GpsmanData.pm
  2. +42 −1 Strassen/Core.pm
  3. +0 −1 Strassen/KML.pm
  4. +4 −5 miscsrc/any2bbd
  5. +89 −18 t/strassen-gpsman.t
  6. +37 −1 t/strassen-gpx.t
  7. +39 −4 t/strassen-kml.t
  8. +11 −2 t/strassen.t
View
12 GPS/GpsmanData.pm
@@ -445,16 +445,16 @@ sub parse_and_set_coordinate {
# XXX no ParsedLongitude/Latitude support for UTM/UPS yet
my($ze,$zn,$x,$y) = @{$f_ref}[$$f_i_ref .. $$f_i_ref+3];
$$f_i_ref += 4;
- my($lat, $long) = Karte::UTM::UTMToDegrees($ze,$zn,$x,$y,$self->DatumFormat);
- $lat = ($lat >= 0 ? "N" : "S") . abs($lat);
- $long = ($long >= 0 ? "E" : "W") . abs($long);
+ ($lat, $long) = Karte::UTM::UTMToDegrees($ze,$zn,$x,$y,$self->DatumFormat);
+ $lat *= -1 if $lat < 0;
+ $long *= -1 if $long < 0;
} else {
$parsed_lat = $lat = $f_ref->[$$f_i_ref++];
$parsed_long = $long = $f_ref->[$$f_i_ref++];
+ my $converter = $self->CurrentConverter;
+ $lat = $converter->($lat);
+ $long = $converter->($long);
}
- my $converter = $self->CurrentConverter;
- $lat = $converter->($lat);
- $long = $converter->($long);
$obj->Latitude($lat);
$obj->Longitude($long);
$obj->ParsedLatitude($parsed_lat);
View
43 Strassen/Core.pm
@@ -26,7 +26,7 @@ use vars qw(@datadirs $OLD_AGREP $VERBOSE $STRICT $VERSION $can_strassen_storabl
use enum qw(NAME COORDS CAT);
use constant LAST => CAT;
-$VERSION = '1.95';
+$VERSION = '1.96';
if (defined $ENV{BBBIKE_DATADIR}) {
require Config;
@@ -118,6 +118,42 @@ sub new {
}
}
+ $class->new_bbd($filename, %args);
+}
+
+sub new_by_magic_or_suffix {
+ my($class, $filename, %args) = @_;
+ my $ret = $class->new_by_magic($filename, %args);
+ return $ret if $ret;
+ $class->new($filename, %args);
+}
+
+sub new_by_magic {
+ my($class, $filename, %args) = @_;
+ if (defined $filename) {
+ open my $fh, $filename
+ or die "Can't open $filename: $!";
+ read($fh, my($buf), 1024);
+ if ($buf =~ m{<gpx\b}) {
+ require Strassen::GPX;
+ return Strassen::GPX->new($filename, %args);
+ } elsif ($buf =~ m{<kml\b}) {
+ require Strassen::KML;
+ return Strassen::KML->new($filename, %args);
+ } elsif ($buf =~ m{<ttqv\b}) {
+ require Strassen::Touratech;
+ return Strassen::Touratech->new($filename, %args);
+ } elsif ($buf =~ m{^!Format:\s*(DMS|DMM|DDD)}m) {
+ require Strassen::Gpsman;
+ return Strassen::Gpsman->new($filename, %args);
+ }
+ }
+ undef;
+}
+
+sub new_bbd {
+ my($class, $filename, %args) = @_;
+
my(@filenames);
if (defined $filename) {
if (!file_name_is_absolute($filename)) {
@@ -1510,6 +1546,11 @@ sub get_global_directive {
}
}
+sub set_global_directive {
+ my($self, $key, @val) = @_;
+ $self->{GlobalDirectives}->{$key} = [@val];
+}
+
# Note that this sets only the reference; if you want a copy, then
# use Storable::dclone before!
sub set_global_directives {
View
1 Strassen/KML.pm
@@ -54,7 +54,6 @@ sub kml2bbd {
sub _kmldoc2bbd {
my($self, $doc, %args) = @_;
- my $xy2longlat = \&xy2longlat;
my $root = $doc->documentElement;
if ($root->can("setNamespaceDeclURI") && !$TEST_SET_NAMESPACE_DECL_URI_HACK) {
$root->setNamespaceDeclURI(undef, undef);
View
9 miscsrc/any2bbd
@@ -180,11 +180,10 @@ my $ms = MultiStrassen->new(@s);
if ($opt{append}) {
$ms->append($outfile);
} else {
- $ms->set_global_directives({ "category_dash.AccManually" => ["3,8"],
- "category_color.AccManually" => ["#8080c0"],
- "category_dash.AccLow" => ["2,4"],
- "category_color.AccLow" => ["#4040a0"],
- });
+ $ms->set_global_directive("category_dash.AccManually" => "3,8");
+ $ms->set_global_directive("category_color.AccManually" => "#8080c0");
+ $ms->set_global_directive("category_dash.AccLow" => "2,4");
+ $ms->set_global_directive("category_color.AccLow" => "#4040a0");
$ms->write($outfile);
}
View
107 t/strassen-gpsman.t
@@ -2,7 +2,6 @@
# -*- perl -*-
#
-# $Id: strassen-gpsman.t,v 1.10 2008/02/02 22:11:16 eserte Exp $
# Author: Slaven Rezic
#
@@ -11,6 +10,8 @@ use FindBin;
use lib ("$FindBin::RealBin/..",
"$FindBin::RealBin/../lib",
);
+
+use File::Temp qw(tempfile);
use Getopt::Long;
use Strassen::Core;
@@ -34,12 +35,18 @@ BEGIN {
}
}
+sub load_from_string_and_check ($$);
+
my $tests_with_data = 4; # in my private directory
-my $tests = $tests_with_data + 9;
+my $test_do_all = 1;
+my $tests = $tests_with_data + $test_do_all + 36;
plan tests => $tests + $have_nowarnings;
my $gpsman_dir = "$FindBin::RealBin/../misc/gps_data";
-if (!GetOptions("gpsmandir=s" => \$gpsman_dir)) {
+my $do_all;
+if (!GetOptions("gpsmandir=s" => \$gpsman_dir,
+ "all" => \$do_all,
+ )) {
die <<EOF;
usage: $0 [-gpsmandir directory]
EOF
@@ -74,11 +81,30 @@ SKIP: {
#require Data::Dumper; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([$s1, $s2],[qw()])->Indent(1)->Useqq(1)->Dump; # XXX
+ SKIP: {
+ skip("No -all option specified", 1)
+ if !$do_all;
+ my @errors;
+ my $i = 0;
+ for my $gpsmanfile (@trk, @wpt) {
+ my $s_new = Strassen->new($gpsmanfile);
+ my $s_magic = Strassen->new_by_magic($gpsmanfile);
+ if (!$s_new) {
+ push @errors, "$gpsmanfile: new failed";
+ } elsif (!$s_magic) {
+ push @errors, "$gpsmanfile: new_by_magic failed";
+ } elsif (scalar @{$s_magic->data} != scalar @{$s_new->data}) {
+ push @errors, "$gpsmanfile: inconsistent read";
+ }
+ }
+ ok !@errors, "No errors checking all"
+ or diag join("\n", @errors);
+ }
}
-{
- require Strassen::Gpsman; # because maybe nobody did it before!
+require Strassen::Gpsman; # because maybe nobody did it before!
+{
my $trk_sample = <<'EOF';
% Written by /home/e/eserte/src/bbbike/bbbike Wed Dec 28 19:10:26 2005
% Edit at your own risk!
@@ -101,15 +127,11 @@ SKIP: {
31-Dec-1989 01:00:00 N53.0933013449282 E12.8904135187235 0
EOF
- my $s = Strassen::Gpsman->new_from_string($trk_sample);
- isa_ok($s, "Strassen");
- isa_ok($s, "Strassen::Gpsman");
+ my $s = load_from_string_and_check $trk_sample, 'trk';
cmp_ok(scalar(@{$s->data}), "==", 2, "Track sample has two lines");
}
{
- require Strassen::Gpsman; # because maybe nobody did it before!
-
my $wpt_sample = <<'EOF';
% Written by GPSManager 17-Jan-2002 22:35:45 (CET)
% Edit at your own risk!
@@ -122,15 +144,11 @@ EOF
008 N52 30 42.6 E13 24 30.6 alt=33.05078125 GD108:class=|c! GD108:colour=~|Z GD108:attrs=` GD108:depth=QY|c%|_i GD108:state=|cAA GD108:country=|cAA
EOF
- my $s = Strassen::Gpsman->new_from_string($wpt_sample);
- isa_ok($s, "Strassen");
- isa_ok($s, "Strassen::Gpsman");
+ my $s = load_from_string_and_check $wpt_sample, 'wpt';
cmp_ok(scalar(@{$s->data}), "==", 2, "Waypoint sample version one has two objects");
}
{
- require Strassen::Gpsman; # because maybe nobody did it before!
-
my $wpt_sample = <<'EOF';
% Written by GPSManager 2006-07-31 00:21:07 (CET)
% Edit at your own risk!
@@ -142,10 +160,63 @@ EOF
019 30-JUL-06 13:01:35 2006-07-30 23:57:21 N52 31.152 E13 04.405 symbol=crossing alt=42.7 GD109:dtyp=|c" GD109:class=|c! GD109:colour=|c@ GD109:attrs=p GD109:depth=1I|c3% GD109:state=|cAA GD109:country=|cAA GD109:ete=~|R$|Z
020 30-JUL-06 13:05:13 2006-07-30 23:57:21 N52 31.591 E13 04.648 symbol=crossing alt=47.0 GD109:dtyp=|c" GD109:class=|c! GD109:colour=|c@ GD109:attrs=p GD109:depth=1I|c3% GD109:state=|cAA GD109:country=|cAA GD109:ete=~|R$|Z
EOF
- my $s = Strassen::Gpsman->new_from_string($wpt_sample);
- isa_ok($s, "Strassen");
- isa_ok($s, "Strassen::Gpsman");
+ my $s = load_from_string_and_check $wpt_sample, 'wpt';
cmp_ok(scalar(@{$s->data}), "==", 2, "Waypoint sample version two has two objects");
}
+{
+ my $utm_sample = <<'EOF';
+% Written by GPSManager 08-Feb-2002 10:33:19 (CET)
+% Edit at your own risk!
+
+!Format: DMS 1 WGS 84
+!Creation: no
+
+!W:
+392 WILDENBRUCH WEIGANDUFER N52 29 06.2 E13 26 40.1 alt=22.4763183594
+!Position: UTM/UPS
+A2 ALT STRALAU MARKGRAFENDAMM 33 U 395766 5817425
+!Position: DMS
+A3 ELSEN KIEFHOLZ N52 29 21.1 E13 27 14.6 alt=11.6732177734
+
+EOF
+ my $s = load_from_string_and_check $utm_sample, 'wpt';
+ is_deeply $s->data,
+ [
+ "392 (WILDENBRUCH WEIGANDUFER)\tX 13210,8863\n",
+ "A2 (ALT STRALAU MARKGRAFENDAMM)\tX 14548,10215\n",
+ "A3 (ELSEN KIEFHOLZ)\tX 13852,9335\n"
+ ], 'wpt data with PositionFormat change and UTM/UPS usage';
+}
+
+# 8 tests
+sub load_from_string_and_check ($$) {
+ my($data, $type) = @_;
+
+ my $s = Strassen::Gpsman->new_from_string($data);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::Gpsman";
+
+ my($tmpfh,$tmpfile) = tempfile(SUFFIX => '.'.$type, UNLINK => 1)
+ or die $!;
+ print $tmpfh $data or die $!;
+ close $tmpfh;
+
+ {
+ my $s_file = Strassen->new_by_magic($tmpfile);
+ isa_ok $s_file, "Strassen";
+ isa_ok $s_file, "Strassen::Gpsman";
+ is_deeply $s_file->data, $s->data, "Loading $type with magic check";
+ }
+
+ {
+ my $s_file = Strassen->new($tmpfile);
+ isa_ok $s_file, "Strassen";
+ isa_ok $s_file, "Strassen::Gpsman";
+ is_deeply $s_file->data, $s->data, "Loading $type with magic check in factory method";
+ }
+
+ $s;
+}
+
__END__
View
38 t/strassen-gpx.t
@@ -32,11 +32,12 @@ use BBBikeTest qw(gpxlint_string);
use Route;
sub keep_file ($$);
+sub load_from_file_and_check ($$);
my $v;
my @variants = ("XML::LibXML", "XML::Twig");
my $new_strassen_gpx_tests = 5;
-my $tests_per_variant = 70 + $new_strassen_gpx_tests;
+my $tests_per_variant = 88 + $new_strassen_gpx_tests;
my $do_long_tests = !!$ENV{BBBIKE_LONG_TESTS};
my $bbdfile;
my $bbdfile_with_lines = "comments_scenic";
@@ -119,6 +120,8 @@ for my $use_xml_module (@variants) {
$s3->gpx2bbd($ofilename);
is_deeply($s3->data, $s->data, "File loading OK");
+ load_from_file_and_check $ofilename, $s3;
+
# Parsing from string, overriding name and cat
my $s4 = Strassen::GPX->new;
$s4->gpxdata2bbd($gpx_sample, name => "My Name", cat => "MYCAT");
@@ -162,6 +165,8 @@ for my $use_xml_module (@variants) {
$s3->gpx2bbd($ofilename);
is_deeply($s->data, $s3->data, "File loading OK");
+ load_from_file_and_check $ofilename, $s3;
+
# Parsing from string, overriding name and cat
my $s4 = Strassen::GPX->new;
$s4->gpxdata2bbd($gpx_sample, name => "My Name", cat => "MYCAT");
@@ -558,4 +563,35 @@ sub keep_file ($$) {
}
}
+# 9 tests
+# Try the different constructor variants
+sub load_from_file_and_check ($$) {
+ my($gpxfile, $check_against) = @_;
+
+ my $s_gpx = do {
+ my $s = Strassen::GPX->new($gpxfile);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::GPX";
+ $s;
+ };
+
+ my $s = do {
+ my $s = Strassen->new($gpxfile);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::GPX";
+ $s;
+ };
+
+ my $s_magic = do {
+ my $s = Strassen->new_by_magic($gpxfile);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::GPX";
+ $s;
+ };
+
+ is_deeply $s->data, $check_against->data, "Loading gpx with factory";
+ is_deeply $s_gpx->data, $check_against->data, "Loading gpx explicitely with Strassen::GPX";
+ is_deeply $s_magic->data, $check_against->data, "Loading gpx with magic check";
+}
+
__END__
View
43 t/strassen-kml.t
@@ -31,7 +31,9 @@ BEGIN {
use BBBikeTest;
-plan tests => 32;
+sub load_from_file_and_check ($);
+
+plan tests => 54;
use_ok("Strassen::KML")
or exit 1; # avoid recursive calls to Strassen::new
@@ -77,9 +79,7 @@ isa_ok($s, "Strassen");
}
ok(!@errors, "Coordinates within tolerance after roundtrip");
- my $s0 = Strassen->new($file);
- isa_ok($s, "Strassen", ".kml detection in Strassen::Core seems OK");
- is_deeply($s0->data, $s->data, "No difference between Strassen and Strassen::KML loading");
+ load_from_file_and_check $file;
}
{
@@ -96,6 +96,8 @@ isa_ok($s, "Strassen");
isa_ok($s, "Strassen", "File <$file> loaded OK");
my @data = @{ $s->data };
is($data[0], "Tour\tX @sample_coords\n", "Expected translated coordinates with namespace decl hack");
+
+ load_from_file_and_check $file;
}
{
@@ -108,6 +110,8 @@ isa_ok($s, "Strassen");
isa_ok($s, "Strassen", "File <$tmpfile> loaded OK");
my @data = @{ $s->data };
is_deeply \@data, \@sample_data;
+
+ load_from_file_and_check $tmpfile;
}
for my $kml_filename ('doc.kml',
@@ -272,4 +276,35 @@ sub get_sample_data_polygons {
("Mitte X 8294,13544 8298,13544 8310,13522 8305,13513\n");
}
+# 8 tests
+sub load_from_file_and_check ($) {
+ my($filename) = @_;
+
+ my $s_kml = do {
+ my $s = Strassen::KML->new($filename);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::KML";
+ $s;
+ };
+
+ my $s_magic = do {
+ my $s = Strassen->new_by_magic($filename);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::KML";
+ $s;
+ };
+
+ my $s = do {
+ my $s = Strassen->new($filename);
+ isa_ok $s, "Strassen";
+ isa_ok $s, "Strassen::KML";
+ $s;
+ };
+
+ is_deeply $s->data, $s_kml->data, 'Strassen and Strassen::KML loading';
+ is_deeply $s_magic->data, $s_kml->data, 'magic check';
+
+ $s_kml;
+}
+
__END__
View
13 t/strassen.t
@@ -46,8 +46,9 @@ my $zebrastreifen_tests = 3;
my $encoding_tests = 10;
my $multistrassen_tests = 11;
my $initless_tests = 3;
+my $global_directive_tests = 3;
-plan tests => $basic_tests + $doit_tests + $strassen_orig_tests + $zebrastreifen_tests + $encoding_tests + $multistrassen_tests + $initless_tests;
+plan tests => $basic_tests + $doit_tests + $strassen_orig_tests + $zebrastreifen_tests + $encoding_tests + $multistrassen_tests + $initless_tests + $global_directive_tests;
goto XXX if $do_xxx;
@@ -514,6 +515,14 @@ EOF
my $s2 = Strassen->new_from_data_string($data2, UseLocalDirectives => 1);
is_deeply(\@warnings, [], 'No warnings in complicated nested case');
}
-
+
+{ # $global_directive_tests
+ my $s = Strassen->new;
+ $s->set_global_directive('some' => 'thing');
+ is $s->get_global_directive('some'), 'thing', 'set/get global directive';
+ $s->set_global_directive('some' => 'thing', 'else');
+ is $s->get_global_directive('some'), 'thing', 'after setting multiple values';
+ is_deeply $s->get_global_directives, { some => [qw(thing else)] }, 'get_global_directives';
+}
__END__

No commit comments for this range

Something went wrong with that request. Please try again.