/[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 62 by dpavlin, Mon Jul 10 12:01:04 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_2;
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            regexps => [
93                    's/something/else/g',
94            ],
95   );   );
96    
97  Options are described below:  Options are described below:
# Line 117  Filter code ref which will be used befor Line 121  Filter code ref which will be used befor
121    
122  =item debug  =item debug
123    
124  Dump a B<lot> of debugging output.  Dump a B<lot> of debugging output even at level 1. For even more increase level.
125    
126    =item join_subfields_with
127    
128    Define delimiter which will be used to join repeatable subfields. This
129    option is included to support lagacy application written against version
130    older than 0.21 of this module. By default, it disabled. See L</to_hash>.
131    
132    =item regexpes
133    
134    Define (any number) of regexpes to apply at field values before they are
135    splitted into subfield. This is great place to split subfields in input to
136    mulitple subfields if needed or rename subfields.
137    
138  =back  =back
139    
# Line 385  sub fetch { Line 401  sub fetch {
401          return $self->{'record'};          return $self->{'record'};
402  }  }
403    
404    =head2 mfn
405    
406    Returns current MFN position
407    
408      my $mfn = $isis->mfn;
409    
410    =cut
411    
412    # This function should be simple return $self->{current_mfn},
413    # but if new is called with _hack_mfn it becomes setter.
414    # It's useful in tests when setting $isis->{record} directly
415    
416    sub mfn {
417            my $self = shift;
418            return $self->{current_mfn};
419    };
420    
421    
422  =head2 to_ascii  =head2 to_ascii
423    
424  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 498  which will be used for identifiers, C<i1
498               }               }
499             ],             ],
500    
501    In case there are repeatable subfields in record, this will create
502    following structure:
503    
504      '900' => [ {
505            'a' => [ 'foo', 'bar', 'baz' ],
506      }]
507    
508    Or in more complex example of
509    
510      902   ^aa1^aa2^aa3^bb1^aa4^bb2^cc1^aa5
511    
512    it will create
513    
514      902   => [
515            { a => ["a1", "a2", "a3", "a4", "a5"], b => ["b1", "b2"], c => "c1" },
516      ],
517    
518    This behaviour can be changed using C<join_subfields_with> option to L</new>,
519    in which case C<to_hash> will always create single value for each subfield.
520    This will change result to:
521    
522    
523    
524  This method will also create additional field C<000> with MFN.  This method will also create additional field C<000> with MFN.
525    
526    There is also more elaborative way to call C<to_hash> like this:
527    
528      my $hash = $isis->to_hash({
529            mfn => 42,
530            include_subfields => 1,
531            regexps => [
532                    's/something/else/g',
533            ],
534      });
535    
536    Each option controll creation of hash:
537    
538    =over 4
539    
540    =item mfn
541    
542    Specify MFN number of record
543    
544    =item include_subfields
545    
546    This option will create additional key in hash called C<subfields> which will
547    have original record subfield order and index to that subfield like this:
548    
549      902   => [ {
550            a => ["a1", "a2", "a3", "a4", "a5"],
551            b => ["b1", "b2"],
552            c => "c1",
553            subfields => ["a", 0, "a", 1, "a", 2, "b", 0, "a", 3, "b", 1, "c", 0, "a", 4],
554      } ],
555    
556    =item join_subfields_with
557    
558    Define delimiter which will be used to join repeatable subfields. You can
559    specify option here instead in L</new> if you want to have per-record control.
560    
561    =item regexpes
562    
563    Override C<regexpes> specified in L</new>.
564    
565    =back
566    
567  =cut  =cut
568    
569  sub to_hash {  sub to_hash {
570          my $self = shift;          my $self = shift;
571    
572    
573          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
574            my $arg;
575    
576            if (ref($mfn) eq 'HASH') {
577                    $arg = $mfn;
578                    $mfn = $arg->{mfn} || confess "need mfn in arguments";
579            }
580    
581            $arg->{regexpes} ||= $self->{regexpes};
582    
583            confess "regexps must be HASH" if ($arg->{regexps} && ref($arg->{regexps}) ne 'HASH');
584    
585          # init record to include MFN as field 000          # init record to include MFN as field 000
586          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
587    
588          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
589    
590          foreach my $k (keys %{$row}) {          my $j_rs = $arg->{join_subfields_with};
591                  foreach my $l (@{$row->{$k}}) {          $j_rs = $self->{join_subfields_with} unless(defined($j_rs));
592            my $i_sf = $arg->{include_subfields};
593    
594            foreach my $f_nr (keys %{$row}) {
595                    foreach my $l (@{$row->{$f_nr}}) {
596    
597                          # filter output                          # filter output
598                          if ($self->{'hash_filter'}) {                          if ($self->{'hash_filter'}) {
# Line 487  sub to_hash { Line 600  sub to_hash {
600                                  next unless defined($l);                                  next unless defined($l);
601                          }                          }
602    
603                            # apply regexps
604                            if ($arg->{regexps} && defined($arg->{regexps}->{$f_nr})) {
605                                    confess "regexps->{$f_nr} must be ARRAY" if (ref($arg->{regexps}->{$f_nr}) ne 'ARRAY');
606                                    my $c = 0;
607                                    foreach my $r (@{ $arg->{regexps}->{$f_nr} }) {
608                                            while ( eval '$l =~ ' . $r ) { $c++ };
609                                    }
610                                    warn "## field $f_nr triggered $c regexpes\n" if ($c && $self->{debug});
611                            }
612    
613                          my $val;                          my $val;
614                            my $r_sf;       # repeatable subfields in this record
615    
616                          # has identifiers?                          # has identifiers?
617                          ($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 620  sub to_hash {
620                          if ($l =~ m/\^/) {                          if ($l =~ m/\^/) {
621                                  foreach my $t (split(/\^/,$l)) {                                  foreach my $t (split(/\^/,$l)) {
622                                          next if (! $t);                                          next if (! $t);
623                                          $val->{substr($t,0,1)} = substr($t,1);                                          my ($sf,$v) = (substr($t,0,1), substr($t,1));
624                                            # XXX this might be option, but why?
625                                            next unless ($v);
626    #                                       warn "### $f_nr^$sf:$v",$/ if ($self->{debug} > 1);
627    
628                                            if (ref( $val->{$sf} ) eq 'ARRAY') {
629    
630                                                    push @{ $val->{$sf} }, $v;
631    
632                                                    # record repeatable subfield it it's offset
633                                                    push @{ $val->{subfields} }, ( $sf, $#{ $val->{$sf} } ) if (! $j_rs && $i_sf);
634                                                    $r_sf->{$sf}++;
635    
636                                            } elsif (defined( $val->{$sf} )) {
637    
638                                                    # convert scalar field to array
639                                                    $val->{$sf} = [ $val->{$sf}, $v ];
640    
641                                                    push @{ $val->{subfields} }, ( $sf, 1 ) if (! $j_rs && $i_sf);
642                                                    $r_sf->{$sf}++;
643    
644                                            } else {
645                                                    $val->{$sf} = $v;
646                                                    push @{ $val->{subfields} }, ( $sf, 0 ) if ($i_sf);
647                                            }
648                                  }                                  }
649                          } else {                          } else {
650                                  $val = $l;                                  $val = $l;
651                          }                          }
652    
653                          push @{$rec->{$k}}, $val;                          if ($j_rs) {
654                                    map {
655                                            $val->{$_} = join($j_rs, @{ $val->{$_} });
656                                    } keys %$r_sf
657                            }
658    
659                            push @{$rec->{$f_nr}}, $val;
660                  }                  }
661          }          }
662    
# Line 615  module with databases from programs othe Line 769  module with databases from programs othe
769  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
770  know any details about it's version.  know any details about it's version.
771    
772    =head1 VERSIONS
773    
774    As this is young module, new features are added in subsequent version. It's
775    a good idea to specify version when using this module like this:
776    
777      use Biblio::Isis 0.21
778    
779    Below is list of changes in specific version of module (so you can target
780    older versions if you really have to):
781    
782    =over 8
783    
784    =item 0.21
785    
786    Added C<join_subfields_with> to L</new> and L</to_hash>.
787    
788    Added C<include_subfields> to L</to_hash>.
789    
790    =item 0.20
791    
792    Added C<< $isis->mfn >>, support for repeatable subfields and
793    C<< $isis->to_hash({ mfn => 42, ... }) >> calling convention
794    
795    =back
796    
797  =head1 AUTHOR  =head1 AUTHOR
798    
799          Dobrica Pavlinusic          Dobrica Pavlinusic
# Line 636  LICENSE file included with this module. Line 815  LICENSE file included with this module.
815    
816  =head1 SEE ALSO  =head1 SEE ALSO
817    
818    L<Biblio::Isis::Manual> for CDS/ISIS manual appendix F, G and H which describe file format
819    
820  OpenIsis web site L<http://www.openisis.org>  OpenIsis web site L<http://www.openisis.org>
821    
822  perl4lib site L<http://perl4lib.perl.org>  perl4lib site L<http://perl4lib.perl.org>
Legend:
Removed from v.45  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.26