3 |
use warnings; |
use warnings; |
4 |
use strict; |
use strict; |
5 |
|
|
|
use blib; |
|
|
|
|
6 |
use WebPAC::Common; |
use WebPAC::Common; |
7 |
use base qw/WebPAC::Common/; |
use base qw/WebPAC::Common/; |
8 |
use Text::Iconv; |
use Text::Iconv; |
9 |
|
use Data::Dumper; |
10 |
|
|
11 |
=head1 NAME |
=head1 NAME |
12 |
|
|
91 |
$module =~ s#::#/#g; |
$module =~ s#::#/#g; |
92 |
$module .= '.pm'; |
$module .= '.pm'; |
93 |
$log->debug("require low-level module $self->{module} from $module"); |
$log->debug("require low-level module $self->{module} from $module"); |
94 |
|
|
95 |
require $module; |
require $module; |
96 |
eval $self->{module} .'->import'; |
#eval $self->{module} .'->import'; |
97 |
|
|
98 |
# check if required subclasses are implemented |
# check if required subclasses are implemented |
99 |
foreach my $subclass (qw/open_db fetch_rec/) { |
foreach my $subclass (qw/open_db fetch_rec init/) { |
100 |
if ( $self->can($subclass) ) { |
my $n = $self->{module} . '::' . $subclass; |
101 |
$log->debug("imported $subclass"); |
if (! defined &{ $n }) { |
102 |
|
my $missing = "missing $subclass in $self->{module}"; |
103 |
|
$self->{$subclass} = sub { $log->logwarn($missing) }; |
104 |
} else { |
} else { |
105 |
$log->warn("missing $subclass in $self->{module}"); |
$self->{$subclass} = \&{ $n }; |
106 |
} |
} |
107 |
} |
} |
108 |
|
|
109 |
if ($self->can('init')) { |
if ($self->{init}) { |
110 |
$log->debug("calling init"); |
$log->debug("calling init"); |
111 |
$self->init(@_); |
$self->{init}->($self, @_); |
112 |
} |
} |
113 |
|
|
114 |
$self->{'code_page'} ||= 'ISO-8859-2'; |
$self->{'code_page'} ||= 'ISO-8859-2'; |
175 |
my $code_page = $arg->{'code_page'} || '852'; |
my $code_page = $arg->{'code_page'} || '852'; |
176 |
|
|
177 |
# store data in object |
# store data in object |
178 |
$self->{'code_page'} = $code_page; |
$self->{'input_code_page'} = $code_page; |
179 |
foreach my $v (qw/path offset limit/) { |
foreach my $v (qw/path offset limit/) { |
180 |
$self->{$v} = $arg->{$v} if ($arg->{$v}); |
$self->{$v} = $arg->{$v} if ($arg->{$v}); |
181 |
} |
} |
183 |
# create Text::Iconv object |
# create Text::Iconv object |
184 |
$self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'}); |
$self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'}); |
185 |
|
|
186 |
my ($db, $size) = $self->open_db( |
my ($db, $size) = $self->{open_db}->( $self, |
187 |
path => $arg->{path}, |
path => $arg->{path}, |
188 |
); |
); |
189 |
|
|
208 |
} |
} |
209 |
|
|
210 |
if ($self->{limit}) { |
if ($self->{limit}) { |
211 |
$log->info("limiting to ",$self->{limit}," records"); |
$log->debug("limiting to ",$self->{limit}," records"); |
212 |
$limit = $offset + $self->{limit} - 1; |
$limit = $offset + $self->{limit} - 1; |
213 |
$limit = $size if ($limit > $size); |
$limit = $size if ($limit > $size); |
214 |
} |
} |
216 |
# store size for later |
# store size for later |
217 |
$self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0; |
$self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0; |
218 |
|
|
219 |
$log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}"); |
$log->info("processing $self->{size}/$size records [$offset-$limit] convert $code_page -> $self->{code_page}"); |
220 |
|
|
221 |
# read database |
# read database |
222 |
for (my $pos = $offset; $pos <= $limit; $mfn++) { |
for (my $pos = $offset; $pos <= $limit; $pos++) { |
223 |
|
|
224 |
$log->debug("position: $pos\n"); |
$log->debug("position: $pos\n"); |
225 |
|
|
226 |
my $rec = $self->fetch_rec( $db, $pos ); |
my $rec = $self->{fetch_rec}->($self, $db, $pos ); |
227 |
|
|
228 |
|
$log->debug(sub { Dumper($rec) }); |
229 |
|
|
230 |
if (! $rec) { |
if (! $rec) { |
231 |
$log->warn("record $pos empty? skipping..."); |
$log->warn("record $pos empty? skipping..."); |