comment on

I see a couple other solutions but here is mine. Used at work on a linux box to move .tif files but accepts filetype from cmd line argument, so that other types may also be zipped!

#!/usr/bin/perl  
use warnings;
use strict;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Time::localtime;
use Cwd;

my $dir = cwd;
system "cls";
die "Zip.pl\nUsage: <(c)ompress> <e(x)tract>\n"    unless(@ARGV == 1 o
+r @ARGV == 2);
my $opt = shift @ARGV;
if($opt =~ /c/i){
    print "Running compress routine\n";
    GlobFiles();
}
if($opt =~/x/i){
    GlobFiles2();
}

sub GlobFiles{
    @_ = glob ('*');
    ZipFiles(@_);
    }

sub GlobFiles2{
    @_ = glob ('*');
    UnZip(@_);
}
    
sub ZipFiles{
    my $expr;
    
    if(@ARGV == 1){
         $expr = shift @ARGV;
    }else{
        $expr = "tif\n"
    }
    chomp $expr;
    my $Zip = Archive::Zip->new();
    my ($wday, $month, $day, $t, $year)=split(/\s+/, ctime);
    my ($hour, $min, $sec)=split(/\:/, $t);
    my $new_t = "$hour-$min";
    my $ZipName = "$year $month\-$day $new_t";
    foreach(@_){
        next unless($_ =~ m/($expr)$/);
        my $member = $Zip->addFile($_);
        $member->desiredCompressionLevel( 9 );
        if($Zip->writeToFileNamed("$ZipName.zip") == AZ_OK) {
            # Below is used to remove the files once the files are zip
+ped AZ_OK
            #unlink($_);
            print "$_ written to $ZipName.zip\n";
            }
            else{
                warn "Error writing $_ to $ZipName.zip\nTrying to cont
+inue\n";
            }
        }
        if( -e "$ZipName.zip"){
            print "Done creating $ZipName.zip\n";
        }else{
            print "No $expr files found in current directory\n";
        }
        undef $Zip;
    }

sub UnZip{
    my $zip = Archive::Zip->new();                # Allows the use of 
+the zip module
    #my $FoldPath;
    foreach(@_){                        # Searches through each file p
+assed to the sub 
        next unless($_ =~ m/(zip)$/);            #skips all but zip fi
+les
        print "Opening $_ for extraction\n\n";
        #FoldNameCheck($Folder1);
        die "Error reading zip file" if $zip->read($_) != AZ_OK;
                                    # Errors if the zip file is not pr
+operly read.
        ## !! Below is used for foldername. Does return name but does 
+not make folder and extract to peroperly
        #FoldNameCheck($_);
        #sub returnname{
        #    no warnings;
        #    $FoldPath = shift @_;
        #    }
        my @members = $zip->members();            # used to view each 
+item in the zip file
        no warnings;                    # needed to keep module errors
+ from popping up
        foreach (@members){            # Used to loop through each ite
+m in the zip
            #print "$_->{fileName}\n";    #Used to test if the default
+ var would work.
            
            ## !! used for foldername !! #
            #my $newname = "$FoldPath/$_";
            #$zip->extractMember($_, $FoldPath,$_);
            $zip->extractMember($_);        # Actually extracting file
+ from zip
            print "Extracted $_->{fileName}\n";    # Display msg sayin
+g completion for each file
            }
        print "Done extracting files\n\n";            # Completion mes
+sage
    }
}

sub FoldNameCheck{
    my $Folder = shift @_;
    $Folder =~ s/(\d+\s\w+\-\d+\s\d+\-\d+)(.+)/$1/;
    if(-e $Folder){
        print "Extracting ...\n";
    }else{
        #mkdir "$Folder" or die "Error creating $Folder\n";
        print "Making folder $Folder\n";
    }
    return returnname($Folder);
}
[download]

Let me know what you think. Enjoy!

In reply to Re: Zipping Files by mikeock
in thread Zipping Files by Anonymous Monk

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.


Think about Loose Coupling
	PerlMonks