/[webpac2]/trunk/lib/WebPAC/Normalize.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/WebPAC/Normalize.pm

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

revision 618 by dpavlin, Fri Aug 25 12:31:01 2006 UTC revision 641 by dpavlin, Wed Sep 6 20:54:47 2006 UTC
# Line 4  use Exporter 'import'; Line 4  use Exporter 'import';
4          _set_rec _set_lookup          _set_rec _set_lookup
5          _get_ds _clean_ds          _get_ds _clean_ds
6          _debug          _debug
7            _pack_subfields_hash
8    
9          tag search display          tag search display
10          marc marc_indicators marc_repeatable_subfield          marc marc_indicators marc_repeatable_subfield
# Line 36  WebPAC::Normalize - describe normalisato Line 37  WebPAC::Normalize - describe normalisato
37    
38  =head1 VERSION  =head1 VERSION
39    
40  Version 0.16  Version 0.17
41    
42  =cut  =cut
43    
44  our $VERSION = '0.16';  our $VERSION = '0.17';
45    
46  =head1 SYNOPSIS  =head1 SYNOPSIS
47    
# Line 540  sub marc_compose { Line 541  sub marc_compose {
541    
542          warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2);          warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2);
543    
544            if ($#_ % 2 != 1) {
545                    die "ERROR: marc_compose",dump($f,@_)," not valid (must be even).\nDo you need to add first() or join() around some argument?\n";
546            }
547    
548          while (@_) {          while (@_) {
549                  my $sf = shift or die "marc_compose $f needs subfield";                  my $sf = shift;
550                  my $v = shift;                  my $v = shift;
551    
552                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
# Line 718  sub marc_original_order { Line 723  sub marc_original_order {
723  This function should be used inside functions to create C<data_structure> described  This function should be used inside functions to create C<data_structure> described
724  above.  above.
725    
726    =head2 _pack_subfields_hash
727    
728     @values = _pack_subfields_hash( $h, $include_subfields )
729    
730    =cut
731    
732    sub _pack_subfields_hash {
733    
734            warn "## _pack_subfields_hash( ",dump(@_), " )\n";
735    
736            my ($h,$include_subfields) = @_;
737    
738    
739            if ( defined($h->{subfields}) ) {
740                    my $sfs = delete $h->{subfields} || die "no subfields?";
741                    my @out;
742                    while (@$sfs) {
743                            my $sf = shift @$sfs;
744                            push @out, '^' . $sf if ($include_subfields);
745                            my $o = shift @$sfs;
746                            if ($o == 0 && ref( $h->{$sf} ) ne 'ARRAY' ) {
747                                    # single element subfields are not arrays
748                                    push @out, $h->{$sf};
749                            } else {
750    #warn "====> $f $sf $o $#$sfs ", dump( $sfs ), "\n";
751                                    push @out, $h->{$sf}->[$o];
752                            }
753                    }
754                    return @out;
755            } else {
756                    # FIXME this should probably be in alphabetical order instead of hash order
757                    values %{$h};
758            }
759    }
760    
761  =head2 rec1  =head2 rec1
762    
763  Return all values in some field  Return all values in some field
# Line 734  sub rec1 { Line 774  sub rec1 {
774          return unless (defined($rec) && defined($rec->{$f}));          return unless (defined($rec) && defined($rec->{$f}));
775          warn "rec1($f) = ", dump( $rec->{$f} ), $/ if ($debug > 1);          warn "rec1($f) = ", dump( $rec->{$f} ), $/ if ($debug > 1);
776          if (ref($rec->{$f}) eq 'ARRAY') {          if (ref($rec->{$f}) eq 'ARRAY') {
777                  return map {                  my @out;
778                          if (ref($_) eq 'HASH') {                  foreach my $h ( @{ $rec->{$f} } ) {
779                                  values %{$_};                          if (ref($h) eq 'HASH') {
780    warn "rec1 hash: ",dump($h),"\n";
781                                    push @out, ( _pack_subfields_hash( $h ) );
782                          } else {                          } else {
783                                  $_;                                  push @out, $h;
784                          }                          }
785                  } @{ $rec->{$f} };                  }
786                    return @out;
787          } elsif( defined($rec->{$f}) ) {          } elsif( defined($rec->{$f}) ) {
788                  return $rec->{$f};                  return $rec->{$f};
789          }          }

Legend:
Removed from v.618  
changed lines
  Added in v.641

  ViewVC Help
Powered by ViewVC 1.1.26