r5463 - in /packages/libmarc-xml-perl/trunk: META.yml debian/changelog lib/MARC/File/XML.pm

[gregoa-guest at users.alioth.debian.org]

Author: gregoa-guest
Date: Fri May 18 22:41:58 2007
New Revision: 5463

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5463
Log:
* New upstream release.

Modified:
    packages/libmarc-xml-perl/trunk/META.yml
    packages/libmarc-xml-perl/trunk/debian/changelog
    packages/libmarc-xml-perl/trunk/lib/MARC/File/XML.pm

Modified: packages/libmarc-xml-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmarc-xml-perl/trunk/META.yml?rev=5463&op=diff
==============================================================================
--- packages/libmarc-xml-perl/trunk/META.yml (original)
+++ packages/libmarc-xml-perl/trunk/META.yml Fri May 18 22:41:58 2007
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         MARC-XML
-version:      0.85
+version:      0.86
 version_from: lib/MARC/File/XML.pm
 installdirs:  site
 requires:

Modified: packages/libmarc-xml-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmarc-xml-perl/trunk/debian/changelog?rev=5463&op=diff
==============================================================================
--- packages/libmarc-xml-perl/trunk/debian/changelog (original)
+++ packages/libmarc-xml-perl/trunk/debian/changelog Fri May 18 22:41:58 2007
@@ -1,3 +1,9 @@
+libmarc-xml-perl (0.86-1) unstable; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at>  Sat, 19 May 2007 00:39:53 +0200
+
 libmarc-xml-perl (0.85-1) unstable; urgency=low
 
   * New upstream release.

Modified: packages/libmarc-xml-perl/trunk/lib/MARC/File/XML.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libmarc-xml-perl/trunk/lib/MARC/File/XML.pm?rev=5463&op=diff
==============================================================================
--- packages/libmarc-xml-perl/trunk/lib/MARC/File/XML.pm (original)
+++ packages/libmarc-xml-perl/trunk/lib/MARC/File/XML.pm Fri May 18 22:41:58 2007
@@ -14,7 +14,7 @@
 use Carp qw( croak );
 use Encode ();
 
-$VERSION = '0.85';
+$VERSION = '0.86';
 
 my $handler = MARC::File::SAX->new();
 
@@ -98,7 +98,7 @@
 =head2 MARC::File::XML->default_record_format([$format])
 
 Sets or returns the default record format used by MARC::File::XML.  Valid
-formats are B<MARC21>, B<USMARC> and B<UNIMARC>.
+formats are B<MARC21>, B<USMARC>, B<UNIMARC> and B<UNIMARCAUTH>.
 
     MARC::File::XML->default_record_format('UNIMARC');
 
@@ -117,7 +117,7 @@
 =head2 as_xml()
 
 Returns a MARC::Record object serialized in XML. You can pass an optional format
-parameter to tell MARC::File::XML what type of record (USMARC, UNIMARC) you are
+parameter to tell MARC::File::XML what type of record (USMARC, UNIMARC, UNIMARCAUTH) you are
 serializing.
 
     print $record->as_xml([$format]);
@@ -134,7 +134,7 @@
 
 Returns a MARC::Record object serialized in XML without a collection wrapper.
 You can pass an optional format parameter to tell MARC::File::XML what type of
-record (USMARC, UNIMARC) you are serializing.
+record (USMARC, UNIMARC, UNIMARCAUTH) you are serializing.
 
     print $record->as_xml_record('UNIMARC');
 
@@ -152,7 +152,7 @@
 this method to generate a MARC::Record object.  You can pass an optional
 encoding parameter to specify which encoding (UTF-8 or MARC-8) you would like
 the resulting record to be in.  You can also pass a format parameter to specify
-the source record type, such as UNIMARC, USMARC or MARC21.
+the source record type, such as UNIMARC, UNIMARCAUTH, USMARC or MARC21.
 
     my $record = MARC::Record->new_from_xml( $xml, $encoding, $format );
 
@@ -445,13 +445,23 @@
     $parser->{ tagStack } = [];
     $parser->{ subfields } = [];
     $parser->{ Handler }{ record } = MARC::Record->new();
-    $parser->{ Handler }{ toMARC8 } = (lc($format) eq 'unimarc' && $enc && lc($enc) =~ /^utf-?8$/o) ? 0 : 1;
+    $parser->{ Handler }{ toMARC8 } = decideMARC8Binary($format,$enc);
 
     $parser->parse_string( $text );
 
     return( $parser->{ Handler }{ record } );
     
 }
+
+sub decideMARC8Binary {
+	my $format = shift;
+	my $enc = shift;
+
+	return 0 if (defined($format) && lc($format) =~ /^unimarc/o);
+	return 0 if (defined($enc) && lc($enc) =~ /^utf-?8/o);
+	return 1;
+}
+
 
 =head2 encode()
 
@@ -468,8 +478,8 @@
     my $without_header = shift;
     my $enc = shift || $_load_args{DefaultEncoding};
 
-    if (lc($format) eq 'unimarc') {
-        $enc = _unimarc_encoding( $record );
+    if (lc($format) =~ /^unimarc/o) {
+        $enc = _unimarc_encoding( $format => $record );
     }
 
     my @xml = ();
@@ -481,11 +491,15 @@
 }
 
 sub _unimarc_encoding {
+	my $f = shift;
 	my $r = shift;
 
-	my $enc = substr( $r->subfield(100 => 'a'), 26, 2 );
-
-	if ($enc eq '01') {
+	my $pos = 26;
+	$pos = 13 if (lc($f) eq 'unimarcauth');
+
+	my $enc = substr( $r->subfield(100 => 'a'), $pos, 2 );
+
+	if ($enc eq '01' || $enc eq '03') {
 		return 'ISO-8859-1';
 	} elsif ($enc eq '50') {
 		return 'UTF-8';