Compress a Folder/Directory via Perl5

Compress a Folder/Directory via Perl5

tested in Windows, Mac OS X, Ubuntu16.04

#!/usr/bin/perl    
#压缩指定目录    
#nultiple folder    
use IO::Dir;    
use Archive::Tar;    
use v5.16;    
    
die "Give me some Folder
" if ! @ARGV;    
&tar_bz2(@ARGV);    
    
sub tar_bz2 {
	my @haystack = ();
	my $fname = join ',', map { $_=~s//$//;$_ } @_;
    #the compressed file name
	$fname = @_.";".$fname;
	while(my $dir = shift){ #iterate the given list
		$dir =~ s|/$||;
        if (! -d $dir){
            push @haystack, $dir;
            #not a dir/folder, file hodoooor
            next
        }
	    sub haystack {
		    my $dir  = shift; # current dir name
		    my $pat  = shift; # under where
		    my $d = IO::Dir->new("$dir");
		    if (defined($d)) {
				chdir $dir;
		        while (defined($_ = $d->read)) {
		            next if ($_ =~ /^..?$/);
				    if (-f "$_"){ 
						push @haystack, "$pat/$dir/$_";
					}
		            if (-d "$_") {
		                chmod 0755, "$_";
		                &haystack($_,"$pat/$dir");
                        # __SUB__ not work in windows
                        # no matter `use feature "current_sub"`
                        # or `use v5.16`
                        # run under perl v5.18.2
		            }
		        }
				chdir("..");    
		    }
		}    
		&haystack("$dir",'.');    
    }    
	$fname =~ s/[^A-Za-z0-9_-.;]+/_/g;    
	$fname = substr($fname,0,15) if $fname > 14;
    # create a Archive::Tar object
    my $tar = Archive::Tar->new;
    # add files
	$tar->add_files(@haystack) or die "$!";    
	# say STDERR "$_" for (@haystack);    
	$tar->write("$fname.tbz",COMPRESS_BZIP);    
	say "Saved to $fname.tbz";    
}

So,

$ perl ./backupRenLab.pl font/
Saved to 1;font.tbz

font/
  |-- A/
      |-- A File 2.txt
      |-- AFile1.txt
  |-- B/
      |-- C/
          |-- CFile.txt
 The sturcture

More,

• Options Getopt::Long -o(outdir),-t(compress method,gzip bz2,7z,xz),-f(tar filename), -l(compress level)