Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: Bench this BBcode

by SFLEX (Chaplain)
on Sep 09, 2010 at 21:47 UTC ( [id://859573]=note: print w/replies, xml ) Need Help??


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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://859573]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (2)
As of 2024-06-18 01:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.