Bug #34560 for IO-Compress-Zlib: Test failure on Solaris

On Mon Mar 31 16:17:53 2008, robinbowes wrote: Show quoted text
Thanks, that worked perfectly. I've enclosed another variant. Can you try running it please? Paul

use strict; use warnings; sub _unixToDosTime # Archive::Zip::Member { my $time_t = shift; # TODO - add something to cope with unix time < 1980 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); my $dt = 0; $dt += ( $sec >> 1 ); $dt += ( $min << 5 ); $dt += ( $hour << 11 ); $dt += ( $mday << 16 ); $dt += ( ( $mon + 1 ) << 21 ); $dt += ( ( $year - 80 ) << 25 ); return $dt; } sub _dosToUnixTime { #use Time::Local 'timelocal_nocheck'; use Time::Local 'timelocal'; my $dt = shift; my $year = ( ( $dt >> 25 ) & 0x7f ) + 80; my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1; my $mday = ( ( $dt >> 16 ) & 0x1f ); my $hour = ( ( $dt >> 11 ) & 0x1f ); my $min = ( ( $dt >> 5 ) & 0x3f ); my $sec = ( ( $dt << 1 ) & 0x3e ); # catch errors my $time_t = eval { timelocal( $sec, $min, $hour, $mday, $mon, $year ); }; return 0 if $@; return $time_t; } sub writeFile { my($filename, @strings) = @_ ; 1 while unlink $filename ; open (F, ">$filename") or die "Cannot open $filename: $!\n" ; binmode F; foreach (@strings) { no warnings ; print F $_ ; } close F ; } sub readFile { my $f = shift ; open (F, "<$f") or die "Cannot open $f: $!\n" ; binmode F; local $/; my $string = <F> ; close F ; return $string ; } my $tempFile = "/tmp/paul123"; my $now = time; my $dosTime = _unixToDosTime($now); writeFile($tempFile, $dosTime); my $unix = readFile($tempFile); $unix = _dosToUnixTime($dosTime); my $delta = $now - $unix; my $packed = pack "V", $dosTime; writeFile($tempFile, $packed); my $got = readFile($tempFile); my $unpacked = unpack "V", $got; my $unix1 = _dosToUnixTime($unpacked); my $delta1 = $now - $unix1; print <<EOM; Now $now DOS $dosTime Unix $unix Delta $delta Packed Unix $unix1 Delta $delta1 EOM