From 86ac39edb09647b83784c078f9ea3bd3b7a7d4e8 Mon Sep 17 00:00:00 2001 From: "arseny.kapoulkine" Date: Mon, 19 Jul 2010 09:46:30 +0000 Subject: Release archiving now converts newlines to Unix style in tar archives git-svn-id: http://pugixml.googlecode.com/svn/trunk@606 99668b35-9821-0410-8761-19e4c4f06640 --- tests/archive.pl | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 tests/archive.pl (limited to 'tests') diff --git a/tests/archive.pl b/tests/archive.pl new file mode 100644 index 0000000..240dd02 --- /dev/null +++ b/tests/archive.pl @@ -0,0 +1,60 @@ +#!/usr/bin/perl + +use Archive::Tar; +use Archive::Zip; + +my $target = shift @ARGV; +my @sources = @ARGV; + +my $zip = $target =~ /\.zip$/; + +my $arch = $zip ? Archive::Zip->new : Archive::Tar->new; + +for $source (sort {$a cmp $b} @sources) +{ + my $contents = &readfile_contents($source); + my $meta = &readfile_meta($source); + + if ($zip) + { + my $path = $source; + $arch->addDirectory($path) if $path =~ s/\/[^\/]+$/\// && !defined($arch->memberNamed($path)); + + my $member = $arch->addString($contents, $source); + + $member->desiredCompressionMethod(COMPRESSION_DEFLATED); + $member->desiredCompressionLevel(9); + + $member->setLastModFileDateTimeFromUnix($$meta{mtime}); + } + else + { + # tgz releases are for Unix people, Unix people like Unix newlines + $contents =~ s/\r//g if (-T $source); + + $arch->add_data($source, $contents, $meta); + } +} + +$zip ? $arch->overwriteAs($target) : $arch->write($target, 9); + +sub readfile_contents +{ + my $file = shift; + + open FILE, $file or die "Can't open $file: $!"; + binmode FILE; + my @contents = ; + close FILE; + + return join('', @contents); +} + +sub readfile_meta +{ + my $file = shift; + + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($file); + + return {mtime => $mtime}; +} -- cgit v1.2.3