/[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 578 by dpavlin, Tue Jul 4 10:34:15 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 72  sub new { Line 75  sub new {
75          id => $mfn,          id => $mfn,
76          fields => WebPAC::Normalize::_get_marc_fields(),          fields => WebPAC::Normalize::_get_marc_fields(),
77          leader => WebPAC::Normalize::marc_leader(),          leader => WebPAC::Normalize::marc_leader(),
78            row => $row,
79    );    );
80    
81    C<row> is optional parametar which is used when dumping original row to
82    error log.
83    
84  =cut  =cut
85    
86  sub add {  sub add {
# Line 87  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 = $self->{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 110  sub add { Line 132  sub add {
132    
133          if ($self->{lint}) {          if ($self->{lint}) {
134                  $self->{lint}->check_record( $marc );                  $self->{lint}->check_record( $marc );
135                  my $err = join( "\n", $self->{lint}->warnings );                  my @w = $self->{lint}->warnings;
136                  $log->error("MARC lint detected warning on record $id\n",                  if (@w) {
137                          "<<<<< Original imput row:\n",dump($arg->{row}), "\n",                          $log->error("MARC lint detected warning on record $id\n",
138                          ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",                                  "<<<<< Original input row:\n",dump($arg->{row}), "\n",
139                          "!!!!! MARC lint warnings:\n",$err,"\n"                                  ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",
140                  ) if ($err);                                  "!!!!! MARC lint warnings:\n",join("\n",@w),"\n"
141                            );
142                            map { $self->{_marc_lint_warnings}->{$_}++ } @w;
143                    }
144          }          }
145    
146          if ($self->{dump}) {          if ($self->{dump}) {
147                  $log->info("MARC record on record $id\n",                  $log->info("MARC record on record $id\n",
148                          "<<<<< Original imput row:\n",dump($self->{row}), "\n",                          "<<<<< Original imput row:\n",dump($arg->{row}), "\n",
149                          ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",                          ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",
150                  );                  );
151          }          }
152    
153          print {$self->{fh}} $marc->as_usmarc;          {
154                    use bytes;
155                    print {$self->{fh}} $marc->as_usmarc;
156            }
157    
158  }  }
159    
# Line 135  Close MARC output file Line 163  Close MARC output file
163    
164    $marc->finish;    $marc->finish;
165    
166    It will also dump MARC lint warnings summary if called with C<lint>.
167    
168  =cut  =cut
169    
170  sub finish {  sub finish {
171          my $self = shift;          my $self = shift;
172    
173          close( $self->{fh} ) or $self->_get_logger->logdie("can't close ", $self->{path}, ": $!");          my $log = $self->get_logger;
174    
175            close( $self->{fh} ) or $log->logdie("can't close ", $self->{path}, ": $!");
176    
177            if (my $w = $self->{_marc_lint_warnings}) {
178                    $log->error("MARC lint warnings summary:\n",
179                            join ("\n",
180                                    map { $w->{$_} . "\t" . $_ }
181                                    sort { $w->{$b} <=> $w->{$a} } keys %$w
182                            )
183                    );
184            }
185  }  }
186    
187  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.578  
changed lines
  Added in v.626
  ViewVC Help
Powered by ViewVC 1.1.26