/[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 58 by dpavlin, Sun Jul 9 12:18:44 2006 UTC revision 70 by dpavlin, Fri May 18 20:26:01 2007 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.21;          $VERSION     = 0.24_1;
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,
# Line 114  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 126  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    
131    =item ignore_empty_subfields
132    
133    Remove all empty subfields while reading from ISIS file.
134    
135  =back  =back
136    
137  =cut  =cut
# Line 137  sub new { Line 143  sub new {
143    
144          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});          croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb});
145    
146          foreach my $v (qw{isisdb debug include_deleted hash_filter}) {          foreach my $v (qw{isisdb debug include_deleted hash_filter join_subfields_with ignore_empty_subfields}) {
147                  $self->{$v} = {@_}->{$v};                  $self->{$v} = {@_}->{$v} if defined({@_}->{$v});
148          }          }
149    
150          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 382  sub fetch { Line 388  sub fetch {
388                  # skip zero-sized fields                  # skip zero-sized fields
389                  next if ($FieldLEN[$i] == 0);                  next if ($FieldLEN[$i] == 0);
390    
391                  push @{$self->{record}->{$FieldTAG[$i]}}, substr($buff,$FieldPOS[$i],$FieldLEN[$i]);                  my $v = substr($buff,$FieldPOS[$i],$FieldLEN[$i]);
392    
393                    if ( $self->{ignore_empty_subfields} ) {
394                            $v =~ s/(\^\w)+(\^\w)/$2/g;
395                            $v =~ s/\^\w$//;                        # last on line?
396                            next if ($v eq '');
397                    }
398    
399                    push @{$self->{record}->{$FieldTAG[$i]}}, $v;
400          }          }
401    
402          $self->{'current_mfn'} = $mfn;          $self->{'current_mfn'} = $mfn;
# Line 546  have original record subfield order and Line 560  have original record subfield order and
560  Define delimiter which will be used to join repeatable subfields. You can  Define delimiter which will be used to join repeatable subfields. You can
561  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.
562    
563    =item hash_filter
564    
565    You can override C<hash_filter> defined in L</new> using this option.
566    
567  =back  =back
568    
569  =cut  =cut
# Line 557  sub to_hash { Line 575  sub to_hash {
575          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
576          my $arg;          my $arg;
577    
578            my $hash_filter = $self->{hash_filter};
579    
580          if (ref($mfn) eq 'HASH') {          if (ref($mfn) eq 'HASH') {
581                  $arg = $mfn;                  $arg = $mfn;
582                  $mfn = $arg->{mfn} || confess "need mfn in arguments";                  $mfn = $arg->{mfn} || confess "need mfn in arguments";
583                    $hash_filter = $arg->{hash_filter} if ($arg->{hash_filter});
584          }          }
585    
586          # init record to include MFN as field 000          # init record to include MFN as field 000
# Line 567  sub to_hash { Line 588  sub to_hash {
588    
589          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
590    
591          my $j_rs = $arg->{join_subfields_with};          my $j_rs = $arg->{join_subfields_with} || $self->{join_subfields_with};
592          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));
593          my $i_sf = $arg->{include_subfields};          my $i_sf = $arg->{include_subfields};
594    
# Line 575  sub to_hash { Line 596  sub to_hash {
596                  foreach my $l (@{$row->{$f_nr}}) {                  foreach my $l (@{$row->{$f_nr}}) {
597    
598                          # filter output                          # filter output
599                          if ($self->{'hash_filter'}) {                          $l = $hash_filter->($l, $f_nr) if ($hash_filter);
600                                  $l = $self->{'hash_filter'}->($l);                          next unless defined($l);
                                 next unless defined($l);  
                         }  
601    
602                          my $val;                          my $val;
603                          my $r_sf;       # repeatable subfields in this record                          my $r_sf;       # repeatable subfields in this record
# Line 592  sub to_hash { Line 611  sub to_hash {
611                                          next if (! $t);                                          next if (! $t);
612                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));
613                                          # XXX this might be option, but why?                                          # XXX this might be option, but why?
614                                          next unless ($v);                                          next unless (defined($v) && $v ne '');
615  #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);  #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);
616    
617                                          if (ref( $val->{$sf} ) eq 'ARRAY') {                                          if (ref( $val->{$sf} ) eq 'ARRAY') {
# Line 744  know any details about it's version. Line 763  know any details about it's version.
763  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
764  a good idea to specify version when using this module like this:  a good idea to specify version when using this module like this:
765    
766    use Biblio::Isis 0.21    use Biblio::Isis 0.23
767    
768  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
769  older versions if you really have to):  older versions if you really have to):
770    
771  =over 8  =over 8
772    
773    =item 0.24
774    
775    Added C<ignore_empty_subfields>
776    
777    =item 0.23
778    
779    Added C<hash_filter> to L</to_hash>
780    
781    Fixed bug with documented C<join_subfields_with> in L</new> which wasn't
782    implemented
783    
784    =item 0.22
785    
786    Added field number when calling C<hash_filter>
787    
788  =item 0.21  =item 0.21
789    
790  Added C<join_subfields_with> to L</new> and L</to_hash>.  Added C<join_subfields_with> to L</new> and L</to_hash>.
# Line 785  LICENSE file included with this module. Line 819  LICENSE file included with this module.
819    
820  =head1 SEE ALSO  =head1 SEE ALSO
821    
822    L<Biblio::Isis::Manual> for CDS/ISIS manual appendix F, G and H which describe file format
823    
824  OpenIsis web site L<http://www.openisis.org>  OpenIsis web site L<http://www.openisis.org>
825    
826  perl4lib site L<http://perl4lib.perl.org>  perl4lib site L<http://perl4lib.perl.org>
Legend:
Removed from v.58  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.26