From 0821a081e16a83df1766369b53f157f2882c07d3 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Thu, 13 Jul 2006 13:55:19 +0000 Subject: [PATCH] r835@llin: dpavlin | 2006-07-13 15:56:53 +0200 test modify_record git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@599 07558da8-63fa-0310-ba24-9fe276d99e06 --- TODO | 1 + lib/WebPAC/Input.pm | 12 ++++++++---- t/2-input.t | 29 ++++++++++++++++++++++++----- 3 files changed, 33 insertions(+), 9 deletions(-) diff --git a/TODO b/TODO index e204975..7a371d8 100644 --- a/TODO +++ b/TODO @@ -22,6 +22,7 @@ + implement indicators and repetable subfield in marc export [2.23] + add WebPAC::Output::MARC [2.24] + add config() and id() to WebPAC::Normalize +- implement modify_record to split fields on delimiters on join fields with delimiter [2.25] - rewrite lookup support to use WebPAC::Normalize - add dBase input format - remove delimiters characters from index and query entered diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm index 475a6a1..f4d9eb8 100644 --- a/lib/WebPAC/Input.pm +++ b/lib/WebPAC/Input.pm @@ -16,11 +16,11 @@ WebPAC::Input - read different file formats into WebPAC =head1 VERSION -Version 0.08 +Version 0.09 =cut -our $VERSION = '0.08'; +our $VERSION = '0.09'; =head1 SYNOPSIS @@ -252,7 +252,11 @@ sub open { $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map); - return $l unless ($rec_regex); + ## 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 unless ($rec_regex && $f_nr); # apply regexps if ($rec_regex && defined($rec_regex->{$f_nr})) { @@ -604,7 +608,7 @@ Dobrica Pavlinusic, C<< >> =head1 COPYRIGHT & LICENSE -Copyright 2005 Dobrica Pavlinusic, All Rights Reserved. +Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/t/2-input.t b/t/2-input.t index faf4a8e..c08efee 100755 --- a/t/2-input.t +++ b/t/2-input.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -use Test::More tests => 62; +use Test::More tests => 68; use Test::Exception; use Cwd qw/abs_path/; use blib; @@ -30,8 +30,8 @@ throws_ok { $input->open( ) } qr/path/, "need path"; throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open"; -ok($input->open( path => "$abs_path/winisis/BIBL" ), "open"); -ok($input_lm->open( path => "$abs_path/winisis/BIBL", low_mem => 1 ), "open"); +ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis"); +ok($input_lm->open( path => "$abs_path/winisis/BIBL", low_mem => 1 ), "open winisis"); sub test_after_open($) { my $input = shift; @@ -68,7 +68,7 @@ sub test_start_limit($$$$) { diag "offset $s, limit: $l, expected: $e"; - ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => 1 ), "open"); + ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => 1 ), "open winisis"); cmp_ok($s, '==', $size, "db size from open = $size"); cmp_ok($input->size, '==', $e, "input->size = $e"); } @@ -86,9 +86,28 @@ diag "testing with $module"; ok($input = new WebPAC::Input( module => $module, low_mem => 1, no_log => $no_log, no_progress_bar => 1 ), "new $module"); -ok($input->open( path => "$abs_path/data/marc.iso" ), "open"); +ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso"); test_after_open($input); test_fetch($input, $input->size); +# test modify_record +$module = 'WebPAC::Input::ISIS'; +ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module"); + +ok($input->open( path => "$abs_path/modify_isis/LIBRI",), "open modify_isis (plain)"); +ok(my $rec_p = $input->fetch, 'fetch'); + +ok($input->open( + path => "$abs_path/modify_isis/LIBRI", + modify_records => { + 200 => { + '*' => { '^c' => '. ' }, + } + }, +), "open modify_isis (with modify_records)"); + +ok(my $rec = $input->fetch, 'fetch'); + +cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working'); -- 2.20.1