r32320 - in /trunk/libxml-bare-perl: MANIFEST debian/changelog debian/watch makebench.PL

antonio-guest at users.alioth.debian.org antonio-guest at users.alioth.debian.org
Tue Mar 24 19:43:20 UTC 2009


Author: antonio-guest
Date: Tue Mar 24 19:43:16 2009
New Revision: 32320

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32320
Log:
* debian/watch:
  + removed versionmangle and the reference to repack

Added:
    trunk/libxml-bare-perl/makebench.PL
Modified:
    trunk/libxml-bare-perl/MANIFEST
    trunk/libxml-bare-perl/debian/changelog
    trunk/libxml-bare-perl/debian/watch

Modified: trunk/libxml-bare-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/MANIFEST?rev=32320&op=diff
==============================================================================
--- trunk/libxml-bare-perl/MANIFEST (original)
+++ trunk/libxml-bare-perl/MANIFEST Tue Mar 24 19:43:16 2009
@@ -1,6 +1,7 @@
 Bare.pm
 Bare.xs
 Changes
+makebench.PL
 Makefile.PL
 MANIFEST
 META.yml

Modified: trunk/libxml-bare-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/debian/changelog?rev=32320&op=diff
==============================================================================
--- trunk/libxml-bare-perl/debian/changelog (original)
+++ trunk/libxml-bare-perl/debian/changelog Tue Mar 24 19:43:16 2009
@@ -1,15 +1,11 @@
 libxml-bare-perl (0.43-1) UNRELEASED; urgency=low
 
   TODO:
-  - copyright/license for some files in bench/ missing
-  - remove call to repack.sh from debian/watch, and version mangling too
   - these lines during build don't look nice:
 
   /usr/bin/perl "-Iblib/arch" "-Iblib/lib" makebench.PL makebench
   readdir() attempted on invalid dirhandle DIR at makebench.PL line 10.
   closedir() attempted on invalid dirhandle DIR at makebench.PL line 11.
-
-  - MANIFEST has changes
 
   [ Antonio Radici ]
   * New upstream release
@@ -20,6 +16,8 @@
   * debian/control:
     + upgrade to Standards-Version 3.8.1, no changes required
   * removed debian/repack.sh
+  * debian/watch:
+    + removed versionmangle and the reference to repack
 
   [ gregor herrmann ]
   * debian/control: add missing full stop to long description, thanks to

Modified: trunk/libxml-bare-perl/debian/watch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/debian/watch?rev=32320&op=diff
==============================================================================
--- trunk/libxml-bare-perl/debian/watch (original)
+++ trunk/libxml-bare-perl/debian/watch Tue Mar 24 19:43:16 2009
@@ -1,7 +1,4 @@
 # format version number, currently 3; this line is compulsory!
 version=3
 # URL to the package page followed by a regex to search
-opts="dversionmangle=s/\+dfsg\.\d+//" \
-http://search.cpan.org/dist/XML-Bare/ \
-.*/XML-Bare-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ \
-debian sh debian/repack.sh
+http://search.cpan.org/dist/XML-Bare/ .*/XML-Bare-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ 

Added: trunk/libxml-bare-perl/makebench.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-bare-perl/makebench.PL?rev=32320&op=file
==============================================================================
--- trunk/libxml-bare-perl/makebench.PL (added)
+++ trunk/libxml-bare-perl/makebench.PL Tue Mar 24 19:43:16 2009
@@ -1,0 +1,295 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+if( !eval( "require Time::HiRes;" ) ) {
+  print "Time::HiRes not installed; benchmarks cannot be done\n";
+}
+
+opendir( DIR, "./bench" );
+my @files = readdir(DIR);
+closedir( DIR );
+foreach my $file ( @files ) {
+  if( $file =~ m/(.+)\.tmpl/ ) {
+    print "Processing $file\n";
+    tmplfile( './bench/'.$file, $1 );
+    print "\n";
+  }
+}
+
+sub tmplfile {
+  my $file = shift;
+  my $name = shift;
+open(TMPL,"$file");
+$/ = undef;
+my $tmpl = <TMPL>;
+close(TMPL);
+
+$tmpl =~ s/#([c+0-])/#-$1/g;
+
+#print $tmpl;
+my @parts = split('#-',$tmpl);
+
+open(OUT,">./bench/one$name.pl");
+
+my $div;
+sub has_cc {
+  my $div = (substr($ENV{'PATH'},0,1) eq '/') ? ':' : ';';
+  my @path = split($div,$ENV{'PATH'});
+  foreach my $dir ( @path ) {
+    return 1 if( -e "$dir/cc" ||
+                 -e "$dir/gcc" ||
+                 -e "$dir/cc.exe" ||
+                 -e "$dir/gcc.exe" ); }
+  return 0;
+}
+if( $^O eq 'MSWin32' && !has_cc() ) { $div = '\\'; }
+else { $div = '/'; }
+
+print OUT <<START;
+#!/usr/bin/perl
+use strict;
+
+my \$div = "\\$div";
+my \$maxlen = 26;
+my \$file = \$ARGV[1] || 'test.xml';
+my ( \$root, \$s, \$s2, \$s3, \$usec, \$usec2, \$usec3, \$sa, \$sb, \$sc, \$base1, \$base2, \$base3 );
+
+my \$onlyone = \$ARGV[2] ? 1 : 0;
+
+tabit("-Module-",'load    ','parse   ','total') if( !\$onlyone );
+
+exit if( !\$ARGV[0] );
+
+use Time::HiRes qw(gettimeofday);
+
+# For fairness; try to get the file to be read into memory cache
+{
+  open(FILE,'<', \$file) or die "Couldn't open \$!";
+  local \$/ = undef; my \$cache = <FILE>;
+  close(FILE);
+}
+START
+
+#{
+#  (\$s, \$usec) = gettimeofday();
+#  if( eval( "require XML::Bare;" ) ) {
+#    (\$s2, \$usec2) = gettimeofday();
+#    my \$ob = new XML::Bare( file => \$file );
+#    \$root = \$ob->parse();
+#    (\$s3, \$usec3) = gettimeofday();
+#    timeit('XML::Bare',1);
+#  }
+#}
+#START
+my $comment = '';
+my $i = -1;
+foreach my $part ( @parts ) {
+  my @requires;
+  $part = '#'.$part;
+  my $type = '';
+  my $module = '';
+  if( $part =~ m/#([c\-0\+]) (.+)\n/ ) {
+    $type = $1;
+    my $name = $2;
+    $module = $name if( $name =~ m/\w/ );
+  }
+  if( $part =~ m/#([c\-0\+]\+?)\n/ ) {
+    $type = $1;
+  }
+  #print "[$type $module]\n";
+  
+  if( $type eq 'c' ) {
+    $part =~ s/c\n//g;
+    $part = "##".$part."##";
+    $part =~ s/^##[#c \n]+//;
+    $part =~ s/[ \n]+##$//;
+    $comment = $part;
+    next;
+  }
+  if( $type eq '0' ) {
+    
+    if( $module ) {
+      $part =~ s/(#0)\W*.*/$1/;
+    }
+    
+    while( $part =~ m/(require [A-Za-z\:]+;)/g ) {
+      my $req = $1;
+      if( !$module ) {
+        my $fmod = $req;
+        $fmod =~ s/require //; $fmod =~ s/;//;
+        $module = $fmod;
+      }
+      push( @requires, $req );
+    }
+    $part =~ s/require [A-Za-z\:]+;\n//g;
+    
+    $part = "##".$part."##";
+    $part =~ s/^##[#0 \n]+//;
+    $part =~ s/[ \n]+##$//;
+    
+    print OUT "
+    if( \$ARGV[0]*1 >= $i ) {
+      (\$s, \$usec) = gettimeofday();
+      if( eval( '@requires' ) ) {
+        (\$s2, \$usec2) = gettimeofday();
+        
+$part
+
+        (\$s3, \$usec3) = gettimeofday();
+        unload('$module');
+        timeit('$module',1);
+      }
+    }
+    ";
+  }
+  if( $type eq '-' ) {
+    
+    if( $module ) {
+      $part =~ s/(#[\-\0\+])\W*.*/$1/;
+    }
+    
+    while( $part =~ m/(require [A-Za-z\:]+;)/g ) {
+      my $req = $1;
+      if( !$module ) {
+        my $fmod = $req;
+        $fmod =~ s/require //; $fmod =~ s/;//;
+        $module = $fmod;
+      }
+      push( @requires, $req );
+    }
+    $part =~ s/require [A-Za-z\:]+;\n//g;
+    
+    $part = "##".$part."##";
+    $part =~ s/^##[#\- \n]+//;
+    $part =~ s/[ \n]+##$//;
+    
+    print OUT "
+    if( \$ARGV[0] eq '$i' ) {
+      (\$s, \$usec) = gettimeofday();
+      if( eval( '@requires' ) ) {
+        (\$s2, \$usec2) = gettimeofday();
+        
+$part
+
+        (\$s3, \$usec3) = gettimeofday();
+        unload('$module');
+        timeit('$module');
+      }
+    }
+    ";
+  }
+  if( $type eq '+' ) {
+    $part = "##".$part."##";
+    $part =~ s/^##[#\+ \n]+//;
+    $part =~ s/[ \n]+##$//;
+    print OUT "
+    if( \$ARGV[0] eq '$i' ) {
+    
+$part
+    
+    }
+    ";
+  }
+  if( $type eq '0+' ) {
+    $part = "##".$part."##";
+    $part =~ s/^##[0#\+ \n]+//;
+    $part =~ s/[ \n]+##$//;
+    print OUT "
+    #if( \$ARGV[0] eq '$i' ) {
+    
+$part
+    
+    #}
+    ";
+  }
+  $i++;
+}
+
+print OUT <<END;
+
+sub unload {
+  my \$module = shift;
+  my \@parts = split(' ',\$module);
+  \$module = \$parts[0];
+  \$module =~ s/::/\\//g;
+  \$module.='.pm';
+  delete \$INC{\$module};
+}
+
+sub timeit {
+  my \$name = shift;
+  my \$base = shift;
+  \$sa = \$s2-\$s + ((\$usec2-\$usec)/1000000); 
+  \$sb = \$s3-\$s2 + ((\$usec3-\$usec2)/1000000); 
+  \$sc = \$s3-\$s + ((\$usec3-\$usec)/1000000); 
+  if( \$base ) {
+    \$base1 = \$sa;
+    \$base2 = \$sb;
+    \$base3 = \$sc;
+  }
+  \$sa /= \$base1; \$sb /= \$base2; \$sc /= \$base3;
+  \$sa = fixed( \$sa ); \$sb = fixed( \$sb ); \$sc = fixed( \$sc );
+  if( !\$base || !\$onlyone ) {
+    tabit( \$name,\$sa,\$sb,\$sc);
+  }
+}
+
+sub tabit {
+  my ( \$a, \$b, \$c, \$d ) = \@_;
+  my \$len = length( \$a );
+  print \$a;
+  for( 0..(\$maxlen-\$len) ) { print ' '; }
+  print "\$b \$c \$d\n";
+}
+
+sub fixed {
+  my \$in = shift;
+  \$in *= 10000;
+  \$in = int( \$in );
+  \$in /= 10000;
+  my \$a = "\$in";
+  my \$len = length( \$a );
+  if( \$len > 8 ) { \$a = substr( \$a, 8 ); }
+  if( \$len < 8 ) {
+    while( \$len < 8 ) {
+      \$a = "\${a} ";
+      \$len = length( \$a );
+    }
+  }
+  return \$a;
+}
+END
+
+close(OUT);
+
+open( SH, ">./bench/$name.pl" );
+
+my $end = $i+1;
+print SH "#!/usr/bin/perl
+";
+if( $comment ) {
+  print SH "
+print <<END;
+$comment
+
+END
+  ";
+}
+print SH
+"print `perl one$name.pl $end`;
+my \$file = \$ARGV[0] || 'test.xml';
+for my \$i ( 0..$i ) {
+  print `perl one$name.pl \$i \$file 1`
+}
+";
+
+#print SH "#!/bin/bash
+#perl bench.pl $end
+#for (( i=1;i<=$i;i++ )); do
+#perl bench.pl \$i \$1 1
+#done
+#";
+
+close( SH );
+}




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