r41229 - in /branches/upstream/libxml-bare-perl/current: Bare.pm Bare.xs Changes MANIFEST META.yml Makefile.PL t/Basic.t t/UTF8_Attributes.t t/UTF8_Values.t t/test.xml
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Mon Aug 3 15:07:42 UTC 2009
Author: jawnsy-guest
Date: Mon Aug 3 15:07:29 2009
New Revision: 41229
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41229
Log:
[svn-upgrade] Integrating new upstream version, libxml-bare-perl (0.45)
Added:
branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t (with props)
branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t (with props)
branches/upstream/libxml-bare-perl/current/t/test.xml (with props)
Modified:
branches/upstream/libxml-bare-perl/current/Bare.pm
branches/upstream/libxml-bare-perl/current/Bare.xs
branches/upstream/libxml-bare-perl/current/Changes
branches/upstream/libxml-bare-perl/current/MANIFEST
branches/upstream/libxml-bare-perl/current/META.yml
branches/upstream/libxml-bare-perl/current/Makefile.PL
branches/upstream/libxml-bare-perl/current/t/Basic.t
Modified: branches/upstream/libxml-bare-perl/current/Bare.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/Bare.pm?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/Bare.pm (original)
+++ branches/upstream/libxml-bare-perl/current/Bare.pm Mon Aug 3 15:07:29 2009
@@ -3,12 +3,13 @@
use Carp;
use strict;
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
+use utf8;
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
-$VERSION = "0.44";
+$VERSION = "0.45";
use vars qw($VERSION *AUTOLOAD);
@@ -27,7 +28,7 @@
=head1 VERSION
-0.42
+0.45
=cut
@@ -500,7 +501,8 @@
my $root = shift;
my %ret;
foreach my $name ( keys %$root ) {
- my $val = $root->{$name}{'value'} || '';
+ next if( $name =~ m|^_| || $name eq 'comment' || $name eq 'value' );
+ my $val = xval $root->{$name};
$ret{ $name } = $val;
}
return \%ret;
@@ -515,8 +517,29 @@
my $self = shift;
return if( ! $self->{ 'xml' } );
- open F, '>' . $self->{ 'file' };
- print F $self->xml( $self->{'xml'} );
+ my $xml = $self->xml( $self->{'xml'} );
+
+ my $len;
+ {
+ use bytes;
+ $len = length( $xml );
+ }
+ return if( !$len );
+
+ open F, '>:utf8', $self->{ 'file' };
+ print F $xml;
+
+ seek( F, 0, 2 );
+ my $cursize = tell( F );
+ if( $cursize != $len ) { # concurrency; we are writing a smaller file
+ warn "Truncating File $self->{'file'}";
+ truncate( F, $len );
+ }
+ seek( F, 0, 2 );
+ $cursize = tell( F );
+ if( $cursize != $len ) { # still not the right size even after truncate??
+ die "Write problem; $cursize != $len";
+ }
close F;
}
@@ -550,7 +573,6 @@
sub obj2xml {
my ( $objs, $name, $pad, $level, $pdex ) = @_;
-
$level = 0 if( !$level );
$pad = '' if( $level <= 2 );
my $xml = '';
@@ -563,18 +585,10 @@
my $obb = $objs->{ $b };
my $posa = 0;
my $posb = 0;
- if( !$oba ) { $posa = 0; }
- if( !$obb ) { $posb = 0; }
$oba = $oba->[0] if( ref( $oba ) eq 'ARRAY' );
$obb = $obb->[0] if( ref( $obb ) eq 'ARRAY' );
- if( ref( $oba ) eq 'HASH' ) {
- $posa = $oba->{'_pos'};
- if( !$posa ) { $posa = 0; }
- }
- if( ref( $obb ) eq 'HASH' ) {
- $posb = $obb->{'_pos'};
- if( !$posb ) { $posb = 0; }
- }
+ if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; }
+ if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; }
return $posa <=> $posb;
} keys %$objs;
for my $i ( @dex ) {
@@ -663,17 +677,12 @@
my @dex = sort {
my $oba = $objs->{ $a };
my $obb = $objs->{ $b };
- my ( $posa, $posb );
- if( !$oba ) { $posa = 0; }
- if( !$obb ) { $posb = 0; }
+ my $posa = 0;
+ my $posb = 0;
$oba = $oba->[0] if( ref( $oba ) eq 'ARRAY' );
$obb = $obb->[0] if( ref( $obb ) eq 'ARRAY' );
- if( ref( $oba ) eq 'HASH' && ref( $obb ) eq 'HASH' ) {
- $posa = $oba->{'_pos'};
- $posb = $obb->{'_pos'};
- if( !$posa ) { $posa = 0; }
- if( !$posb ) { $posb = 0; }
- }
+ if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; }
+ if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; }
return $posa <=> $posb;
} keys %$objs;
Modified: branches/upstream/libxml-bare-perl/current/Bare.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/Bare.xs?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/Bare.xs (original)
+++ branches/upstream/libxml-bare-perl/current/Bare.xs Mon Aug 3 15:07:29 2009
@@ -2,7 +2,6 @@
#include "EXTERN.h"
#define PERL_IN_HV_C
#define PERL_HASH_INTERNAL_ACCESS
-#define BLIND_PV(a,b) SV *sv;sv=newSV(0);SvUPGRADE(sv,SVt_PV);SvPV_set(sv,a);SvCUR_set(sv,b);SvPOK_only_UTF8(sv);
#include "perl.h"
#include "XSUB.h"
Modified: branches/upstream/libxml-bare-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/Changes?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/Changes (original)
+++ branches/upstream/libxml-bare-perl/current/Changes Mon Aug 3 15:07:29 2009
@@ -1,4 +1,12 @@
XML::Bare Changelog
+
+0.45
+ - Missing UTF8 test files now included
+ - XML Saving functionality now does size checks to ensure concurrency
+ issues do not corrupt XML.
+ - Linking under Solaris should now be fixed
+ - Line number defines removed from XS compilation to attempt to
+ fix some strange compilation problems.
0.44
- Self closing nodes now printed by xml function
Modified: branches/upstream/libxml-bare-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/MANIFEST?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/MANIFEST (original)
+++ branches/upstream/libxml-bare-perl/current/MANIFEST Mon Aug 3 15:07:29 2009
@@ -22,3 +22,6 @@
t/Basic.t
t/Pod_Coverage.t
t/Pod.t
+t/UTF8_Values.t
+t/UTF8_Attributes.t
+t/test.xml
Modified: branches/upstream/libxml-bare-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/META.yml?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/META.yml (original)
+++ branches/upstream/libxml-bare-perl/current/META.yml Mon Aug 3 15:07:29 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: XML-Bare
-version: 0.44
+version: 0.45
abstract: A minimal XML parser / schema checker / pretty-printer using C internally.
license: perl
author:
Modified: branches/upstream/libxml-bare-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/Makefile.PL?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/Makefile.PL (original)
+++ branches/upstream/libxml-bare-perl/current/Makefile.PL Mon Aug 3 15:07:29 2009
@@ -6,6 +6,7 @@
NAME => 'XML::Bare',
VERSION_FROM => 'Bare.pm',
PREREQ_PM => { Carp => 0, Exporter => 0, DynaLoader => 0 },
+ XSOPT => '-nolinenumbers', # line number defines were causing issues on some platforms
#OPTIMIZE => '-O3 -msse2 -march=pentium4 --omit-frame-pointer',
);
my $cc = getcc();
@@ -20,7 +21,10 @@
gen_msvc(); # special case for msvc
}
elsif( $^O eq 'darwin' ) {
- gen_darwin(); # darwin
+ gen_darwin();
+}
+elsif( $^O eq 'solaris' ) {
+ gen_solaris();
}
else {
gen_cc(); # all others
@@ -48,6 +52,13 @@
LIBS => ['-lm'],
OBJECT => 'Bare.o parser.o',
LDDLFLAGS => '-shared -L/usr/local/lib',
+ );
+}
+sub gen_solaris {
+ WriteMakefile( @basics,
+ LIBS => ['-lm'],
+ OBJECT => 'Bare.o parser.o',
+ LDDLFLAGS => '-G -L/usr/local/lib', # -G is equiv of -shared
);
}
sub gen_darwin {
Modified: branches/upstream/libxml-bare-perl/current/t/Basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/t/Basic.t?rev=41229&op=diff
==============================================================================
--- branches/upstream/libxml-bare-perl/current/t/Basic.t (original)
+++ branches/upstream/libxml-bare-perl/current/t/Basic.t Mon Aug 3 15:07:29 2009
@@ -66,6 +66,10 @@
my $z = $root->{'xml'}{'node'}{'_z'}-$i+1;
is( substr( $text, $i, $z ), '<node>checkval</node>', '_i and _z vals' );
+# saving test
+( $xml, $root ) = new XML::Bare( file => 't/test.xml' );
+$xml->save();
+
sub reparse {
my $text = shift;
my $nosimp = shift;
Added: branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t?rev=41229&op=file
==============================================================================
--- branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t (added)
+++ branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t Mon Aug 3 15:07:29 2009
@@ -1,0 +1,50 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+# NB we have use utf8 here, but the source should be 7bit clean
+# however I need the utf8::is_utf8 and utf8::valid names which
+# are no longer exposed without the use line.
+use utf8;
+
+use Test::More qw(no_plan);
+
+use_ok('XML::Bare');
+
+my $data = {
+ hash => "#",
+ oo => "\x{f6}",
+ iso_a => "\x{c4}",
+ iso_oo => "\x{d6}",
+ aa => "\x{e4}",
+ euro => "\x{20ac}",
+};
+
+# build XML string with UTF8 values
+my $xmldata = "<data>\n";
+foreach ( keys %{$data} ) {
+ $xmldata .= " <$_ char=\"" . $data->{$_} . "\" />\n";
+}
+$xmldata .= "</data>\n";
+
+# parse the provided XML
+my $obj = new XML::Bare( text => $xmldata );
+my $root = $obj->parse;
+
+# convert back to XML from parse
+my $roundtrip = $obj->xml($root);
+
+## this isn't valid as order/spacing not preserved
+is( $roundtrip, $xmldata, 'Round trip XML identical' );
+
+while ( my ( $name, $char ) = each %{$data} ) {
+ my $str = $root->{data}{$name}{char}{value};
+ ok( $root->{data}{$name}{char}{_att}, "$name has char attribute" );
+ ok( utf8::is_utf8($str), "Character $name is correct encoding" )
+ if ( utf8::is_utf8($char) );
+ ok( utf8::valid($str), "Character $name is Valid" );
+ ok( ( length($str) == 1 ), "String returned for $name is 1 char long" );
+
+ is( $str, $char, "Character $name OK" );
+}
Propchange: branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t?rev=41229&op=file
==============================================================================
--- branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t (added)
+++ branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t Mon Aug 3 15:07:29 2009
@@ -1,0 +1,55 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+# NB we have use utf8 here, but the source should be 7bit clean
+# however I need the utf8::is_utf8 and utf8::valid names which
+# are no longer exposed without the use line.
+#use utf8;
+
+use Test::Harness;
+$Test::Harness::verbose=1;
+use Test::More qw(no_plan);
+
+
+use_ok('XML::Bare');
+
+my $data = {
+ hash => "#",
+ oo => "\x{f6}",
+ iso_a => "\x{c4}",
+ iso_oo => "\x{d6}",
+ aa => "\x{e4}",
+ euro => "\x{20ac}",
+};
+
+# build XML string with UTF8 values
+my $xmldata = "<data>\n";
+foreach ( keys %{$data} ) {
+ $xmldata .= " <$_>";
+ $xmldata .= $data->{$_};
+ $xmldata .= "</$_>\n";
+}
+$xmldata .= "</data>\n";
+
+# parse the provided XML
+my $obj = new XML::Bare( text => $xmldata );
+my $root = $obj->parse;
+
+# convert back to XML from parse
+use Data::Dumper;
+my $roundtrip = $obj->xml($root);
+
+## this isn't valid as order/spacing not preserved
+is( $roundtrip, $xmldata, 'Round trip XML identical' );
+
+while ( my ( $name, $char ) = each %{$data} ) {
+ my $str = $root->{data}{$name}{value};
+ ok( utf8::is_utf8($str), "Character $name is correct encoding" )
+ if ( utf8::is_utf8($char) );
+ ok( utf8::valid($str), "Character $name is Valid" );
+ ok( ( length($str) == 1 ), "String returned for $name is 1 char long" );
+
+ is( $str, $char, "Character $name OK" );
+}
Propchange: branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t
------------------------------------------------------------------------------
svn:executable = *
Added: branches/upstream/libxml-bare-perl/current/t/test.xml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-bare-perl/current/t/test.xml?rev=41229&op=file
==============================================================================
--- branches/upstream/libxml-bare-perl/current/t/test.xml (added)
+++ branches/upstream/libxml-bare-perl/current/t/test.xml Mon Aug 3 15:07:29 2009
@@ -1,0 +1,1 @@
+<xml />
Propchange: branches/upstream/libxml-bare-perl/current/t/test.xml
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list