r877@llin: dpavlin | 2006-08-25 21:55:05 +0200

 removed traces of Text::Iconv and replaced them with Encode,
 code page 852 is now cp852 (instead of just 852) because Encode
 likes it that way, record encoding is now hard-coded to utf-8

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@624 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index 1e72e48..93fc160 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -7,8 +7,8 @@ use blib;
 
 use WebPAC::Common;
 use base qw/WebPAC::Common/;
-use Text::Iconv;
 use Data::Dumper;
+use Encode qw/from_to/;
 
 =head1 NAME
 
@@ -159,7 +159,7 @@ This function will read whole database in memory and produce lookups.
 
  $input->open(
        path => '/path/to/database/file',
-       code_page => '852',
+       code_page => 'cp852',
        limit => 500,
        offset => 6000,
        lookup => $lookup_obj,
@@ -174,7 +174,7 @@ This function will read whole database in memory and produce lookups.
        },
  );
 
-By default, C<code_page> is assumed to be C<852>.
+By default, C<code_page> is assumed to be C<cp852>.
 
 C<offset> is optional parametar to position at some offset before reading from database.
 
@@ -205,7 +205,7 @@ sub open {
                if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');
 
        $log->logcroak("need path") if (! $arg->{'path'});
-       my $code_page = $arg->{'code_page'} || '852';
+       my $code_page = $arg->{'code_page'} || 'cp852';
 
        # store data in object
        $self->{'input_code_page'} = $code_page;
@@ -213,9 +213,6 @@ sub open {
                $self->{$v} = $arg->{$v} if ($arg->{$v});
        }
 
-       # create Text::Iconv object
-       $self->{iconv} = Text::Iconv->new($code_page,$self->{'encoding'});      ## FIXME remove!
-
        my $filter_ref;
        my $recode_regex;
        my $recode_map;
@@ -243,21 +240,13 @@ sub open {
 
        my ($db, $size) = $self->{open_db}->( $self, 
                path => $arg->{path},
-               filter => sub {
-                               my ($l,$f_nr) = @_;
-                               return unless defined($l);
-
-                               ## FIXME remove iconv!
-                               $l = $self->{iconv}->convert($l) if ($self->{iconv});
-       
-                               $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
-
-                               ## FIXME remove this warning when we are sure that none of API is calling
-                               ## this wrongly
-                               warn "filter called without field number" unless ($f_nr);
-
-                               return $l;
-               },
+#              filter => sub {
+#                      my ($l,$f_nr) = @_;
+#                      return unless defined($l);
+#                      from_to($l, $code_page, $self->{'encoding'});
+#                      $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
+#                      return $l;
+#              },
                %{ $arg },
        );
 
@@ -299,8 +288,14 @@ sub open {
 
                my $rec = $self->{fetch_rec}->($self, $db, $pos, sub {
                                my ($l,$f_nr) = @_;
-                               return unless defined($l);
-                               return $l unless ($rec_regex && $f_nr);
+#                              return unless defined($l);
+#                              return $l unless ($rec_regex && $f_nr);
+
+warn "## --> $f_nr ## $l\n";
+                               # codepage conversion and recode_regex
+#                              from_to($l, $code_page, $self->{'encoding'});
+                               from_to($l, $code_page, 'utf-8');
+                               $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
 
                                # apply regexps
                                if ($rec_regex && defined($rec_regex->{$f_nr})) {
@@ -313,6 +308,7 @@ sub open {
                                        }
                                }
 
+warn "## <-- $f_nr ## $l\n";
                                return $l;
                });