package Zipper;

our (@ISA, @EXPORT);

use Exporter;
use strict;
use Compress::Zlib;

@ISA = qw(Exporter);
@EXPORT = qw(zip_files encode_tar_entry encode_zip_entry encode_zip_directory end_tar);




sub zip_files {
	my @files = @_;
	my %zip_state = (file_ptr => 0, central_headers => []);
	my $zipped_data = undef;
	
	for my $file (@files) {
		my $file_data = slurp_file($file);
		
		if(!$file_data) {
			return undef;
		}
		
		$zipped_data .= encode_zip_entry($file, $file_data, 1, \%zip_state);
	}
	
	$zipped_data .= encode_zip_directory(\%zip_state);
	
	return \$zipped_data;
}


sub slurp_file {
	my ($filename) = @_;
	
	local $/;
	my $infile = undef;
	
	if(open my $fh, $filename) {
		$infile = <$fh>;
		close $fh;
	} else {
		 warn "Can't open $filename\n";
	}
	
	return $infile;
}

sub encode_tar_entry {
    my ($name, $data) = @_;

    my $len = length($data);

    my $header = pack('a100a8a8a8a12a12a8a1@512',
		      $name,                      # filename
		      "000644 ",                  # permissions
		      "177777 ",                  # owner
		      "177777 ",                  # group
		      sprintf("%011o ", $len),    # length
		      sprintf("%011o ", time()),  # modification time
		      " " x 8,                    # space for checksum
		      "0");                       # link indicator
    
    my $chk = 0;
    for (my $i = 0; $i < 512; $i++) {
		$chk += ord(substr($header, $i, 1));
    }
    
	substr($header, 148, 7) = sprintf("%06o ", $chk);     # checksum
    my $tar = $header;
    $tar .= $data;
    my $rem = $len % 512;

    if ($rem > 0) {
		$tar .= "\x00" x (512 - $rem);
    }
	
	return $tar;
}

sub encode_zip_entry {
    my ($name, $data, $compress, $zip_state) = @_;

    my ($sec, $min, $hour, $mday, $mon, $year) = localtime();

    my $len = length($data);
    my $name_len = length($name);

    my $dos_time = $sec | ($min * 0x20) | ($hour * 0x800);
    my $dos_date = $mday | (($mon + 1) * 0x20) | (($year - 80) * 0x200);

    my $compressed = "";

    if ($compress) {
		my ($d, $err) = deflateInit(-WindowBits => -(MAX_WBITS));
		
		if (Z_OK != $err) { die "Couldn't initialize zlib: $err\n"; }
		
		($compressed, $err) = $d->deflate($data);

		if (Z_OK != $err) { die "Couldn't compress data: $err\n"; }
		
		my $flushed = "";
		($flushed, $err) = $d->flush();
		
		if (Z_OK != $err) { die "Couldn't flush compressed data: $err\n"; }
		
		$compressed .= $flushed;
    }

    my $clen = $compress ? length($compressed) : $len;

    if ($clen > $len) {
		# Got bigger on compression
		$clen = $len;
		$compress = 0;
    }

    my $method = $compress ? 8 : 0;

    my $crc = crc32($data);

    my $header = pack('a4vvvvvVVVvv',
		      "PK\x03\x04",   # magic number
		      0x14,           # version needed for extract
		      0,              # flags
		      $method,        # compression method (0=none, 8=deflate)
		      $dos_time,      # time of day
		      $dos_date,      # date
		      $crc,           # crc
		      $clen,          # compressed size
		      $len,           # uncompressed size
		      $name_len,      # filename length
		      0);             # extra field length
    my $central_file_header
	= pack('a4vvvvvvVVVvvvvvVV',
	       "PK\x01\x02",   # magic number
	       0x0314,         # version made by (high byte 3 = unix)
	       0x14,           # version needed for extract
	       0,              # flags
	       $method,        # compression method (0=none, 8=deflate)
	       $dos_time,      # time of day
	       $dos_date,      # date
	       $crc,           # crc
	       $clen,          # compressed size
	       $len,           # uncompressed size
	       $name_len,      # filename length
	       0,              # extra field length
	       0,              # file comment length
	       0,              # disk number start
	       0,              # internal attributes
	       0x81b40000,     # external file attributes (100664)
	       $zip_state->{file_ptr});  # local header offset

    my $zip = $header;
    $zip .= $name;
    $zip .= $compress ? $compressed : $data;

    $zip_state->{file_ptr} += length($header) + $name_len + $clen;
    push(@{$zip_state->{central_headers}}, $central_file_header . $name);
	
	return $zip;
}

sub encode_zip_directory {
    my ($zip_state) = @_;

    my $dir_size = 0;
    my $headers = $zip_state->{central_headers};
	
	my $zip;

    foreach my $header (@$headers) {
		$zip .= $header;
		$dir_size += length($header);
    }

    my $end_record
	= pack('a4vvvvVVv',
	       "PK\x05\x06",           # magic
	       0,                      # disk number
	       0,                      # disk with central directory
	       scalar(@$headers),      # no. of dir. entries on this disk
	       scalar(@$headers),      # no. of dir. entries in total
	       $dir_size,              # size of central directory
	       $zip_state->{file_ptr}, # offset to start of dir.
	       0);                     # zipfile comment length
    $zip .= $end_record;
	
	return $zip;
}

sub end_tar {
	my ($tar) = @_;
	
	$tar .= "\x00" x 1024;
	
	return $tar;
}

1;

__END__

=head1 NAME

Zipper.pm - Create zip or tar files in memory

=head1 SYNOPSIS

use Zipper.pm

#to zip one or more files

$ref_to_zipped_files = zip_files($filename1, $filename2, $filename3);

# or add in data manually

%zip_state = (file_ptr => 0, central_headers => []);
$zipped_data .= encode_zip_entry($file_name_1, $file_data_1, 1, \%zip_state);
$zipped_data .= encode_zip_entry($file_name_2, $file_data_2, 1, \%zip_state);
...
$zipped_data .= encode_zip_entry($file_name_n, $file_data_n, 1, \%zip_state);

# and to finish off
$zipped_data .= encode_zip_directory(\%zip_state);


# for a tar file it works in a similar way
$tarred_data .= encode_tar_entry($file_name_1, $file_data_1);
$tarred_data .= encode_tar_entry($file_name_2, $file_data_2);
...
$tarred_data .= encode_tar_entry($file_name_n, $file_data_n);

# and to end
$tarred_data .= end_tar();

=head1 DESCRIPTION

Zipper is used to make zip or tar files in memory.  Rather than writing files
to disk and using tar or zip commands data can be compressed as you go and then
written out later.  Any files made using this technique can be unzipped or
untarred as normal.

=head1 AUTHOR

Andrew Whitwham from the code by Rob Davies

=head1 HISTORY

 # $Log$ 

=cut





