/[Biblio-Isis]/trunk/lib/Biblio/Isis.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Biblio/Isis.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 62 by dpavlin, Mon Jul 10 12:01:04 2006 UTC revision 69 by dpavlin, Sun Oct 29 15:37:43 2006 UTC
# Line 7  use File::Glob qw(:globally :nocase); Line 7  use File::Glob qw(:globally :nocase);
7  BEGIN {  BEGIN {
8          use Exporter ();          use Exporter ();
9          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
10          $VERSION     = 0.22_2;          $VERSION     = 0.23;
11          @ISA         = qw (Exporter);          @ISA         = qw (Exporter);
12          #Give a hoot don't pollute, do not export more than needed by default          #Give a hoot don't pollute, do not export more than needed by default
13          @EXPORT      = qw ();          @EXPORT      = qw ();
# Line 84  Open ISIS database Line 84  Open ISIS database
84          read_fdt => 1,          read_fdt => 1,
85          include_deleted => 1,          include_deleted => 1,
86          hash_filter => sub {          hash_filter => sub {
87                  my $v = shift;                  my ($v,$field_number) = @_;
88                  $v =~ s#foo#bar#g;                  $v =~ s#foo#bar#g;
89          },          },
90          debug => 1,          debug => 1,
91          join_subfields_with => ' ; ',          join_subfields_with => ' ; ',
         regexps => [  
                 's/something/else/g',  
         ],  
92   );   );
93    
94  Options are described below:  Options are described below:
# Line 117  Don't skip logically deleted records in Line 114  Don't skip logically deleted records in
114    
115  =item hash_filter  =item hash_filter
116    
117  Filter code ref which will be used before data is converted to hash.  Filter code ref which will be used before data is converted to hash. It will
118    receive two arguments, whole line from current field (in C<< $_[0] >>) and
119    field number (in C<< $_[1] >>).
120    
121  =item debug  =item debug
122    
# Line 129  Define delimiter which will be used to j Line 128  Define delimiter which will be used to j
128  option is included to support lagacy application written against version  option is included to support lagacy application written against version
129  older than 0.21 of this module. By default, it disabled. See L</to_hash>.  older than 0.21 of this module. By default, it disabled. See L</to_hash>.
130    
 =item regexpes  
   
 Define (any number) of regexpes to apply at field values before they are  
 splitted into subfield. This is great place to split subfields in input to  
 mulitple subfields if needed or rename subfields.  
   
131  =back  =back
132    
133  =cut  =cut
# Line 146  sub new { Line 139  sub new {
139    
140          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});
141    
142          foreach my $v (qw{isisdb debug include_deleted hash_filter}) {          foreach my $v (qw{isisdb debug include_deleted hash_filter join_subfields_with}) {
143                  $self->{$v} = {@_}->{$v};                  $self->{$v} = {@_}->{$v} if defined({@_}->{$v});
144          }          }
145    
146          my @isis_files = grep(/\.(FDT|MST|XRF|CNT)$/i,glob($self->{isisdb}."*"));          my @isis_files = grep(/\.(FDT|MST|XRF|CNT)$/i,glob($self->{isisdb}."*"));
# Line 528  There is also more elaborative way to ca Line 521  There is also more elaborative way to ca
521    my $hash = $isis->to_hash({    my $hash = $isis->to_hash({
522          mfn => 42,          mfn => 42,
523          include_subfields => 1,          include_subfields => 1,
         regexps => [  
                 's/something/else/g',  
         ],  
524    });    });
525    
526  Each option controll creation of hash:  Each option controll creation of hash:
# Line 558  have original record subfield order and Line 548  have original record subfield order and
548  Define delimiter which will be used to join repeatable subfields. You can  Define delimiter which will be used to join repeatable subfields. You can
549  specify option here instead in L</new> if you want to have per-record control.  specify option here instead in L</new> if you want to have per-record control.
550    
551  =item regexpes  =item hash_filter
552    
553  Override C<regexpes> specified in L</new>.  You can override C<hash_filter> defined in L</new> using this option.
554    
555  =back  =back
556    
# Line 573  sub to_hash { Line 563  sub to_hash {
563          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
564          my $arg;          my $arg;
565    
566            my $hash_filter = $self->{hash_filter};
567    
568          if (ref($mfn) eq 'HASH') {          if (ref($mfn) eq 'HASH') {
569                  $arg = $mfn;                  $arg = $mfn;
570                  $mfn = $arg->{mfn} || confess "need mfn in arguments";                  $mfn = $arg->{mfn} || confess "need mfn in arguments";
571                    $hash_filter = $arg->{hash_filter} if ($arg->{hash_filter});
572          }          }
573    
         $arg->{regexpes} ||= $self->{regexpes};  
   
         confess "regexps must be HASH" if ($arg->{regexps} && ref($arg->{regexps}) ne 'HASH');  
   
574          # init record to include MFN as field 000          # init record to include MFN as field 000
575          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
576    
577          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
578    
579          my $j_rs = $arg->{join_subfields_with};          my $j_rs = $arg->{join_subfields_with} || $self->{join_subfields_with};
580          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));
581          my $i_sf = $arg->{include_subfields};          my $i_sf = $arg->{include_subfields};
582    
# Line 595  sub to_hash { Line 584  sub to_hash {
584                  foreach my $l (@{$row->{$f_nr}}) {                  foreach my $l (@{$row->{$f_nr}}) {
585    
586                          # filter output                          # filter output
587                          if ($self->{'hash_filter'}) {                          $l = $hash_filter->($l, $f_nr) if ($hash_filter);
588                                  $l = $self->{'hash_filter'}->($l);                          next unless defined($l);
                                 next unless defined($l);  
                         }  
   
                         # apply regexps  
                         if ($arg->{regexps} && defined($arg->{regexps}->{$f_nr})) {  
                                 confess "regexps->{$f_nr} must be ARRAY" if (ref($arg->{regexps}->{$f_nr}) ne 'ARRAY');  
                                 my $c = 0;  
                                 foreach my $r (@{ $arg->{regexps}->{$f_nr} }) {  
                                         while ( eval '$l =~ ' . $r ) { $c++ };  
                                 }  
                                 warn "## field $f_nr triggered $c regexpes\n" if ($c && $self->{debug});  
                         }  
589    
590                          my $val;                          my $val;
591                          my $r_sf;       # repeatable subfields in this record                          my $r_sf;       # repeatable subfields in this record
# Line 622  sub to_hash { Line 599  sub to_hash {
599                                          next if (! $t);                                          next if (! $t);
600                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));
601                                          # XXX this might be option, but why?                                          # XXX this might be option, but why?
602                                          next unless ($v);                                          next unless (defined($v) && $v ne '');
603  #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);  #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);
604    
605                                          if (ref( $val->{$sf} ) eq 'ARRAY') {                                          if (ref( $val->{$sf} ) eq 'ARRAY') {
# Line 774  know any details about it's version. Line 751  know any details about it's version.
751  As this is young module, new features are added in subsequent version. It's  As this is young module, new features are added in subsequent version. It's
752  a good idea to specify version when using this module like this:  a good idea to specify version when using this module like this:
753    
754    use Biblio::Isis 0.21    use Biblio::Isis 0.23
755    
756  Below is list of changes in specific version of module (so you can target  Below is list of changes in specific version of module (so you can target
757  older versions if you really have to):  older versions if you really have to):
758    
759  =over 8  =over 8
760    
761    =item 0.23
762    
763    Added C<hash_filter> to L</to_hash>
764    
765    Fixed bug with documented C<join_subfields_with> in L</new> which wasn't
766    implemented
767    
768    =item 0.22
769    
770    Added field number when calling C<hash_filter>
771    
772  =item 0.21  =item 0.21
773    
774  Added C<join_subfields_with> to L</new> and L</to_hash>.  Added C<join_subfields_with> to L</new> and L</to_hash>.
Legend:
Removed from v.62  
changed lines
  Added in v.69
  ViewVC Help
Powered by ViewVC 1.1.26