view release on metacpan or  search on metacpan

bin/lzf  view on Meta::CPAN

use 5.010001;
use strict;
use warnings;

use Getopt::Long;

our $VERSION = '0.02'; # VERSION

my %Opts;

sub parse_cmdline {
    my $res = GetOptions(
        'decompress|uncompress|d' => \$Opts{decompress},
        'force|f' => \$Opts{force},
        'pure-perl|pp' => \$Opts{pure_perl},
        'to-stdout|c' => \$Opts{to_stdout},
        'help|h'         => sub {
            print <<USAGE;
lzf - Compress/decompress using LZF algorithm

Usage:
  lzf [options] <file> ...
  lzf --help
Options:
  --decompress, --uncompress, -d
  --force, -f
  --pure-perl, --pp
  --to-stdout, -c
For more details, see the manpage/documentation.
USAGE
            exit 0;
        },
    );
    exit 99 if !$res;

    unless (@ARGV) {
        warn "lzf: Please specify at least one file\n";
        exit 99;
    }
}

sub run {
  FILE:
    for my $file (@ARGV) {
        if ($Opts{decompress}) {
            die "lzf: Filename '$file' does not end with .lzf\n"
                unless $file =~ /\.lzf\z/;
        } else {
            die "lzf: Filename '$file' already has .lzf suffix, unchanged\n"
                if $file =~ /\.lzf\z/ && !$Opts{force};
        }

        my $fh;
        my $data;
        {
            local $/;
            open $fh, "<", $file
                or die "lzf: Can't open '$file' for reading: $!\n";
            $data = <$fh>;
        }
        my @st = stat($fh) or die "lzf: Can't stat '$file': $!\n";

        my $newdata;
        my $newfile;
        if ($Opts{decompress}) {
            if ($Opts{pure_perl}) {
                require Compress::LZF_PP;
                $newdata = Compress::LZF_PP::decompress($data);
            } else {
                require Compress::LZF;
                $newdata = Compress::LZF::decompress($data);
            }
            $newfile = $file;
            $newfile =~ s/\.lzf\z//;
        } else {
            require Compress::LZF;
            $newdata = Compress::LZF::compress($data);
            $newfile = "$file.lzf";
        }

        if (-e $newfile && !$Opts{to_stdout} && !$Opts{force}) {
            while (1) {
                print "lzf: '$file' already exists, overwrite (y/n)? ";
                my $ans = <STDIN>;
                chomp($ans);
                if ($ans eq 'y') {
                    last;
                } else {
                    next FILE;
                }
            }
        }

        if ($Opts{to_stdout}) {
            print $newdata;
            next;
        }

        open $fh, ">", $newfile
            or die "lzf: Can't open '$file' for writing: $!\n";
        print $fh $newdata;
        close $fh;
        unlink $file or die "lzf: Can't unlink '$file': $!\n";
        utime $st[8], $st[9], $newfile
            or die "lzf: Can't set [am]time of '$newfile': $!\n";
    }
}

# MAIN

parse_cmdline();
run();

# ABSTRACT: Compress/decompress using LZF algorithm
# PODNAME: lzf

__END__

=pod

=encoding UTF-8