package WebPAC::Normalize;
use Exporter 'import';
our @EXPORT = qw/
- _set_rec _set_lookup
+ _set_ds _set_lookup
+ get_ds
_set_load_row
_get_ds _clean_ds
_debug
=cut
-our $VERSION = '0.31';
+our $VERSION = '0.32';
=head1 SYNOPSIS
no strict 'subs';
_set_lookup( $arg->{lookup} ) if defined($arg->{lookup});
- _set_rec( $arg->{row} );
+ _set_ds( $arg->{row} );
_set_config( $arg->{config} ) if defined($arg->{config});
_clean_ds( %{ $arg } );
$load_row_coderef = $arg->{load_row_coderef};
return _get_ds();
}
-=head2 _set_rec
+=head2 _set_ds
Set current record hash
- _set_rec( $rec );
+ _set_ds( $rec );
=cut
my $rec;
-sub _set_rec {
+sub _set_ds {
$rec = shift or die "no record hash";
}
+=head2 get_ds
+
+Access to original record from input module
+
+ my $ds = get_rec;
+
+=cut
+
+sub get_ds {
+ return $rec;
+}
+
=head2 _set_config
Set current config hash
use strict;
use blib;
-use Test::More tests => 351;
+use Test::More tests => 352;
BEGIN {
use_ok( 'WebPAC::Test' );
ok(! _set_lookup( undef ), "set_lookup(undef)");
- _set_rec( $rec1 );
+ _set_ds( $rec1 );
+
+ is_deeply( get_ds, $rec1, 'get_ds' );
cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' );
#ok(! lookup('non-existent'), 'lookup non-existant' );
- _set_rec( $rec2 );
+ _set_ds( $rec2 );
test_s(qq{
search_display('Title',
my $rules = qq{ search('mixed', rec('200') ) };
_clean_ds();
- _set_rec( $rec );
+ _set_ds( $rec );
test_s( $rules );
ok($ds = _get_ds(), "get_ds");
is_deeply( $ds, {
# wird and non-valid structure which is supported anyway
_clean_ds();
- _set_rec({
+ _set_ds({
'200' => [{
'a' => '200a',
},
my ($msg, $rec, $rules, $struct) = @_;
_clean_ds();
- _set_rec($rec);
+ _set_ds($rec);
foreach my $r (split(/;/, $rules)) {
$r =~ s/[\s\n\r]+/ /gs;
sub test_rule {
my ($msg, $rec, $rule, $struct) = @_;
_clean_ds();
- _set_rec( $rec );
+ _set_ds( $rec );
$rule =~ s/\\/\\/gs;
my $r = test_s( $rule );
diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1);