http://www.perlmonks.org?node_id=859573


in reply to Re: Bench this BBcode
in thread Bench this BBcode

If its any help to you, I edited bart's code to not work in a command prompt. The only thing is you have to set the values of the variables in the code.
#!perl use Archive::Tar; $Archive::Tar::DO_NOT_USE_PREFIX = 1; use strict; my %opt = ( 'quickfix' => 1, # quick fix - with out world writeables 'verbose' => 1, # print some text when working 'output' => 'Fixed_Archive.tar.gz', # rename file to ); my $dist = 'C:\Path\to\with-out-world-writeables.tar.gz'; # Path and F +ile to fix print 'Starting the Fix File: '.$dist."\n".' and rename to '.$opt{outp +ut}."\n" if $opt{verbose}; my $fixes; my $tar = Archive::Tar->new; $tar->read($dist); my @files = $tar->get_files; foreach my $file (@files) { my $fixedmode = my $mode = $file->mode; my $filetype = ''; if($file->is_file) { $filetype = 'file'; if($opt{quickfix}) { $fixedmode &= ~2; } elsif(substr(${ $file->get_content_by_ref }, 0, 2) eq '# +!') { $fixedmode = 0775; } else { $fixedmode = 0664; } } elsif($file->is_dir) { $filetype = 'dir'; if($opt{quickfix}) { $fixedmode &= ~2; } else { $fixedmode = 0775; } } else { next; } next if $mode eq $fixedmode; $file->mode($fixedmode); $fixes++; print "\nChange mode %03o to %03o for %s '%s'\n", $mode, $fixe +dmode, $filetype, $file->name if $opt{verbose}; } if($fixes) { $dist = $opt{output} if $opt{output}; $tar->write($dist, 9); print "\nFile '$dist' saved.\n" if $opt{verbose}; }

I just tested it on PAUSE and it works.