/[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 45 by dpavlin, Thu Jul 6 20:31:46 2006 UTC revision 61 by dpavlin, Sun Jul 9 21:36:33 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.14;          $VERSION     = 0.22_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 88  Open ISIS database Line 88  Open ISIS database
88                  $v =~ s#foo#bar#g;                  $v =~ s#foo#bar#g;
89          },          },
90          debug => 1,          debug => 1,
91            join_subfields_with => ' ; ',
92   );   );
93    
94  Options are described below:  Options are described below:
# Line 117  Filter code ref which will be used befor Line 118  Filter code ref which will be used befor
118    
119  =item debug  =item debug
120    
121  Dump a B<lot> of debugging output.  Dump a B<lot> of debugging output even at level 1. For even more increase level.
122    
123    =item join_subfields_with
124    
125    Define delimiter which will be used to join repeatable subfields. This
126    option is included to support lagacy application written against version
127    older than 0.21 of this module. By default, it disabled. See L</to_hash>.
128    
129  =back  =back
130    
# Line 385  sub fetch { Line 392  sub fetch {
392          return $self->{'record'};          return $self->{'record'};
393  }  }
394    
395    =head2 mfn
396    
397    Returns current MFN position
398    
399      my $mfn = $isis->mfn;
400    
401    =cut
402    
403    # This function should be simple return $self->{current_mfn},
404    # but if new is called with _hack_mfn it becomes setter.
405    # It's useful in tests when setting $isis->{record} directly
406    
407    sub mfn {
408            my $self = shift;
409            return $self->{current_mfn};
410    };
411    
412    
413  =head2 to_ascii  =head2 to_ascii
414    
415  Returns ASCII output of record with specified MFN  Returns ASCII output of record with specified MFN
# Line 464  which will be used for identifiers, C<i1 Line 489  which will be used for identifiers, C<i1
489               }               }
490             ],             ],
491    
492    In case there are repeatable subfields in record, this will create
493    following structure:
494    
495      '900' => [ {
496            'a' => [ 'foo', 'bar', 'baz' ],
497      }]
498    
499    Or in more complex example of
500    
501      902   ^aa1^aa2^aa3^bb1^aa4^bb2^cc1^aa5
502    
503    it will create
504    
505      902   => [
506            { a => ["a1", "a2", "a3", "a4", "a5"], b => ["b1", "b2"], c => "c1" },
507      ],
508    
509    This behaviour can be changed using C<join_subfields_with> option to L</new>,
510    in which case C<to_hash> will always create single value for each subfield.
511    This will change result to:
512    
513    
514    
515  This method will also create additional field C<000> with MFN.  This method will also create additional field C<000> with MFN.
516    
517    There is also more elaborative way to call C<to_hash> like this:
518    
519      my $hash = $isis->to_hash({
520            mfn => 42,
521            include_subfields => 1,
522            regexps => [
523                    's/something/else/g',
524            ],
525      });
526    
527    Each option controll creation of hash:
528    
529    =over 4
530    
531    =item mfn
532    
533    Specify MFN number of record
534    
535    =item include_subfields
536    
537    This option will create additional key in hash called C<subfields> which will
538    have original record subfield order and index to that subfield like this:
539    
540      902   => [ {
541            a => ["a1", "a2", "a3", "a4", "a5"],
542            b => ["b1", "b2"],
543            c => "c1",
544            subfields => ["a", 0, "a", 1, "a", 2, "b", 0, "a", 3, "b", 1, "c", 0, "a", 4],
545      } ],
546    
547    =item join_subfields_with
548    
549    Define delimiter which will be used to join repeatable subfields. You can
550    specify option here instead in L</new> if you want to have per-record control.
551    
552    =back
553    
554  =cut  =cut
555    
556  sub to_hash {  sub to_hash {
557          my $self = shift;          my $self = shift;
558    
559    
560          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
561            my $arg;
562    
563            if (ref($mfn) eq 'HASH') {
564                    $arg = $mfn;
565                    $mfn = $arg->{mfn} || confess "need mfn in arguments";
566            }
567    
568            confess "regexps must be HASH" if ($arg->{regexps} && ref($arg->{regexps}) ne 'HASH');
569    
570          # init record to include MFN as field 000          # init record to include MFN as field 000
571          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
572    
573          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
574    
575          foreach my $k (keys %{$row}) {          my $j_rs = $arg->{join_subfields_with};
576                  foreach my $l (@{$row->{$k}}) {          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));
577            my $i_sf = $arg->{include_subfields};
578    
579            foreach my $f_nr (keys %{$row}) {
580                    foreach my $l (@{$row->{$f_nr}}) {
581    
582                          # filter output                          # filter output
583                          if ($self->{'hash_filter'}) {                          if ($self->{'hash_filter'}) {
# Line 487  sub to_hash { Line 585  sub to_hash {
585                                  next unless defined($l);                                  next unless defined($l);
586                          }                          }
587    
588                            # apply regexps
589                            if ($arg->{regexps} && defined($arg->{regexps}->{$f_nr})) {
590                                    confess "regexps->{$f_nr} must be ARRAY" if (ref($arg->{regexps}->{$f_nr}) ne 'ARRAY');
591                                    my $c = 0;
592                                    foreach my $r (@{ $arg->{regexps}->{$f_nr} }) {
593                                            while ( eval '$l =~ ' . $r ) { $c++ };
594                                    }
595                                    warn "## field $f_nr triggered $c regexpes\n" if ($c && $self->{debug});
596                            }
597    
598                          my $val;                          my $val;
599                            my $r_sf;       # repeatable subfields in this record
600    
601                          # has identifiers?                          # has identifiers?
602                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\^/\^/);                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\^/\^/);
# Line 496  sub to_hash { Line 605  sub to_hash {
605                          if ($l =~ m/\^/) {                          if ($l =~ m/\^/) {
606                                  foreach my $t (split(/\^/,$l)) {                                  foreach my $t (split(/\^/,$l)) {
607                                          next if (! $t);                                          next if (! $t);
608                                          $val->{substr($t,0,1)} = substr($t,1);                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));
609                                            # XXX this might be option, but why?
610                                            next unless ($v);
611    #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);
612    
613                                            if (ref( $val->{$sf} ) eq 'ARRAY') {
614    
615                                                    push @{ $val->{$sf} }, $v;
616    
617                                                    # record repeatable subfield it it's offset
618                                                    push @{ $val->{subfields} }, ( $sf, $#{ $val->{$sf} } ) if (! $j_rs && $i_sf);
619                                                    $r_sf->{$sf}++;
620    
621                                            } elsif (defined( $val->{$sf} )) {
622    
623                                                    # convert scalar field to array
624                                                    $val->{$sf} = [ $val->{$sf}, $v ];
625    
626                                                    push @{ $val->{subfields} }, ( $sf, 1 ) if (! $j_rs && $i_sf);
627                                                    $r_sf->{$sf}++;
628    
629                                            } else {
630                                                    $val->{$sf} = $v;
631                                                    push @{ $val->{subfields} }, ( $sf, 0 ) if ($i_sf);
632                                            }
633                                  }                                  }
634                          } else {                          } else {
635                                  $val = $l;                                  $val = $l;
636                          }                          }
637    
638                          push @{$rec->{$k}}, $val;                          if ($j_rs) {
639                                    map {
640                                            $val->{$_} = join($j_rs, @{ $val->{$_} });
641                                    } keys %$r_sf
642                            }
643    
644                            push @{$rec->{$f_nr}}, $val;
645                  }                  }
646          }          }
647    
# Line 615  module with databases from programs othe Line 754  module with databases from programs othe
754  tested this against ouput of one C<isis.dll>-based application, but I don't  tested this against ouput of one C<isis.dll>-based application, but I don't
755  know any details about it's version.  know any details about it's version.
756    
757    =head1 VERSIONS
758    
759    As this is young module, new features are added in subsequent version. It's
760    a good idea to specify version when using this module like this:
761    
762      use Biblio::Isis 0.21
763    
764    Below is list of changes in specific version of module (so you can target
765    older versions if you really have to):
766    
767    =over 8
768    
769    =item 0.21
770    
771    Added C<join_subfields_with> to L</new> and L</to_hash>.
772    
773    Added C<include_subfields> to L</to_hash>.
774    
775    =item 0.20
776    
777    Added C<< $isis->mfn >>, support for repeatable subfields and
778    C<< $isis->to_hash({ mfn => 42, ... }) >> calling convention
779    
780    =back
781    
782  =head1 AUTHOR  =head1 AUTHOR
783    
784          Dobrica Pavlinusic          Dobrica Pavlinusic
# Line 636  LICENSE file included with this module. Line 800  LICENSE file included with this module.
800    
801  =head1 SEE ALSO  =head1 SEE ALSO
802    
803    L<Biblio::Isis::Manual> for CDS/ISIS manual appendix F, G and H which describe file format
804    
805  OpenIsis web site L<http://www.openisis.org>  OpenIsis web site L<http://www.openisis.org>
806    
807  perl4lib site L<http://perl4lib.perl.org>  perl4lib site L<http://perl4lib.perl.org>
Legend:
Removed from v.45  
changed lines
  Added in v.61
  ViewVC Help
Powered by ViewVC 1.1.26