diff --git a/Changelog b/Changelog index 8673a2d..a357b40 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,16 @@ +1.39: + +fixed rt.cpan.org#91464: disable caching if DB_File is not found. + +1.38: + +fixed rt.cpan.org#92944, missed translations. The problem was, +that the pda.leo.org uses a differnt number of tables depending +on the translation. So, now we just fetch all tables (2-4) and +ignore those which are not translations (forum posts or empty cells). + +Applied patch rt.cpan.org#92914 (POD locale encoding). + 1.37: fixed rt.cpan.org#92679, the site url and table structure diff --git a/Org.pm b/Org.pm index ec2cf21..da90545 100644 --- a/Org.pm +++ b/Org.pm @@ -1,11 +1,13 @@ # -# Copyleft (l) 2000-2014 by Thomas Linden . leo may be +# Copyleft (l) 2000-2014 Thomas Linden . +# 2014 Thomas von Dein . +# 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. package WWW::Dict::Leo::Org; -$WWW::Dict::Leo::Org::VERSION = 1.37; +$WWW::Dict::Leo::Org::VERSION = 1.39; use strict; use warnings; @@ -223,12 +225,24 @@ Accept-Language: en_US, en\r\n); #$site =~ s/(<\/table[^>]*>)/\n$1\n/g; #print $site; - my @request = ({ + my @request = ( + { + id => 2, + row => sub { $this->row(@_); }, + hdr => sub { $this->hdr(@_); } + }, + { id => 3, + hdr => sub { $this->hdr(@_); }, row => sub { $this->row(@_); } - } - ); - $this->{Linecount} = 1; + }, + { + id => 4, + hdr => sub { $this->hdr(@_); }, + row => sub { $this->row(@_); } + } + ); + $this->{Linecount} = 0; my $p = HTML::TableParser->new( \@request, { Decode => 1, Trim => 1, Chomp => 1, DecodeNBSP => 1 } ); $site=~s/ /\ \;/g; @@ -246,19 +260,12 @@ Accept-Language: en_US, en\r\n); push @matches, { title => $title, data => $this->{data}->{$title} }; } - return @matches; } -sub row { - # - # divide rows into titles and lang data. - # rows with the last one of 5 defined and - # where the last and the pre-last are qual - # are titles. +sub hdr { my ( $this, $tbl_id, $line_no, $data, $udata ) = @_; - if ($data->[1] && $data->[0] eq $data->[1]) { $this->debug("Probable start of a new section: $data->[1]"); if (@{$this->{section}}) { @@ -269,7 +276,19 @@ sub row { $this->{title} = $data->[1]; $this->{section} = []; } - else { +} + +sub row { + # + # divide rows into titles and lang data. + # we get 2 items (left and right column), if they + # are equal, it's a segment title, otherwise it's + # segment content. left columns ending in HH:MM + # are forumposts and ignored as well as rows with + # empty left cells. + my ( $this, $tbl_id, $line_no, $data, $udata ) = @_; + + if ($data->[1] && $data->[0] && $data->[0] ne $data->[1] && $data->[0] !~ /\d{2}:\d{2}$/) { if (length($data->[0]) > $this->{Maxsize}) { $this->{Maxsize} = length($data->[0]); } @@ -305,6 +324,8 @@ sub debug { 1; +=encoding ISO8859-1 + =head1 NAME WWW::Dict::Leo::Org - Interface module to dictionary dict.leo.org @@ -507,6 +528,7 @@ L WWW::Dict::Leo::Org - Copyright (c) 2007-2014 by Thomas Linden +Copyright (c) 2014 by Thomas von Dein L - Copyright (c) 1995-2014 LEO Dictionary Team. @@ -523,6 +545,6 @@ Please don't forget to add debugging output! =head1 VERSION -1.35 +1.39 =cut diff --git a/README b/README index 6f29066..dce46db 100644 --- a/README +++ b/README @@ -37,10 +37,10 @@ HISTORY COPYRIGHT WWW::Dict::Leo::Org - Copyright (c) 2007-2014 by Thomas von Dein + Copyright (c) 2007-2014 by Thomas Linden leo - Copyright (c) 2000-2014 by Thomas von Dein + Copyright (c) 2000-2014 by Thomas Linden http://dict.leo.org/ Copyright (c) 1995-2014 LEO Dictionary Team. @@ -49,4 +49,4 @@ COPYRIGHT at LEO.org. Thanks for the great work. -Thomas von Dein. +Thomas Linden. diff --git a/leo b/leo index e9697ca..f2718c6 100755 --- a/leo +++ b/leo @@ -37,7 +37,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.37"; +my $version = "1.39"; my $config = $ENV{HOME} . "/.leo"; my $cache = $ENV{HOME} . "/.leo-CACHE.db"; @@ -156,7 +156,13 @@ elsif ($conf{use_color} eq "yes") { # open the cache, if wanted # if ($conf{use_cache} eq "yes") { - dbmopen(%CACHE, $cache, 0600) or $conf{use_cache} = "no"; + eval { require DB_FileX; }; + if ($@) { + $conf{use_cache} = "no"; + } + else { + dbmopen(%CACHE, $cache, 0600) or $conf{use_cache} = "no"; + } } my %PARAM; @@ -626,6 +632,6 @@ browser, what is not prohibited. At least not today. =head1 VERSION -This is the manpage for B version B<1.36>. +This is the manpage for B version B<1.39>. =cut