MARC-Loader-0.004001/0000755000175000017500000000000011625654707014101 5ustar stephanestephaneMARC-Loader-0.004001/lib/0000755000175000017500000000000011625643265014644 5ustar stephanestephaneMARC-Loader-0.004001/t/0000755000175000017500000000000011625670247014341 5ustar stephanestephaneMARC-Loader-0.004001/lib/MARC/0000755000175000017500000000000011625665126015366 5ustar stephanestephaneMARC-Loader-0.004001/Changes0000644000175000017500000000076111625654675015404 0ustar stephanestephaneRevision history for MARC-Loader 0.004 Fri August 26 10:29:00 EDT 2011 - add ability to define many controlfields with same field name 0.003 Mon July 11 16:53:00 EDT 2011 - add ability to reorder fields and subfields in a chosen order 0.002 Tue May 3 14:53:00 EDT 2011 - add support of controlfields - add ability to define the record's leader - add ability to reorder fields and subfields of each field in alphabetical order - add ability to remove non-sorting characters MARC-Loader-0.004001/Makefile.PL0000644000175000017500000000112411524005263016032 0ustar stephanestephane# Note: this file was auto-generated by Module::Build::Compat version 0.3603 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'MARC::Loader', 'VERSION_FROM' => 'lib/MARC/Loader.pm', 'PREREQ_PM' => { 'Data::Compare' => 0, 'MARC::Record' => '0', 'Scalar::Util' => '0', 'Test::More' => 0, 'YAML' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; MARC-Loader-0.004001/MANIFEST0000644000175000017500000000012211524005263015206 0ustar stephanestephaneBuild.PL Changes lib/MARC/Loader.pm MANIFEST META.yml README t/test.t Makefile.PL MARC-Loader-0.004001/README0000644000175000017500000000046411524005263014746 0ustar stephanestephaneMARC-Loader INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install COPYRIGHT AND LICENCE Copyright (C) 2011 Stéphane Delaune This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. MARC-Loader-0.004001/Build.PL0000644000175000017500000000105111524005263015353 0ustar stephanestephaneuse 5.010000; use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'MARC::Loader' , license => 'perl' , dist_version_from => 'lib/MARC/Loader.pm' , create_makefile_pl => 'traditional' , dist_author => 'Stephane Delaune ' , add_to_cleanup => [ 'MARC-Loader-*' ] , requires => {qw< Scalar::Util 0 MARC::Record 0 >} , build_requires => {qw< Test::More 0 Data::Compare 0 YAML 0 >} ); $builder->create_build_script; MARC-Loader-0.004001/META.yml0000644000175000017500000000111311625654707015346 0ustar stephanestephane--- abstract: 'Perl module for creating MARC record from a hash' author: - 'Stephane Delaune ' build_requires: Data::Compare: 0 Test::More: 0 YAML: 0 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3603' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: MARC-Loader provides: MARC::Loader: file: lib/MARC/Loader.pm version: 0.004001 requires: MARC::Record: 0 Scalar::Util: 0 resources: license: http://dev.perl.org/licenses/ version: 0.004001 MARC-Loader-0.004001/t/test.t0000755000175000017500000001604311625667033015513 0ustar stephanestephane#!/usr/bin/perl use Data::Compare; use strict; use warnings; use lib qw( lib ../lib ); use YAML; use Test::More 'no_plan'; BEGIN { use_ok( 'MARC::Loader' ); } my $r={ 'ldr' => 'optionnal_leader', 'orderfields' => 0, 'ordersubfields' => 0, 'cleannsb' => 1, 'f005' => [ { 'f005_' => 'controlfield_contenta' }, { 'f005_' => 'controlfield_contentb' } ], 'f006_' => 'controlfield_content', 'f995' => [ { '001##f995e' => 'Salle de lecture 1', '002##f995b' => 'MP', '003##f995k' => 'NT 0380/6/1', '004##f995c' => 'MPc', '005##f995f' => '8001-ex', '006##f995r' => 'PRET', '007##f995o' => '0' }, { 'i9951' => '1', 'i9952' => '2', 'f995e' => 'Salle de lecture 2', 'f995b' => 'MP', 'f995k' => 'NT 0380/6/1', 'f995c' => 'MPc', 'f995f' => '8002-ex', 'f995r' => 'PRET', 'f995o' => '0' }, { 'f995e' => 'Salle de lecture 3', 'f995b' => 'MPS', 'f995k' => 'MIS 0088', 'f995c' => 'MPS', 'f995f' => '8003-ex', 'f995r' => 'PRET', 'f995o' => '0' } ], 'f215a' => [ '201' ], 'f615' => [ { 'f615a' => 'CATHEDRALE' }, { 'f615a' => 'BATISSEUR' } ], 'f210a' => [ 'Paris' ], '001##f300' => [ { 'f300a' => 'tabl. photos' } ], 'f035a' => '8002', 'i0992' => '4', 'f702' => [ { 'f702f' => '1090?-1153', 'f7024' => '730', 'f702a' => 'Bernard de Clairvaux' } ], 'f010d' => '45', 'f200a' => "\x88Les \x89ouvriers des calanques", 'i0991' => '3', 'f210c' => [ 'La Martiniere' ], 'f010a' => [ '111242417X' ], 'f461' => [ { 'f461v' => '48' }, { 'f461v' => '61' } ], 'f099c' => '2011-02-03', 'f700' => [ { 'f700f' => '', 'f700a' => 'ICHERFrancois' }, { 'f700f' => '1353? - 1435', 'f700a' => 'PAULUS', 'f700b' => [ 'jean','francois'] } ], 'f099d' => '', 'f225' => [ { 'f225a' => 'Sources calanquaises', 'f225v' => '48' }, { 'f225a' => 'Calanquaises Kommentar', 'f225v' => '61' } ], 'f210d' => '1998', 'f200g' => [ 'ITHER, fred', 'Facundus,hector (05..?-0571?)', 'Bernard de Clairvaux (saint ; 1090?-1153)' ], 'f101a' => [ 'lat', 'fre', 'ger', 'gem', 'por', 'spa' ], 'f099t' => 'LIVRE', 'f200f' => 'ICHERFrancois, PAULUS, MARIA 1353? - 1435', 'f330' => [], 'f701' => [ { 'f701f' => '', 'f701a' => 'ITHER', 'f701b' => 'fred' }, { 'f701f' => '05..?-0571?', 'f701a' => 'Facundus', 'f701b' => 'hector' } ], 'f215c' => 'ill. coul.' }; my $record = MARC::Loader->new($r); #my $v1=YAML::Dump $record->as_formatted; #print recordtostring($record); my $v1=recordtostring($record); my $v2="optionnal_leader||||005:controlfield_contenta||005:controlfield_contentb||006:controlfield_content||010: |a:111242417X|d:45||035: |a:8002||099:34|c:2011-02-03|t:LIVRE||101: |a:fre|a:gem|a:ger|a:lat|a:por|a:spa||200: |a:Les ouvriers des calanques|f:ICHERFrancois, PAULUS, MARIA 1353? - 1435|g:Bernard de Clairvaux (saint ; 1090?-1153)|g:Facundus,hector (05..?-0571?)|g:ITHER, fred||210: |a:Paris|c:La Martiniere|d:1998||215: |a:201|c:ill. coul.||225: |a:Calanquaises Kommentar|v:61||225: |a:Sources calanquaises|v:48||300: |a:tabl. photos||461: |v:48||461: |v:61||615: |a:BATISSEUR||615: |a:CATHEDRALE||700: |a:ICHERFrancois||700: |a:PAULUS|b:francois|b:jean|f:1353? - 1435||701: |a:Facundus|b:hector|f:05..?-0571?||701: |a:ITHER|b:fred||702: |4:730|a:Bernard de Clairvaux|f:1090?-1153||995: |b:MPS|c:MPS|e:Salle de lecture 3|f:8003-ex|k:MIS 0088|o:0|r:PRET||995: |b:MP|c:MPc|e:Salle de lecture 1|f:8001-ex|k:NT 0380/6/1|o:0|r:PRET||995:12|b:MP|c:MPc|e:Salle de lecture 2|f:8002-ex|k:NT 0380/6/1|o:0|r:PRET"; sub recordtostring { my ($record) = @_; my $string=""; my $finalstring=$record->leader; my %tag_names = map( { $$_{_tag} => 1 } $record->fields); my @order = qw/0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/; foreach my $tag(sort({ $a cmp $b } keys(%tag_names))) { my @fields=$record->field($tag); foreach my $field(@fields) { $string.="|#f#|$tag:"; if ($field->is_control_field()) { $string.=$field->data(); } else { $string.=$field->indicator(1); $string.=$field->indicator(2); foreach my $key (@order) { foreach my $subfield (sort({ $a cmp $b } $field->subfield($key))) { $string.="|$key:".$subfield; } } } } } my @arec = split(/\|#f#\|/,$string);#warn Data::Dumper::Dumper @arec; foreach my $tempstring (sort({ $a cmp $b } @arec)) { $finalstring.="||$tempstring"; } return $finalstring; } ok(Compare($v1,$v2)) or diag(Dump $v1); #print $record->as_formatted; MARC-Loader-0.004001/lib/MARC/Loader.pm0000644000175000017500000002401011625665126017127 0ustar stephanestephane# vim: sw=4 package MARC::Loader; use 5.10.0; use warnings; use strict; use Carp; use MARC::Record; use YAML; use Scalar::Util qw< reftype >; our $VERSION = '0.004001'; our $DEBUG = 0; sub debug { $DEBUG and say STDERR @_ } sub new { my ($self,$data) = @_; my $r = MARC::Record->new(); my $orderfields = 0; my $ordersubfields = 0; my $cleannsb = 0; my $lc={};#the controlfield's list my $lf={};#the field's list my $cf={};#counter where multiple fields with same name my $bf={};#bool ok if field have one subfield at least if (defined($$data{"ldr"}) and $$data{"ldr"} ne "") { $r->leader($$data{"ldr"}); } if ($$data{"orderfields"}) { $orderfields=1; } if ($$data{"ordersubfields"}) { $ordersubfields=1; } if ($$data{"cleannsb"}) { $cleannsb=1; } foreach my $k ( sort {$a cmp $b} keys(%$data) ) { if (($k eq "ldr") or ($k eq "orderfields") or ($k eq "ordersubfields") or ($k eq "cleannsb")) { next; } if ( ref( $$data{$k} ) eq "ARRAY" ) { foreach my $v ( sort {$a cmp $b} @{$$data{$k}} ) { createfield($k,$lc,$lf,$bf,$cf,$v,$cleannsb); } } else { createfield($k,$lc,$lf,$bf,$cf,$$data{$k},$cleannsb); } } foreach my $contk ( sort {$a cmp $b} keys(%$lc) ) { if($orderfields) { $r->insert_fields_ordered( $$lc{$contk} ); } else { $r->append_fields( $$lc{$contk} ); } } foreach my $k ( sort {$a cmp $b} keys(%$lf) ) { if ($$bf{$k}==1) { $$lf{$k}->delete_subfield(pos => 0); if($orderfields) { $r->insert_fields_ordered( $$lf{$k} ); } else { $r->append_fields( $$lf{$k} ); } } } $r; } sub createfield { my ($k,$lc,$lf,$bf,$cf,$v,$cleannsb) = @_; #$k = the hash key that defines the field or subfield name #$v = the field or subfield value #$lc= the controlfield's list #$lf= the field's list #$cf= counter where multiple fields with same name #$bf= bool ok if field have one subfield at least my $prefield=""; if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) { $prefield=$1 if $1; if (!exists($$lf{$prefield.$4})) { if($4<10 and defined($v) and $v ne "") { $v=nsbclean($v) if $cleannsb; $$lc{$prefield.$4} = MARC::Field->new( "$4", $v ); } else { $$lf{$prefield.$4} = MARC::Field->new( "$4", "", "", 0 => "temp" ); #$fnoauth = MARC::Field->new( '009', $noauth ); $$bf{$prefield.$4}=0; if (defined($v) and $v ne "") { $v=nsbclean($v) if $cleannsb; createsubfield($$lf{$prefield.$4},$5,$v,$k); $$bf{$prefield.$4}=1; } } } else { if (defined($v) and $v ne "") { $v=nsbclean($v) if $cleannsb; createsubfield($$lf{$prefield.$4},$5,$v,$k); $$bf{$prefield.$4}=1; } } } elsif (($k=~/^((.*)##)?(\D)(\d{3})$/) and ( ref( $v ) eq "HASH" )) { $prefield=$1 if $1; if (!exists($$cf{$prefield.$4})) { $$cf{$prefield.$4}=0; } $$cf{$prefield.$4}++; if($4<10){ foreach my $k ( sort {$a cmp $b} keys(%$v) ) { if (defined($$v{$k}) and $$v{$k} ne "") { if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) { $$v{$k}=nsbclean($$v{$k}) if $cleannsb; $$lc{$prefield.$4.$$cf{$prefield.$4}} = MARC::Field->new( "$4", $$v{$k} ); $$bf{$prefield.$4.$$cf{$prefield.$4}}=1; } else { warn "wrong field name : $k";return; } } } } else { $$lf{$prefield.$4.$$cf{$prefield.$4}} = MARC::Field->new( "$4", "", "", 0 => "temp" ); $$bf{$prefield.$4.$$cf{$prefield.$4}}=0; foreach my $k ( sort {$a cmp $b} keys(%$v) ) { if (defined($$v{$k}) and $$v{$k} ne "" and ref($$v{$k}) eq "ARRAY" ) { foreach my $v ( sort {$a cmp $b} @{$$v{$k}} ) { if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) { $v=nsbclean($v) if $cleannsb; createsubfield($$lf{$prefield.$4.$$cf{$prefield.$4}},$5,$v,$k); $$bf{$prefield.$4.$$cf{$prefield.$4}}=1; } else { warn "wrong field name : $k";return; } } } elsif (defined($$v{$k}) and $$v{$k} ne "") { if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) { $$v{$k}=nsbclean($$v{$k}) if $cleannsb; createsubfield($$lf{$prefield.$4.$$cf{$prefield.$4}},$5,$$v{$k},$k); $$bf{$prefield.$4.$$cf{$prefield.$4}}=1; } else { warn "wrong field name : $k";return; } } } } } else { warn "wrong field name : $k";return; } } sub createsubfield { my ($f,$s,$v,$k)=@_; #$f = the field #$s = the subfield name #$k = the hash key that defines the subfield name #$v = the subfield value if ($k=~/^((.*)##)?(i)(\d{3})(\w)$/) { my $ind=$5; if ( ($5=~/1|2/) and ($v=~/\d|\|/) ) { $f->update( "ind$ind" => $v); } else { warn "wrong ind values : $k=$v";return; } } else { $f->add_subfields( "$s" => $v ); } } sub nsbclean { my ($string) = @_ ; $_ = $string ; s/\x88//g ;# NSB : begin Non Sorting Block s/\x89//g ;# NSE : Non Sorting Block end s/\x98//g ;# NSB : begin Non Sorting Block s/\x9C//g ;# NSE : Non Sorting Block end s/\xC2//g ;# What is this char ? It is sometimes left by the regexp after removing NSB / NSE $string = $_ ; return($string) ; } 1; __END__ =head1 NAME MARC::Loader - Perl module for creating MARC record from a hash =head1 VERSION Version 0.004001 =head1 SYNOPSIS use MARC::Loader; my $foo={ 'ldr' => 'optionnal_leader', 'cleannsb' => 1, 'f005' => [ { 'f005_' => 'controlfield_contenta' }, { 'f005_' => 'controlfield_contentb' } ], 'f006_' => 'controlfield_content', 'f010d' => '45', 'f099c' => '2011-02-03', 'f099t' => 'LIVRE', 'i0991' => '3', 'i0992' => '4', 'f200a' => "\x88le \x89titre", '001##f101a' => ['lat','fre','spa'], 'f215a' => [ 'test' ], 'f700' => [ { 'f700f' => '1900-1950', 'f700a' => 'ICHER', 'f700b' => ['jean','francis'] }, { 'f700f' => '1353? - 1435', 'f700a' => 'PAULUS', 'f700b' => 'MARIA'} ], 'f995' => [ { 'f995e' => 'S1', 'f995b' => 'MP', 'f995f' => '8002-ex' }, { '001##f995e' => 'S2', '002##f995b' => 'MP', '005##f995f' => '8001-ex' } ] }; my $record = MARC::Loader->new($foo); # Here, the command "print $record->as_formatted;" will return : # LDR optionnal_leader # 005 controlfield_contenta # 005 controlfield_contentb # 006 controlfield_content # 101 _afre # _alat # _aspa # 010 _d45 # 099 34 _c2011-02-03 # _tLIVRE # 200 _ale titre # 215 _atest # 700 _aICHER # _bfrancis # _bjean # _f1900-1950 # 700 _aPAULUS # _bMARIA # _f1353? - 1435 # 995 _bMP # _eS1 # _f8002-ex # 995 _eS2 # _bMP # _f8001-ex =head1 DESCRIPTION This is a Perl module for creating MARC records from a hash variable. MARC::Loader use MARC::Record. =head3 Hash keys naming convention. The names of hash keys are very important. They must begin with letter B followed by the B<3-digit> field name ( e.g. f099), followed, for the subfields, by their B ( e.g. B). Repeatable fields are arrays of hash ( e.g., 'f700' => [{'f700f' => '1900','f700a' => 'ICHER'},{'f700f' => '1353','f700a' => 'PAULUS'}] ). Repeatable subfields are arrays ( e.g., 'f101a' => [ 'lat','fre','spa'] ). Controlfields are automatically detected when the hash key begin with letter B followed by B<3-digit lower than 10> followed by B ( e.g. B). Indicators must begin with the letter i followed by the 3-digit field name followed by the indicator's position (1 or 2) : e.g. C. Record's leader can be defined with the hash key 'ldr' ( e.g., 'ldr' => 1 ). =head3 reorder fields and subfields Fields and subfields are in lexically order. If you want reorder fields and subfields differently, you can add a reordering string (necessarily followed by ##) at the beginning of hash keys (e.g., to reorder the subfields of f995 to have $e followed by $b : 'f995' => [{'001##f995e' => 'S2','002##f995b' => 'MP')]};). If you want to reorder fields, please note that the controlfields will always be located before the other (e.g., if you define '001##f101a' => [ 'lat','fre','spa'] , the f101 will be placed after the last controlfield ). Be careful, the reorder is made lexically, not numerically : 10 will be placed before 2, while 002 will be placed before 010. If the script you use to build your hash requires you to precede fields AND subfields with a reordering string when you want to reorder only those sub-fields, you can force the module to reorder the fields in alphabetical order with an hash key named 'orderfields' ( e.g., 'orderfields' => 1 ). You can also remove non-sorting characters with an hash key named 'cleannsb' ( e.g., 'cleannsb' => 1 ). =head1 METHOD =head2 new() =over 4 =item * $record = MARC::Loader->new($foo); This is the only method provided by the module. =back =head1 AUTHOR Stephane Delaune, (delaune.stephane at gmail.com) =head1 COPYRIGHT Copyright 2011 Stephane Delaune for Biblibre.com, all rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO =over 4 =item * MARC::Record (L) =item * MARC::Field (L) =item * Library Of Congress MARC pages (L) The definitive source for all things MARC. =cut