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

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

revision 625 by dpavlin, Fri Aug 25 18:06:42 2006 UTC revision 626 by dpavlin, Mon Sep 4 16:15:07 2006 UTC
# Line 8  use base qw/WebPAC::Common/; Line 8  use base qw/WebPAC::Common/;
8  use MARC::Record 2.0;   # need 2.0 for utf-8 encoding see marcpm.sf.net  use MARC::Record 2.0;   # need 2.0 for utf-8 encoding see marcpm.sf.net
9  use MARC::Lint;  use MARC::Lint;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11    use Encode qw/from_to decode/;
12    
13  =head1 NAME  =head1 NAME
14    
# Line 15  WebPAC::Output::MARC - Create MARC recor Line 16  WebPAC::Output::MARC - Create MARC recor
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.01  Version 0.02
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.02';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
# Line 33  L<WebPAC::Normalize>. Line 34  L<WebPAC::Normalize>.
34    
35    my $marc = new WebPAC::Output::MARC(    my $marc = new WebPAC::Output::MARC(
36          path => '/path/to/output.marc',          path => '/path/to/output.marc',
37          encoding => 'utf-8',          native_encoding => 'iso-8859-2',
38            marc_encoding => 'utf-8',
39          lint => 1,          lint => 1,
40          dump => 0,          dump => 0,
41    )    )
# Line 61  sub new { Line 63  sub new {
63                  $log->logconfess("new called without path");                  $log->logconfess("new called without path");
64          }          }
65    
66          $self->{encoding} ||= 'utf-8';          $self->{native_encoding} ||= 'iso-8859-2';
67            $self->{marc_encoding} ||= 'utf-8';
68    
69          $self ? return $self : return undef;          $self ? return $self : return undef;
70  }  }
# Line 91  sub add { Line 94  sub add {
94                  unless ($arg->{fields} && defined $arg->{id});                  unless ($arg->{fields} && defined $arg->{id});
95    
96          my $marc = new MARC::Record;          my $marc = new MARC::Record;
97          $marc->encoding( $self->{encoding} );          $marc->encoding( $self->{marc_encoding} );
98    
99          my $id = $arg->{id};          my $id = $arg->{id};
100    
101          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');
102    
103          $marc->add_fields( @{ $arg->{fields} } );          my $fields = $arg->{fields};
104    
105            $log->debug("original fields = ", sub { dump( $fields ) });
106    
107            # recode fields to marc_encoding
108            foreach my $j ( 0 .. $#$fields ) {
109                    foreach my $i ( 0 .. ( ( $#{$fields->[$j]} - 3 ) / 2 ) ) {
110                            my $f = $fields->[$j]->[ ($i * 2) + 4 ];
111                            $f = decode( $self->{native_encoding}, $f );
112                            $fields->[$j]->[ ($i * 2) + 4 ] = $f;
113                    }
114            }
115    
116            $log->debug("recode fields = ", sub { dump( $fields ) });
117    
118            $marc->add_fields( @$fields );
119    
120          # tweak leader          # tweak leader
121          if (my $new_l = $arg->{leader}) {          if (my $new_l = $arg->{leader}) {
# Line 132  sub add { Line 150  sub add {
150                  );                  );
151          }          }
152    
153          print {$self->{fh}} $marc->as_usmarc;          {
154                    use bytes;
155                    print {$self->{fh}} $marc->as_usmarc;
156            }
157    
158  }  }
159    

Legend:
Removed from v.625  
changed lines
  Added in v.626

  ViewVC Help
Powered by ViewVC 1.1.26