r41231 - in /trunk/libxml-bare-perl: Bare.pm Bare.xs Changes MANIFEST META.yml Makefile.PL debian/changelog 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:12:19 UTC 2009 

Author: jawnsy-guest
Date: Mon Aug  3 15:12:13 2009
New Revision: 41231

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41231
Log:
* New upstream release
  + Prevent XML corruption during XML saving
  + Fix strange compilation problems by removing line number defines

Added:
    trunk/libxml-bare-perl/t/UTF8_Attributes.t
      - copied unchanged from r41230, branches/upstream/libxml-bare-perl/current/t/UTF8_Attributes.t
    trunk/libxml-bare-perl/t/UTF8_Values.t
      - copied unchanged from r41230, branches/upstream/libxml-bare-perl/current/t/UTF8_Values.t
    trunk/libxml-bare-perl/t/test.xml
      - copied unchanged from r41230, branches/upstream/libxml-bare-perl/current/t/test.xml
Modified:
    trunk/libxml-bare-perl/Bare.pm
    trunk/libxml-bare-perl/Bare.xs
    trunk/libxml-bare-perl/Changes
    trunk/libxml-bare-perl/MANIFEST
    trunk/libxml-bare-perl/META.yml
    trunk/libxml-bare-perl/Makefile.PL
    trunk/libxml-bare-perl/debian/changelog
    trunk/libxml-bare-perl/t/Basic.t

Modified: trunk/libxml-bare-perl/Bare.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/Bare.pm?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/Bare.pm (original)
+++ trunk/libxml-bare-perl/Bare.pm Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/Bare.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/Bare.xs?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/Bare.xs (original)
+++ trunk/libxml-bare-perl/Bare.xs Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/Changes?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/Changes (original)
+++ trunk/libxml-bare-perl/Changes Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/MANIFEST?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/MANIFEST (original)
+++ trunk/libxml-bare-perl/MANIFEST Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/META.yml?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/META.yml (original)
+++ trunk/libxml-bare-perl/META.yml Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/Makefile.PL?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/Makefile.PL (original)
+++ trunk/libxml-bare-perl/Makefile.PL Mon Aug  3 15:12:13 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: trunk/libxml-bare-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/debian/changelog?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/debian/changelog (original)
+++ trunk/libxml-bare-perl/debian/changelog Mon Aug  3 15:12:13 2009
@@ -1,3 +1,11 @@
+libxml-bare-perl (0.45-1) UNRELEASED; urgency=low
+
+  * New upstream release
+    + Prevent XML corruption during XML saving
+    + Fix strange compilation problems by removing line number defines
+
+ -- Jonathan Yu <frequency at cpan.org>  Mon, 03 Aug 2009 07:10:20 -0400
+
 libxml-bare-perl (0.44-1) unstable; urgency=low
 
   [ Jonathan Yu ]

Modified: trunk/libxml-bare-perl/t/Basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/t/Basic.t?rev=41231&op=diff
==============================================================================
--- trunk/libxml-bare-perl/t/Basic.t (original)
+++ trunk/libxml-bare-perl/t/Basic.t Mon Aug  3 15:12:13 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;

More information about the Pkg-perl-cvs-commits mailing list