Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* new BBBikeUtil function sort_german

  The function is used in bbbike's choose_ort and replaces the old
  sort function there. Test cases are in bbbikeutil.t, for German-only
  and mixed German/Polish/Czech names.
  • Loading branch information...
commit 3a9ca6c6f70a31121ab38d02c2047dc53371fc5a 1 parent 7eab454
@eserte authored
Showing with 82 additions and 7 deletions.
  1. +18 −0 BBBikeUtil.pm
  2. +1 −6 bbbike
  3. +63 −1 t/bbbikeutil.t
View
18 BBBikeUtil.pm
@@ -327,6 +327,11 @@ BEGIN {
%uml_german_locale = ('ä' => 'a', 'ö' => 'o', 'ü' => 'u', 'ß' => 'ss',
'Ä' => 'A', 'Ö' => 'O', 'Ü' => 'U',
'é' => 'e', 'è' => 'e', 'ë' => 'e', 'á' => 'a',
+ # some Polish and Czech characters appearing in the bbbike data set
+ # XXX better to use Text::Unidecode maybe?
+ "\x{00DA}" => 'U', "\x{0141}" => 'L', "\x{015A}" => 'S',
+ "\x{0142}" => 'l', "\x{0105}" => 'a',
+ "\x{011B}" => 'e', "\x{0119}" => 'e', "\x{00F3}" => 'o',
);
$uml_german_locale_keys = join("",keys %uml_german_locale);
$uml_german_locale_keys_rx = qr{[$uml_german_locale_keys]};
@@ -349,6 +354,19 @@ sub umlauts_to_german {
$s;
}
+sub sort_german {
+ my($arr_ref) = @_;
+ map { $_->[1] }
+ sort { $a->[0] cmp $b->[0] }
+ map {
+ [ do {
+ my $val = lc umlauts_for_german_locale($_);
+ $val =~ s{[\(\)\"\.]}{}g;
+ $val;
+ }, $_]
+ } @$arr_ref;
+}
+
BEGIN {
if (eval { require Storable; $Storable::VERSION >= 2 }) { # need the ability to clone CODE items XXX determine correct Storable version
*clone = sub ($) {
View
7 bbbike
@@ -12148,12 +12148,7 @@ sub choose_ort {
# - the german locale may be missing
# - with various perl versions and OSes I had in the
# past problems with "use locale"
- my $tf_sub = \&BBBikeUtil::umlauts_for_german_locale;
- $lb->insert('end',
- map { $_->[1] }
- sort { $a->[0] cmp $b->[0] }
- map { [ do { /^\(?(.*)/; $tf_sub->($1) }, $_] }
- keys %orte);
+ $lb->insert('end', BBBikeUtil::sort_german([ keys %orte ]));
}
}
View
64 t/bbbikeutil.t
@@ -1,11 +1,12 @@
#!/usr/bin/perl -w
-# -*- perl -*-
+# -*- mode:cperl;coding:utf-8 -*-
#
# Author: Slaven Rezic
#
use strict;
+use utf8;
use FindBin;
use lib "$FindBin::RealBin/..";
@@ -77,4 +78,65 @@ is($bbbike_root, realpath(dirname(dirname(realpath($0)))), "Expected value for b
is $dir, 'l', 'left turn';
}
+{
+ # This list is already sorted
+ my @test = (
+ 'Aachener Str.',
+ '(am Bundeskanzleramt)',
+ '(A.T.U-Einfahrt - ALDI-Parkplatz)',
+ 'Brommystr.',
+ 'Bröndbystr.',
+ 'Brontëweg',
+ 'Brook-Taylor-Str.',
+ 'Brösener Str.',
+ 'Brotteroder Str.',
+ 'Grünberger Str.',
+ '("Grünes Band")',
+ 'Oschatzer Ring',
+ 'Öschelbronner Weg',
+ 'Osdorfer Str.',
+ 'Zwischen den Giebeln',
+ );
+
+ {
+ my @res = BBBikeUtil::sort_german(\@test);
+ is_deeply \@res, \@test, 'sort_german';
+ }
+
+ {
+ my @rev_test = reverse @test;
+ my @res = BBBikeUtil::sort_german(\@test);
+ is_deeply \@res, \@test, 'sort_german (2)';
+ }
+}
+
+{
+ my @test_with_polish = (
+ 'Dąbie',
+ 'Dabrun',
+ 'Dechtow',
+ 'Děčín',
+ 'Dyrotz',
+ 'Górzyca',
+ 'Gosen',
+ 'Leitzkau',
+ 'Łęknica',
+ 'Lemmersdorf',
+ 'Sieversdorf b. Neustadt',
+ 'Słońsk',
+ 'Słubice',
+ 'Summt',
+ 'Świnoujście',
+ 'Szczecin',
+ 'Usedom',
+ 'Ústí nad Labem',
+ 'Ützdorf',
+ 'Vehlefanz',
+ );
+ {
+ my @res = BBBikeUtil::sort_german(\@test_with_polish);
+ is_deeply \@res, \@test_with_polish, 'sort_german (with some Polish characters)';
+ }
+}
+
__END__
Please sign in to comment.
Something went wrong with that request. Please try again.