/[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 582 by dpavlin, Tue Jul 4 11:36:21 2006 UTC revision 1187 by dpavlin, Wed May 20 14:23:54 2009 UTC
# Line 5  use strict; Line 5  use strict;
5    
6  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
7    
8  use MARC::Record 2.0;   # need 2.0 for utf-8 encoding see marcpm.sf.net  use MARC::Record;
9  use MARC::Lint;  use MARC::Lint;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11    
# Line 15  WebPAC::Output::MARC - Create MARC recor Line 15  WebPAC::Output::MARC - Create MARC recor
15    
16  =head1 VERSION  =head1 VERSION
17    
18  Version 0.01  Version 0.04
19    
20  =cut  =cut
21    
22  our $VERSION = '0.01';  our $VERSION = '0.04';
23    
24  =head1 SYNOPSIS  =head1 SYNOPSIS
25    
# Line 33  L<WebPAC::Normalize>. Line 33  L<WebPAC::Normalize>.
33    
34    my $marc = new WebPAC::Output::MARC(    my $marc = new WebPAC::Output::MARC(
35          path => '/path/to/output.marc',          path => '/path/to/output.marc',
36          encoding => 'utf-8',          marc_encoding => 'utf-8',
37          lint => 1,          lint => 1,
38          dump => 0,          dump => 0,
39    )    )
# Line 52  sub new { Line 52  sub new {
52                          $log->warn("Can't create MARC::Lint object, linting is disabled");                          $log->warn("Can't create MARC::Lint object, linting is disabled");
53          }          }
54    
55            $self->{marc_encoding} ||= 'utf-8';
56    
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)' : '', " encoding ", $self->{marc_encoding}, "\n");
63          } else {          } else {
64                  $log->logconfess("new called without path");                  $log->logconfess("new called without path");
65          }          }
66    
         $self->{encoding} ||= 'utf-8';  
   
67          $self ? return $self : return undef;          $self ? return $self : return undef;
68  }  }
69    
# Line 71  sub new { Line 72  sub new {
72    $marc->add(    $marc->add(
73          id => $mfn,          id => $mfn,
74          fields => WebPAC::Normalize::_get_marc_fields(),          fields => WebPAC::Normalize::_get_marc_fields(),
75          leader => WebPAC::Normalize::marc_leader(),          leader => WebPAC::Normalize::_get_marc_leader(),
76          row => $row,          row => $row,
77    );    );
78    
# Line 91  sub add { Line 92  sub add {
92                  unless ($arg->{fields} && defined $arg->{id});                  unless ($arg->{fields} && defined $arg->{id});
93    
94          my $marc = new MARC::Record;          my $marc = new MARC::Record;
95          $marc->encoding( $self->{encoding} );          $marc->encoding( $self->{marc_encoding} );
96    
97          my $id = $self->{id};          my $id = $arg->{id};
98    
99          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');          $log->logconfess("fields isn't array") unless (ref($arg->{fields}) eq 'ARRAY');
100    
101          $marc->add_fields( @{ $arg->{fields} } );          my $fields = $arg->{fields};
102    
103            $log->debug("original fields = ", sub { dump( $fields ) });
104    
105            # recode fields to marc_encoding
106            foreach my $j ( 0 .. $#$fields ) {
107                    foreach my $i ( 0 .. ( ( $#{$fields->[$j]} - 3 ) / 2 ) ) {
108                            my $f = $fields->[$j]->[ ($i * 2) + 4 ];
109                            $fields->[$j]->[ ($i * 2) + 4 ] = $f;
110                    }
111            }
112    
113            # sort fields
114            @$fields = sort { $a->[0] <=> $b->[0] } @$fields;
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 117  sub add { Line 135  sub add {
135                  my @w = $self->{lint}->warnings;                  my @w = $self->{lint}->warnings;
136                  if (@w) {                  if (@w) {
137                          $log->error("MARC lint detected warning on record $id\n",                          $log->error("MARC lint detected warning on record $id\n",
138                                  "<<<<< Original imput row:\n",dump($arg->{row}), "\n",                                  "<<<<< Original input row:\n",dump($arg->{row}), "\n",
139                                  ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $arg->{fields} ), "\n",                                  ">>>>> Normalized MARC row: leader: [", $marc->leader(), "]\n", dump( $fields ), "\n",
140                                  "!!!!! MARC lint warnings:\n",join("\n",@w),"\n"                                  "!!!!! MARC lint warnings:\n",join("\n",@w),"\n"
141                          );                          );
142                          map { $self->{_marc_lint_warnings}->{$_}++ } @w;                          map { $self->{_marc_lint_warnings}->{$_}++ } @w;
# Line 127  sub add { Line 145  sub add {
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( $fields ), "\n",
150                  );                  );
151          }          }
152    
Legend:
Removed from v.582  
changed lines
  Added in v.1187
  ViewVC Help
Powered by ViewVC 1.1.26