Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

tidyhome

by billysara (Acolyte)
on Dec 17, 2000 at 01:02 UTC ( #47073=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info billysara
Description: A little script to tidy users home areas by moving files from ~/ to subdirectories related to filetype. Written so I didn't need to spend my time tidying up all those .tar.gz files I accumulate from freshmeat...
#!/usr/bin/perl
#
#    tidyhome.perl
#
#    Perl script to parse a ~/.tidy file and move files from
#    user home directory to thier tidied/<category> dir. 
#
#    (c) 2000 Billy Allan.
#    Released under the terms of the GNU General Public License.
#    See http://www.gnu.org for details.
#
#    Version 0.1 Fri Nov 24 19:43:39 GMT 2000
#    Version 0.2 Sun Jan 14 15:16:47 GMT 2001
#    Version 0.3 Mon Mar 19 18:48:52 GMT 2001
#
#    Usage:
#    tidyhome.perl [username] [username]...
#
#    If no username is supplied, the current UID is assumed (and warne
+d)
#
#    Format of ~/.tidy file :
#    <basedir>
#    <dir-type> <extension> [<extension> <extension>...]
#    <dir-type> <extension> ...
#    ...
#
#    For example :
#
#    tidied
#    pictures jpg xcf gif png tiff
#    docs/web html htm
#    docs/text txt doc
#    movies avi mpg fli mpeg mov
#
#    The files will be moved into a folder called :
#        ~/<basedir>/<dir-type>
#    ****which must exist already!****
#

$basedir = 'tidied';        # default
$config = '.tidy';

#######################

if ($#ARGV < 0)
{
    warn("No username given - defaulting to current username\n");
    @details = getpwuid($<);    # get the current user-account
    @userlist = $details[0];    # get the username
}
else
{
    @userlist = @ARGV;
}

#######################

foreach $user (@userlist)
{
    if ($homedir = (getpwnam("$user"))[7])
    {
        if (! tidy($homedir))
        {
            warn("Could not tidy $user homedir...\n");
        }
    }
}

1;

#######################

sub tidy                    # tidy($homdir)
{
    my $home = $_[0];
    if (open(CONFIG,"<$home/$config"))
    {
        $basedir = <CONFIG>;
        chomp($basedir);
        while (<CONFIG>)
        {
            chomp();
            my ($key,@types) = split(/ /);
            if ($key =~ m/[^0-9a-zA-Z_\-\/]/)        # only allow "saf
+e" directory names
            {
                print "Invalid directory in .tidy file...\n";
                next();
            }
            foreach my $type (@types)
            {
                chomp($type);
                my @list = glob("$home/*.$type");
                foreach my $file (@list)
                {
                    my $result = rename($file,"$home/$basedir/$key");
                }
                $type = uc($type);
                @list = glob("$home/*.$type");
                foreach $file (@list)
                {
                    $result = rename($file,"$home/$basedir/$key");
                }

            }
        }
        return 1;
    }
    else
    {
        return 0;
    }
}

Comment on tidyhome
Download Code
Re: tidyhome
by snax (Friar) on Dec 17, 2000 at 15:36 UTC
    I would make two suggestions regarding this chunk:
    my @list = glob("$home/*.$type"); foreach my $file (@list) { my $result = `mv $file $home/$basedir/$key`; } $type = uc($type); @list = glob("$home/*.$type"); foreach $file (@list) { $result = `mv $file $home/$basedir/$key`; }
    First, there's a lot of repetition there that can be removed by setting your @list variable to the "concatenation" of the lists returned by the glob. Second, you grab $result but you never check whether the move was successful! I'd think about rewriting the chunk above as:
    foreach my $file (glob("$home/*.$type"), glob("$home/*.\U$type")) { system('mv', $file, "$home/$basedir/$key") == 0 or warn "Could not move $file: $!"; }
    (the \U modifier does the uc translation within double quoted strings).

    Also, you could do to a test for existence of directories (-d $dirname, I believe) and create those on the fly rather than forcing their existence beforehand, something like

    system('mkdir', '-p', "$home/$basedir/$key") unless -d "$home/$basedir/$key";
    Here I presume a *nix environment, which seems likely given your earlier use of 'mv'. Natch, you should test the return value of that system call, too....

      Or, you could use the builtin rename and mkdir functions ...

      Tony

      Indeedy - I'll be updating the script soon. It's more 'perlie' now, creates the directories if the don't exist, and also checks for permission/symlink problems. Billy.

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (7)
As of 2014-08-28 03:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (255 votes), past polls