fixed rt.cpan.org#119714 rt.cpan.org#120563 and #1. Now using the XML API, fixed DB_File loading

Changelog

@@ -1,3 +1,11 @@
+2.00:
+
+Fixed rt.cpan.org#119714 rt.cpan.org#120563 and https://github.com/TLINDEN/leo/pull/1:
+We're now implementing the XML interface, since the HTML interface
+is no longer available. Many thanks to Roland Hieber for the help!
+
+Fixed DB_File loading, now more portable.
+
 1.45:
 
 fixed rt.cpan.org#118472.

Org.pm

@@ -1,5 +1,5 @@
 #
-# Copyleft (l) 2000-2016 Thomas v.D. <tlinden@cpan.org>.
+# Copyleft (l) 2000-2017 Thomas v.D. <tlinden@cpan.org>.
 #
 # leo may be
 # used and distributed under the terms of the GNU General Public License.
@@ -7,7 +7,7 @@
 # or service marks of their respective holders.
 
 package WWW::Dict::Leo::Org;
-$WWW::Dict::Leo::Org::VERSION = "1.45";
+$WWW::Dict::Leo::Org::VERSION = "2.00";
 
 use strict;
 use warnings;
@@ -33,9 +33,6 @@ sub new {
                          "-ProxyUser"      => "",
                          "-ProxyPass"      => "",
                          "-Debug"          => 0,
-                         "-SpellTolerance" => "standard",  # on, off
-                         "-Morphology"     => "standard",      # none, forcedAll
-                         "-CharTolerance"  => "relaxed",    # fuzzy, exact
                          "-Language"       => "en",           # en2de, de2fr, fr2de, de2es, es2de
                          "data"            => {}, # the results
                          "section"         => [],
@@ -228,35 +225,12 @@ Accept-Language: en_US, en\r\n);
   $from_lang = substr $lang{speak}, 0, 2;
   $to_lang   = substr $lang{speak}, 2, 2;
 
-  # parse all the <word>s and build a string
-  sub parse_word($) {
-    my $word = shift;
-    if (ref $word eq "HASH") {
-      if ($word->{content}) {
-        return encode('UTF-8', $word->{content});
-      }
-      elsif ($word->{cc}) {
-        # chinese simplified, traditional and pinyin
-        return encode('UTF-8', $word->{cc}->{cs}->{content} . "[" .
-          $word->{cc}->{ct}->{content} . "] " .
-          $word->{cc}->{pa}->{content});
-      }
-    }
-    elsif (ref $word eq "ARRAY") {
-      return encode('UTF-8', @{$word}[-1]->{content});
-    }
-    else {
-      return encode('UTF-8', $word);
-    }
-  }
-
-
   foreach my $section (@{$data->{sectionlist}->{section}}) {
     my @entries;
     foreach my $entry (@{$section->{entry}}) {
 
-      my $left   = parse_word $entry->{side}->{$from_lang}->{words}->{word};
+      my $left   = $this->parse_word($entry->{side}->{$from_lang}->{words}->{word});
-      my $right  = parse_word $entry->{side}->{$to_lang}->{words}->{word};
+      my $right  = $this->parse_word($entry->{side}->{$to_lang}->{words}->{word});
 
       push @entries, { left => $left, right => $right };
       if ($this->{Maxsize} < length($left)) {
@@ -265,14 +239,37 @@ Accept-Language: en_US, en\r\n);
       $this->{Linecount}++;
     }
     push @matches, {
-      title => encode('UTF-8', $section->{sctTitle}),
+                    title => encode('UTF-8', $section->{sctTitle}),
-      data => \@entries
+                    data => \@entries
-    };
+                   };
   }
 
   return @matches;
 }
 
+# parse all the <word>s and build a string
+sub parse_word {
+  my ($this, $word) = @_;
+  if (ref $word eq "HASH") {
+    if ($word->{content}) {
+      return encode('UTF-8', $word->{content});
+    }
+    elsif ($word->{cc}) {
+      # chinese simplified, traditional and pinyin
+      return encode('UTF-8', $word->{cc}->{cs}->{content} . "[" .
+                    $word->{cc}->{ct}->{content} . "] " .
+                    $word->{cc}->{pa}->{content});
+    }
+  }
+  elsif (ref $word eq "ARRAY") {
+    # FIXME: include alternatives, if any
+    return encode('UTF-8', @{$word}[-1]->{content});
+  }
+  else {
+    return encode('UTF-8', $word);
+  }
+}
+
 sub grapheme_length {
   my($this, $str) = @_;
   my $count = 0;
@@ -479,7 +476,7 @@ L<leo>
 
 =head1 COPYRIGHT
 
-WWW::Dict::Leo::Org - Copyright (c) 2007-2016 by Thomas v.D.
+WWW::Dict::Leo::Org - Copyright (c) 2007-2017 by Thomas v.D.
 
 L<http://dict.leo.org/> -
 Copyright (c) 1995-2016 LEO Dictionary Team.
@@ -496,6 +493,6 @@ Please don't forget to add debugging output!
 
 =head1 VERSION
 
-  1.45
+  2.00
 
 =cut

leo

@@ -8,7 +8,7 @@
 # the term to be translated. It will then return the results in
 # an unformatted form.
 #
-# Copyleft (l) 2000-2016 by Thomas v.D. <tlinden@cpan.org>. leo may be
+# Copyleft (l) 2000-2017 by Thomas v.D. <tlinden@cpan.org>. leo may be
 # used and distributed under the terms of the GNU General Public License.
 # All other brand and product names are trademarks, registered trademarks
 # or service marks of their respective holders.
@@ -19,7 +19,6 @@ use utf8;
 
 use strict;
 use Getopt::Long;
-use DB_File;
 use POSIX qw(isatty);
 use WWW::Dict::Leo::Org;
 use Data::Dumper;
@@ -34,7 +33,7 @@ my $default_c = "\033[0m";    # reset default terminal color
 my $bold_c    = "\033[0;34m"; # blue color
 my $copy_c    = "\033[0;35m"; # copyright message color (green)
 
-my $version   = "1.43";
+my $version   = "2.00";
 my $config    = $ENV{HOME} . "/.leo";
 my $cache     = $ENV{HOME} . "/.leo-CACHE.db";
 
@@ -154,12 +153,15 @@ elsif ($conf{use_color} eq "yes") {
 # open the cache, if wanted
 #
 if ($conf{use_cache} eq "yes") {
-  eval { require DB_FileX; };
+  $conf{use_cache} = "no";
-  if ($@) {
+  no strict 'subs';
-    $conf{use_cache} = "no";
+  foreach my $M (qw(DB_File NDBM_File GDBM_File)) {
-  }
+    eval { require $M; };
-  else {
+    if (! $@) {
-    dbmopen(%CACHE, $cache, 0600) or $conf{use_cache} = "no";
+      tie(%CACHE, $M, $cache, O_RDWR|O_CREAT, 0600) or $conf{use_cache} = "no";
+      $conf{use_cache} = "yes";
+      last;
+    }
   }
 }
 
@@ -299,8 +301,8 @@ foreach my $section (@match) {
 
 print "$copy_c" if $highlight;
 print "\n     Fetched by leo $version via http://dict.leo.org/";
-print "\n     Copyright (C) LEO  Dictionary Team 1995-2016";
+print "\n     Copyright (C) LEO  Dictionary Team 1995-2017";
-print "\n     [leo] GPL Copyleft   Thomas v.D. 2000-2016\n\n";
+print "\n     [leo] GPL Copyleft   Thomas v.D. 2000-2017\n\n";
 print "$default_c" if $highlight;
 
 
@@ -326,10 +328,7 @@ sub usage {
   print qq(Usage:   $me [-slmcfuphdv] [<term>]
 Translate a term from german to english or vice versa.
 
-  -s, --spelltolerance=on|off                   allow spelling errors
+-l, --language=[de2]<countrycode>[2de]        translation direction
-  -m, --morphology=none|forcedAll               provide morphology information
-  -c, --chartolerance=fuzzy|exact               allow umlaut alternatives
-  -l, --language=[de2]<countrycode>[2de]        translation direction
 -n, --noescapechars                           dont use escapes for highlighting
 -f, --force                                   don't use the query cache
 -u, --user=username                           user for proxy authentication
@@ -350,15 +349,15 @@ pt    portuguese
 pl    polish
 ch    chinese
 
-You can  specify only the country  code, or append B<de2>  in order to
+You can  specify only the country  code, or append de2  in order to
-force translation to german, or  preprend B<de2> in order to translate
+force translation to german, or  preprend de2 in order to translate
 to the other language. Valid examples:
 
 ru     to or from russian
 de2pl  to polish
 es2de  spanish to german
 
-Report bugs to <tlinden\@cpan.org>.
+Report bugs to <tlinden\@cpan.org> or on https://github.com/TLINDEN/leo/issues.
 );
 
   exit 1;