# All rights reserved (c) 2002;  Author: Daniel Dinev;  http://chatologica.com

package MTS4::STD::Gzip;                                # GZIP COMPRESSION UTILITY

use strict;
no strict 'subs';
use MTS4::STD::Common;
use MTS4::STD::Files;
use vars qw($OK $ZlibAvailable $GzipExists $UseExternalGzip);

BEGIN {
    $ZlibAvailable = 1;
    {
        local $SIG{__DIE__} = sub {};                   # disable fatal errors if cannot find a module
        eval("use Compress::Zlib");
    };
    $ZlibAvailable = 0 if $@;
    my $P = ${$UNIVERSAL::MTS4}{'Parameters'} || {};
    $GzipExists = $$P{'gzip_exists'};
    $UseExternalGzip = $$P{'use_external_gzip'};
    $OK = $GzipExists || $ZlibAvailable;
};



sub new {                                               # A STANDARD OBJECT CONSTRUCTOR
    my ($this,%p) = @_;
    my $class = ref($this) || $this;
    my $me = {};
    bless $me, $class;
    $me->init(%p);
    return $me;
}



sub init                                                # INITIALIZE THIS OBJECT
{
    my ($me,%p) = @_;
    $$me{'page_started'} = 0;
    $$me{'page_flushed'} = 0;
    $$me{'P'} = ${$UNIVERSAL::MTS4}{'Parameters'} || {};
    $$me{'E'} = ${$UNIVERSAL::MTS4}{'ENV'} || {};
};



sub start_page
{
    my ($me) = @_;
    my $E = $$me{'E'};
    $$me{'page_started'} = 1;
    $$me{'page_flushed'} = 0;
    my $gzip = ${$$me{'P'}}{'path_to_gzip'} || 'gzip';
    $$me{'method'} = 'plain';                           # by default we do not gzip
    if($GzipExists && (!$ZlibAvailable || $UseExternalGzip)) {
        $$me{'method'} = 'gzip';                        # choose external gzip method
        $$me{'GZIP'} = new IO::Handle;
        if($ENV{'MOD_PERL'} || $ENV{'FCGI_ROLE'}){      # mod_perl/fastcgi requires writing a file
            $$me{'tmp_gzip_page_file'} = "$$E{'CWD'}data/tmp/page.gz." . &gen_unique_ID;
            open($$me{'GZIP'},"|$gzip -c9 > \"$$me{'tmp_gzip_page_file'}\"") || ($$me{'method'} = 'plain');
        } else {
            open($$me{'GZIP'},"|$gzip -c9") || ($$me{'method'} = 'plain');
        };
    } elsif($ZlibAvailable) {
        $$me{'method'} = 'zlib';                        # choose Zlib library
        $$me{'ZLIB'} = Compress::Zlib::deflateInit(
            -Level          => Compress::Zlib::Z_BEST_COMPRESSION(),
            -WindowBits     => - Compress::Zlib::MAX_WBITS(),
            -Bufsize        => 4096,
        );
        if(!$$me{'ZLIB'}){
            $$me{'method'} = 'plain';
        } else {                                        # write a minimal gzip header
            my $MIN_HDR_SIZE;
            {
                local $^W=0;
                local $SIG{__DIE__} = sub {};
                eval("\$MIN_HDR_SIZE = Compress::Zlib::MIN_HDR_SIZE+0");
            };
            $MIN_HDR_SIZE = $MIN_HDR_SIZE || 10;
            $$me{'gzip_header'} = pack("C" . $MIN_HDR_SIZE,
                Compress::Zlib::MAGIC1,
                Compress::Zlib::MAGIC2,
                Compress::Zlib::Z_DEFLATED(),
                0,0,0,0,0,0,
                Compress::Zlib::OSCODE
            );
            my $empty = "";
            $$me{'string'} = \$empty;
        };
    }
    return $$me{'method'};
};



sub gzwrite                                             # PUT A STRING IN BUFFER TO GZIP
{
    my ($me,$string) = @_;                              # ref to string
    if ($$me{'method'} eq 'gzip'){
        binmode STDOUT if !$ENV{'FCGI_ROLE'};
        print {$$me{'GZIP'}} $$string;
    } elsif ($$me{'method'} eq 'zlib') {
        if($$me{'gzip_header'} ne '') {                 # send GZIP header if not sent yet
            binmode STDOUT if !$ENV{'FCGI_ROLE'};       # because FCGI did not defined binmode
            print $$me{'gzip_header'};
            $$me{'gzip_header'} = '';
        };
        my ($output, $status) = $$me{'ZLIB'}->deflate($string);
        if(!defined $output){
            die "Zlib error: $status";
        } else {
            print $output;
        };
        my $str = ${$$me{'string'}} . $$string;         # used at the end when have to make gzip footer
        $$me{'string'} = \$str;
    } else {
        print $$string;                                 # just print it if no compression
    };
}



sub gzflush                                             # FLUSH UNSENT DATA AND THE GZIP FOOTER
{
    my($me) = @_;
    if($$me{'page_started'} && !$$me{'page_flushed'}) {
        if ($$me{'method'} eq 'gzip'){
            $$me{'GZIP'}->flush;
            close $$me{'GZIP'};
            if ($ENV{'MOD_PERL'} || $ENV{'FCGI_ROLE'}){
                print &read_file($$me{'tmp_gzip_page_file'},1);
                unlink $$me{'tmp_gzip_page_file'};
            };
        } elsif ($$me{'method'} eq 'zlib') {
            my ($output, $status) = $$me{'ZLIB'}->flush();
            if(!defined $output){
                die "Zlib error: $status";
            } else {
                print $output;
                if(defined $$me{'string'}) {
                    my $gzip_footer = pack("V V", Compress::Zlib::crc32($$me{'string'}), length(${$$me{'string'}}));
                    print $gzip_footer;
                };
            };
        };
        $$me{'page_flushed'} = 1;
    };
};



sub UnGzip                                                  # UNGZIP $file OR $str TO FILE $to
{
    my ($file,$to,$str) = @_;
    my $error = '';
    my $P = ${$UNIVERSAL::MTS4}{'Parameters'} || {};
    my $E = ${$UNIVERSAL::MTS4}{'ENV'} || {};
    my $gzip = $$P{'path_to_gzip'} || 'gzip';
    my $ungzipped_content = '';
    if(!$OK){
        $error = ' No Gzip functionality';
    } else {                                                # START PREPARING SOURCE AND TARGET FILES:
        $to = '' if !defined $to;
        my $delete_to_file = 0;
        if(defined $str) {                                  # have to gzip a string
            my $id = &gen_unique_ID;
            my $cwd = $$E{'CWD'};
            $file = $cwd . "data/tmp/ungzip_from_$id\.gz";
            if ($to eq ''){
                $delete_to_file = 1;
                $to = $cwd . "data/tmp/ungzip_to_$id";
            };
            $error .= &save_file($file,$str,0,1);           # store string in a temporary file
        } elsif ($to eq '') {                               # have to store ungzipped data in default file
            $to = $file;
            $to =~ s{(\.gz)(\.[^/]+|)$}{$2};                # remove .gz suffix
        };
        if($ZlibAvailable && !$error){                      # DECOMPRESS THROUGH Zlib
            my $TO = new IO::File;
            if(!open($TO,">$to")){                          # open decompresed target file
                $error = " Can't write file '$to'. $! Check if this file and its directory have write permissions. File chmod 666 and directory chmod 777 is required!";
            } else {
                binmode $TO;
                my $gz = gzopen($file, 'rb');               # open to read compressed file
                if($gz){
                    my $buffer;
                    my $read_bytes;
                    while((!$error) && ($read_bytes = $gz->gzread($buffer)) && ($read_bytes>0)){   # decompress buffer
                        print {$TO} $buffer;
                        #if($read_bytes == -1){
                        #    $error .= " Error while decompressing gzipped file: $file";
                        #}
                    };
                    $gz->gzclose();
                    close $TO;
                } else {
                    $error .= " Can't read gzipped file: $file";
                };
            };
        } elsif($GzipExists && !$error){                    # DECOMPRESS THROUGH EXTERNAL GZIP PROGRAM
            my $exist = -e $to;
            my $dir = $to;
            $dir =~ s{[/\\][^/\\]+$}{};
            if((!$exist && (-w $dir)) || ((-e $to) && (-w $to))){
                `$gzip -cd "$file" > "$to"`;
            } else {
                $error .= "Error writing '$to' file. Check if this file and its directory have write permissions. File chmod 666 and directory chmod 777 is required!";
            };
        };
        if(!$error){
            my $read_err;
            ($ungzipped_content, $read_err) = &read_file($to,1);
            $error .= $read_err if $read_err;
        };
        if ($delete_to_file || $error) {
            unlink $to;                                     # remove target file on error or if not needed
        };
        if(defined $str){
            unlink $file;                                   # remove a temporary source file
        };
    };
    return ($ungzipped_content,$error);
};



sub Gzip                                                    # GZIP $file OR $str TO FILE $to
{
    my ($file,$to,$str) = @_;
    my $error = '';
    my $P = ${$UNIVERSAL::MTS4}{'Parameters'} || {};
    my $E = ${$UNIVERSAL::MTS4}{'ENV'} || {};
    my $gzip = $$P{'path_to_gzip'} || 'gzip';
    my $gzipped_content = '';
    if(!$OK){
        $error = ' No Gzip functionality';
    } else {                                                # START PREPARING SOURCE AND TARGET FILES:
        $to = '' if !defined $to;
        my $delete_to_file = 0;
        if(defined $str) {                                  # have to gzip a string
            my $id = &gen_unique_ID;
            my $cwd = $$E{'CWD'};
            $file = $cwd . "data/tmp/gzip_from_$id\.gz";
            if ($to eq ''){
                $delete_to_file = 1;
                $to = $cwd . "data/tmp/gzip_to_$id";
            };
            $error .= &save_file($file,$str,0,1);           # store string in a temporary file
        } elsif ($to eq '') {                               # have to store gzipped data in default file
            $to = $file . '.gz';
        };
        if($ZlibAvailable && !$error){                      # COMPRESS THROUGH Zlib
            my $FROM = new IO::File;
            if(!open($FROM,"<$file")){                      # open source file
                $error .= " Can't read '$file' file. $!";
            } else {
                binmode $FROM;
                my $gz = gzopen($to,'wb');                  # open target gzipped file
                if($gz){
                    my $buffer;
                    my $bytes;
                    while(!$error && ($bytes = read($FROM,$buffer,4096))){      # buffered reading
                        my $written_bytes = $gz->gzwrite($buffer);              # write compressed buffer
                        if(!$written_bytes){
                            $error .= " Error while compressing '$file' file.";
                        };
                    };
                    $gz->gzclose();
                    close $FROM;
                    if(!defined $bytes){
                        $error .= " Error reading '$file' file. $!";
                    };
                } else {
                    $error .= " Error writing '$to' file. Check if this file and its directory have write permissions. File chmod 666 and directory chmod 777 is required!";
                };
            };
        } elsif($GzipExists && !$error){                    # COMPRESS THROUGH EXTERNAL GZIP PROGRAM
            my $exist = -e $to;
            my $dir = $to;
            $dir =~ s{[/\\][^/\\]+$}{};
            if((!$exist && (-w $dir)) || ((-e $to) && (-w $to))){
                `$gzip -c9 "$file" > "$to"`;
            } else {
                $error .= " Error writing '$to' file. Check if this file and its directory have write permissions. File chmod 666 and directory chmod 777 is required!";
            };
        };
        if(!$error){
            my $read_err;
            ($gzipped_content,$read_err) = &read_file($to,1);
            $error .= $read_err if $read_err;
        };
        if ($delete_to_file || $error) {
            unlink $to ;                                    # remove target file on error or if not needed
        };
        if(defined $str){
            unlink $file;                                   # remove a temporary source file
        };
    };
    return ($gzipped_content,$error);
}



sub DESTROY                                                 # DESTRUCTOR OF THIS CLASS
{
    my($me) = @_;
    $me->gzflush;
}



1; # must return TRUE


