/[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 621 by dpavlin, Fri Aug 25 18:06:42 2006 UTC revision 753 by dpavlin, Sun Oct 8 18:43:58 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.04
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.04';
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 55  sub new { Line 57  sub new {
57          if (my $path = $self->{path}) {          if (my $path = $self->{path}) {
58                  open($self->{fh}, '>', $path) ||                  open($self->{fh}, '>', $path) ||
59                          $log->logdie("can't open MARC output $path: $!");                          $log->logdie("can't open MARC output $path: $!");
60                    binmode($self->{fh}, ':utf8');
61    
62                  $log->info("Creating MARC export file $path", $self->{lint} ? ' (with lint)' : '', "\n");                  $log->info("Creating MARC export file $path", $self->{lint} ? ' (with lint)' : '', "\n");
63          } else {          } else {
64                  $log->logconfess("new called without path");                  $log->logconfess("new called without path");
65          }          }
66    
67          $self->{encoding} ||= 'utf-8';          $self->{native_encoding} ||= 'iso-8859-2';
68            $self->{marc_encoding} ||= 'utf-8';
69    
70          $self ? return $self : return undef;          $self ? return $self : return undef;
71  }  }
# Line 91  sub add { Line 95  sub add {
95                  unless ($arg->{fields} && defined $arg->{id});                  unless ($arg->{fields} && defined $arg->{id});
96    
97          my $marc = new MARC::Record;          my $marc = new MARC::Record;
98          $marc->encoding( $self->{encoding} );          $marc->encoding( $self->{marc_encoding} );
99    
100          my $id = $arg->{id};          my $id = $arg->{id};
101    
102          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');
103    
104          $marc->add_fields( @{ $arg->{fields} } );          my $fields = $arg->{fields};
105    
106            $log->debug("original fields = ", sub { dump( $fields ) });
107    
108            # recode fields to marc_encoding
109            foreach my $j ( 0 .. $#$fields ) {
110                    foreach my $i ( 0 .. ( ( $#{$fields->[$j]} - 3 ) / 2 ) ) {
111                            my $f = $fields->[$j]->[ ($i * 2) + 4 ];
112                            $f = decode( $self->{native_encoding}, $f );
113                            $fields->[$j]->[ ($i * 2) + 4 ] = $f;
114                    }
115            }
116    
117            # sort fields
118            @$fields = sort { $a->[0] <=> $b->[0] } @$fields;
119    
120            $log->debug("recode fields = ", sub { dump( $fields ) });
121    
122            $marc->add_fields( @$fields );
123    
124          # tweak leader          # tweak leader
125          if (my $new_l = $arg->{leader}) {          if (my $new_l = $arg->{leader}) {
# Line 118  sub add { Line 140  sub add {
140                  if (@w) {                  if (@w) {
141                          $log->error("MARC lint detected warning on record $id\n",                          $log->error("MARC lint detected warning on record $id\n",
142                                  "<<<<< Original input row:\n",dump($arg->{row}), "\n",                                  "<<<<< Original input row:\n",dump($arg->{row}), "\n",
143                                  ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",                                  ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $fields ), "\n",
144                                  "!!!!! MARC lint warnings:\n",join("\n",@w),"\n"                                  "!!!!! MARC lint warnings:\n",join("\n",@w),"\n"
145                          );                          );
146                          map { $self->{_marc_lint_warnings}->{$_}++ } @w;                          map { $self->{_marc_lint_warnings}->{$_}++ } @w;
# Line 128  sub add { Line 150  sub add {
150          if ($self->{dump}) {          if ($self->{dump}) {
151                  $log->info("MARC record on record $id\n",                  $log->info("MARC record on record $id\n",
152                          "<<<<< Original imput row:\n",dump($arg->{row}), "\n",                          "<<<<< Original imput row:\n",dump($arg->{row}), "\n",
153                          ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",                          ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $fields ), "\n",
154                  );                  );
155          }          }
156    
Legend:
Removed from v.621  
changed lines
  Added in v.753
  ViewVC Help
Powered by ViewVC 1.1.26