#! /usr/bin/perl -w

# This script will compress a file called 'something' in gzip format.
# The code is related to a Perl module written for debpool that is currently
# only found in the BTS. The file is called Bzip2.pm.
# (http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=415447#10)

use strict;
use warnings;
use Compress::Zlib;


my $file = 'something';
my $gzfile = 'something.gz';

if ( ! -e $file ) {
	open(TEST_FILE,  '>', $file);
	close(TEST_FILE);
}

my $gz = gzopen($gzfile, 'wb');
if (!$gz) {
    print "Couldn't initialize compression library: " . $gzerrno . "\n";
}

# Open the source file so that we have it available.
if (!open(SOURCE, '<', $file)) {
    print "Couldn't open source file '$file': $!";
}

while (1) {
    my $buffer;
    my $bytesread = read SOURCE, $buffer, 4096;
    if (!defined $bytesread) {
        print "Error reading from '$file': $!";
        close SOURCE;
    }
    last if $bytesread == 0;
    my $byteswritten = $gz->gzwrite($buffer);
    if ($byteswritten < $bytesread) {
        print "Error gzwriting to temporary file: " . $gz->gzerror;
        close SOURCE;
    }
}

my $gzflush = $gz->gzflush(Z_FINISH);

# Z_OK and Z_STREAM_END are ok
if (($gzflush != Z_OK) && ($gzflush != Z_STREAM_END)) {
    print "Error flushing compressed file: " . $gz->gzerror;
    close SOURCE;
}

# And we're done
close SOURCE;
$gz->gzclose;