Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Copy Permissions

by BuddhaNature (Beadle)
on Apr 25, 2004 at 19:25 UTC ( [id://347997]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Shane Liebling - shane at cryptio dot net
Description: Based on Ben Okopnik's cpmod script this script takes two directories (or files) and recursively sets the permissions of files/directories that exist in both to those of the version in the first. Handy if you want to check something out of a version control system and set the permissions to those of an already existant copy elsewhere.

NOTE: The full paths of both directories/files must be used, or ~/ if in your home directory.

UPDATED: Made use of japhy's suggestion.

UPDATED: Made use of some of davido's suggestions and those in his perlstyle piece.

UPDATED: Made use of another of davido's suggestions regarding checking the matches.

#!/usr/bin/perl -w

### Must pass full path for directories or with ~/ if
### in home directory

use strict;
use diagnostics;
use File::Find ();

@ARGV == 2 or die "Usage: cp-perms <full-path-to-correct-directory-or-
+file> <full-path-to-incorrect-directory-or-fileairp>\n";

sub cpmod2 ($$)
{
    my @a = (stat shift)[2,4,5];
    chown @a[1,2],          @_;
    chmod $a[0] & 07777,    @_;
}

use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

my $correct_dir = $ARGV[0];
my $wrong_dir = $ARGV[1];

my $wanted = sub
{
    $name =~ /\Q($wrong_dir\E)(.*)/
             or do
    {
             warn "Can't match $name for $wrong_dir in line __LINE__.\
+n";
             return undef;
    };
    my $the_thing = "$correct_dir$2";
    if (-e $the_thing)
    {
        cpmod2($the_thing,$name) or die "just couldnt do it: $!\n";
    }
};

File::Find::find({wanted => $wanted}, $wrong_dir);
Replies are listed 'Best First'.
Re: Copy Permissions
by japhy (Canon) on Apr 25, 2004 at 19:33 UTC
    In case there are some wacky characters in $wrong_dir, I'd do: $name =~ /(\Q$wrong_dir\E)(.*)/;
    _____________________________________________________
    Jeff[japhy]Pinyan: Perl, regex, and perl hacker, who'd like a job (NYC-area)
    s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;
      Good call. I updated the code to reflect your suggestion. Thanks!

      -Shane

Re: Copy Permissions
by davido (Cardinal) on Apr 25, 2004 at 20:54 UTC
    I happen to like modifiers, such as "do this unless that", or "perform this code foreach of these". But I like them usually when I want the action to seem (to the reader of the code) like the most important part of that statement, and in fact, the default behavior. There are, of course, exceptions to that rule. For example, I see nothing wrong with "next unless $line; inside a file-reading loop where I've just chomped and want to move on to the next line if this one turned out to be blank. But for the most part, I prefer my modifiers to be all about actions that I want to have happen except for some less common circumstance.

    Keeping that in mind, I would change your die "Usage..." unless @ARGV == 2; to a slightly different idiom.

    @ARGV == 2 or die "Usage.....";

    Now you've got the condition of death right up front so that a reader will see what's triggering the death; too many elements in @ARGV. This is the same approach commonly used with file open. You will find a strong recommendation in that direction for mostly the same reasons I've given in perlstyle. But to be fair, this is a gray area, and you do see it both ways all the time.

    I also don't like the notion of setting up aliases to $File::Find::name using typeglobs. These variables are read-only according to the POD for File::Find. When you start aliasing them, you might not remember that $name is special, and shouldn't be modified.

    I would much rather just see you checking $File::Find::name directly, or assigning its value to a lexical $name.

    The next thing that bothers me is in your $wanted->() sub. You're not checking for the validity of your pattern match, and then you're subsequently relying on $2 to contain a reasonable value. Don't rely on captures unless you're certain that there was a match. Just don't; you will get into trouble eventually with that approach.


    Dave

      Regarding: "The next thing that bothers me is in your $wanted->() sub. You're not checking for the validity of your pattern match, and then you're subsequently relying on $2 to contain a reasonable value. Don't rely on captures unless you're certain that there was a match. Just don't; you will get into trouble eventually with that approach."

      How would you go about ensuring the match? Would you just do a if to test if there is something there, or would there be a remenant from the last match? If there was a remenant would you need to assign it to a global and then first test if it is the same as the global?

      Any suggestions would be greatly welcomed.

      -Shane

        my $wanted = sub { $name =~ /\Q($wrong_dir\E)(.*)/; my $the_thing = "$correct_dir$2"; if (-e $the_thing) { cpmod2($the_thing,$name) or die "just couldnt do it: $!\n"; } };

        How would you go about ensuring the match?

        The point is that $2 can contain an artifact of previous match successes, it can contain undef, or under some circumstances, it can contain rubbish. Your script is set up to die if it's unable to perform the desired action in the $wanted->() sub. Error handling of the match could occur one of several ways, depending on what you think is best.

        You can either issue a warning and then break out of the sub before taking the next action, or die altogether. I kind of like the idea of issuing a warning and breaking out of the sub so that the next iteration can still take place.

        my $wanted = sub { $name =~ /\Q($wrong_dir\E)(.*)/ or do { warn "Can't match $name for $wrong_dir in line __LINE__.\n"; return undef; }; my $the_thing = "$correct_dir$2"; if (-e $the_thing) { cpmod2($the_thing,$name) or die "just couldnt do it: $!\n"; } };

        That should at least guarantee that you're never attempting to do a cpmod2() where $name is potentially unknown garbage.

        Of course there's always more than one way to do it.


        One more point I wanted to make clear: My critique was in no way intended to discourage you or anyone else from posting code here, whether it's pristine or somewhat less than that. I am glad when I see code posted, and my critique was only intended to provide a basis from which you and others can pick up on areas for improvement that will help in the longrun. I did notice your discussion in the CB regarding the posting of code for critique, so I assumed that was what you had in mind with this particular piece. Overall, good job. I don't think it's possible to post anything to PerlMonks without someone chiming in with better ways (in his/her opinion) to do things.

        Take my critique as one person's opinion. If some of what I've said is found to be beneficial to you, that's all I can hope for. Keep up the good work.


        Dave

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2024-03-29 14:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found