8 |
use XBase; |
use XBase; |
9 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
10 |
use Encode qw/encode_utf8/; |
use Encode qw/encode_utf8/; |
11 |
use YAML; |
use YAML qw/LoadFile DumpFile/; |
|
use File::Slurp; |
|
12 |
|
|
13 |
=head1 NAME |
=head1 NAME |
14 |
|
|
39 |
|
|
40 |
my $ll_db = new WebPAC::Input::DBF( |
my $ll_db = new WebPAC::Input::DBF( |
41 |
path => '/path/to/database.dbf' |
path => '/path/to/database.dbf' |
42 |
|
mapping_path => '/path/to/input/dbf/mapping.yml', |
43 |
filter => sub { |
filter => sub { |
44 |
my ($l,$field_nr) = @_; |
my ($l,$field_nr) = @_; |
45 |
# do something with $l which is line of input file |
# do something with $l which is line of input file |
55 |
|
|
56 |
path to DBF file |
path to DBF file |
57 |
|
|
58 |
|
=item mapping_path |
59 |
|
|
60 |
|
path to mapping YAML which will be created on first run |
61 |
|
|
62 |
=back |
=back |
63 |
|
|
64 |
=cut |
=cut |
72 |
|
|
73 |
my $log = $self->_get_logger(); |
my $log = $self->_get_logger(); |
74 |
|
|
75 |
|
$log->logconfess("this module requires input_config") unless ( $arg->{input_config} ); |
76 |
|
|
77 |
my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!"); |
my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!"); |
78 |
|
|
79 |
my $size = $db->last_record; |
my $size = $db->last_record; |
80 |
|
|
81 |
$log->info("opening DBF database '$arg->{path}' with $size records"); |
$log->info("opening DBF database '$arg->{path}' with $size records"); |
82 |
|
|
83 |
my $mapping = $arg->{input_config}->{mapping}; |
my $mapping_path = $arg->{input_config}->{mapping_path}; |
84 |
|
my $mapping; |
85 |
|
|
86 |
if ( ! $mapping ) { |
if ( ! $mapping_path ) { |
87 |
$log->debug("didn't found any mapping file in configuration", sub { dump( $arg->{input_config} ) }); |
$log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) }); |
88 |
|
|
89 |
foreach my $field ( $db->field_names ) { |
foreach my $field ( $db->field_names ) { |
90 |
push @$mapping, { $field => { '900' => 'x' } }; |
push @$mapping, { $field => { '900' => 'x' } }; |
95 |
|
|
96 |
$log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path ); |
$log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path ); |
97 |
|
|
98 |
write_file( $mapping_path, Dump( { mapping => $mapping } ) ) || |
DumpFile( $mapping_path, Dump( { mapping => $mapping } ) ) || |
99 |
$log->logdie("can't write template file for mapping_path $mapping_path: $!"); |
$log->logdie("can't write template file for mapping_path $mapping_path: $!"); |
100 |
|
|
101 |
$log->logdie("template file for mapping_path created as $mapping_path"); |
$log->logdie("template file for mapping_path created as $mapping_path"); |
102 |
|
|
103 |
} else { |
} else { |
104 |
$log->debug("using mapping ", sub { dump($mapping) }); |
$mapping = LoadFile( $mapping_path ) || $log->logdie("can't open $mapping_path: $!"); |
105 |
|
$log->logdie("missing top-level mapping key in $mapping_path") unless ( $mapping->{mapping} ); |
106 |
|
$mapping = $mapping->{mapping}; |
107 |
|
$log->debug("using mapping from $mapping_path = ", sub { dump($mapping) }); |
108 |
} |
} |
109 |
|
|
110 |
foreach my $mfn ( 1 .. $size ) { |
foreach my $mfn ( 1 .. $size ) { |
117 |
'001' => [ $mfn ], |
'001' => [ $mfn ], |
118 |
}; |
}; |
119 |
|
|
120 |
|
# fixme -- this *will* break given wrong structure! |
121 |
|
foreach my $m ( @$mapping ) { |
122 |
|
my $db_field = (keys %$m)[0]; |
123 |
|
my ( $f, $sf ) = %{ $m->{$db_field} }; |
124 |
|
push @{ $record->{$f} }, '^' . $sf . $row->{$db_field} if ( defined( $row->{$db_field} ) && $row->{$db_field} ne '' ); |
125 |
|
} |
126 |
|
|
127 |
$self->{_rows}->{ $mfn } = $record; |
$self->{_rows}->{ $mfn } = $record; |
128 |
$log->debug("created row $mfn ", dump( $record )); |
$log->debug("created row $mfn ", dump( $record )); |
129 |
} |
} |
176 |
Return hash from row. Taken from L<Biblio::Isis> |
Return hash from row. Taken from L<Biblio::Isis> |
177 |
|
|
178 |
my $rec = $ll_db->_to_hash( |
my $rec = $ll_db->_to_hash( |
179 |
mfn => $mfn; |
mfn => $mfn, |
180 |
$row |
row => $row, |
181 |
); |
); |
182 |
|
|
183 |
=cut |
=cut |