Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
XP is just a number

Private Utilities

by Ovid (Cardinal)
on Nov 30, 2005 at 18:14 UTC ( #513033=perlmeditation: print w/ replies, xml ) Need Help??

One of the reasons so many of us love Perl is how easy it is to hack out a quick utility that does exactly what we need. However, sharing these utilities doesn't always make sense because the utility is either custom to your needs (I had a precursor to Module::Starter which was dependent on my personal setup) or is so limited that posting it is sure to draw quick replies of "yeah, but that doesn't do X!"

So here's one of mine. I type subs PerlFileName and it dumps out a list of the subroutines. If I type subs -p PerlFileName it will include the "private" subs (those that begin with an underscore).

#!/usr/bin/perl use strict; use warnings; use Getopt::Long; GetOptions( "private" => \my $private ); my $file = shift or die "Usage: subs ProgramName"; my @subs; open my $fh, '<', $file or die "Cannot open ($file) for reading: $!"; while ( defined( my $line = <$fh> ) ) { if ( $line =~ /^\s*sub\s+([[:word:]]+)/ ) { my $sub = $1; next if ! $private && '_' eq substr $sub, 0, 1; push @subs, $sub; } } print join "\n", sort @subs;

It's pretty simple, will break on a lot of code and pretty much guarantees that posting it as a utility here won't meet with the best response. However, if I need a quick refresher on a module's interface, it's great. What private utilities do you have which might meet your needs but not be "general" enough to post elsewhere?


New address of my CGI Course.

Comment on Private Utilities
Download Code
Re: Private Utilities
by Old_Gray_Bear (Bishop) on Nov 30, 2005 at 19:13 UTC
    I have built a number of 'SA utilities' by the expedient of tracking the requests I issue in the course of a day. If I find that I am doing a particular, complex, query more than three times a day, it becomes a candidate for a utility code, and I add it to my little list. When I find myself at loose ends (boring meetings, 45 minutes until the car-pool leaves, etc), I pop the top item of the list and write the script for it. The resulting code works in my current environment, but will probably never get ported outside the Company. It would take a fair amount of work to produce portable and general enough code for posting to CPAN.

    Over the past six months I have written utilities to:

    • Check each member in a server-cloud and report back on the percent running over 75% CPU busy
    • Check each member in a server-cloud and report which boxes are under 'environmental stress', defined as mother-board temperatures over 85F. (Far too many. This particular script was turned over to the Hardware folks the week we had three boxes go thermal in one day.)
    • Check a server-cloud and report on how many members have a particular configuration set active
    • Check a server cloud and report on the number of open HTTP conversations
    • Check the status of a load-balancer: how "hot" is it running? How many servers is it fronting? What is the five minute trend?
    • Check on the status of machines in the test lab; who is up and who is idle
    • Wander through the last five minutes of the Apache logs in a server cloud and report on the most popular source and destination IPs. Ditto for the most popular errors.

    Most of these were a couple of hour projects, nothing fancy, no seriously strange code involved, not particularly well documented (blush).

    I have a couple of bigger problems on the list, associated with walking through SNMP trees of MIBs. I can get the Network usage information from the Network logs, but it will be 8+ hours old. I want to be able to look at the servers and routers that I Care About in a shorter time frame, say the last fifteen minutes. The Network Manager, would love to have the tool, too, but she doesn't have the body to assign to it. So I have an over-the-Christmas-break project.

    I Go Back to Sleep, Now.


Re: Private Utilities
by Anonymous Monk on Nov 30, 2005 at 19:50 UTC
    A quick and dirty rename command for UNIX: it looks simple, but is quite handy. Also, similar little utilities for deleting all the empty files (including empty gzipped files) in a directory, copying with rename, and so forth...
    %cat #!/usr/bin/perl =head1 SYNOPSIS '<pattern from>/<pattern to>' <filenames> =head1 DESCRIPTION Renames the files listed as <filenames> after performing the substitut +ion using the standard perl regular expression pattern from and to. =head1 EXAMPLES 'ready/done' file1-ready file2-ready_to_go renames "file1-ready" to "file1-done" and "file2-ready_to_go" to "file2-done_to_go" =cut use strict; use warnings; my $file; my $old; my $pattern; my $command; unless( @ARGV >= 2) { print "Usage: rename \"patternfrom/to\" <filenames>\n"; exit(1); } # end argument check $pattern = shift(@ARGV); foreach $file (@ARGV) { $old=$file; $pattern .= "/" unless( $pattern =~ m#.*?/.*?/$# ); $command = "\$file =~ s/$pattern"; eval $command; if ( $@ ) { print STDERR "$@"; } # end eval failed check rename($old,$file); } # end rename loop

        Note also my improvements on it: rename 0.3 - now with two extra cupholders

        (The version on my disk is a bit better in some ways, but has grown messily, and I have no clear idea about how to clean it up…)

        Makeshifts last the longest.

Re: Private Utilities
by belg4mit (Prior) on Nov 30, 2005 at 20:41 UTC
    That's similar in utility to something I spoke about in the CB awhile back, bart said he'd like it and I started but haven't finished... It was aplopos, an apropos for your installed module base.

    I have this, quotemeta for pipes e.g; find -name *.pl | quotemeta | xargs grep foo

    #perl -p s/([ '"$*?()\[\]])/\\$1/g;
    And this icky URIgrep:
    #perl -l -O777 $_=<>;while(m/(\w+:\/\/[-a-zA-Z0-9\$_.+!*'(),?\/\%\&=~:]+)/g){print$1; +}

    In Bob We Trust, All Others Bring Data.

      I can see some uses for your quotemeta for pipes, but the use you mentioned is more easily written as
      find -name \*.pl -print0 | xargs -0 grep foo
      which has the advantage of quoting all nasty filename characters (for instance, new lines, tabs, etc).
        If you have newlines in your filenames you've issues IMHO. As for "more easily" well, I don't find your idiom particularly intuitive (it relies upon two arcane swtiches and you're sort of repeating yourself). Besides, I don't use the tool as much as I could because it always slips my mind, the more I use it the more I'll use it :-P

        It's interesting to know there's an option, maybe I'll include some variant as the default when I get around to writing the trivial wrapper that accepts arguments in the right order. POSIX be damned, find is grep-ing the filesystem and it ought to be find EXPR PATH

        In Bob We Trust, All Others Bring Data.

        Except that not all finds and xargss have this feature. The ones included with Solaris, for example.


        The only easy day was yesterday

Re: Private Utilities
by jonix (Friar) on Nov 30, 2005 at 21:25 UTC
    Well, you have asked for it. Here is the script I update my gentoo box with for some months now. It is a smarter replacement of the bash alias in the first comment. I procrastinate finishing it since as it just does what I need though. No guarantees if you dare to try it!
Re: Private Utilities
by xdg (Monsignor) on Nov 30, 2005 at 21:37 UTC
    What private utilities do you have which might meet your needs but not be "general" enough to post elsewhere?

    Well, a quick scan of my ~/utility-scripts/ directory shows:

    • -- a level of detail between 'corelist' and 'corelist -a'
    • cpanget -- grabs a CPAN dist from (before I knew about 'cpanp -d')
    • findrequires -- scans for module dependencies and outputs in a Module::Build ready format (annotated with core-module history, if available)
    • pod2htmleasy -- output to Pod::HtmlEasy
    • -- regenerate thumbnails for my photo album CGI
    • release-dist -- download a module from my SVN repository, extract it, build it, and if all tests pass, upload it to CPAN
    • set-version -- sets "$VERSION = x.yy.zz" recursively in appropriate files in a distribution directory
    • tag-svk -- create a tag branch from within an svk directory
    • tag-svn -- ditto from within an svn directory

    Some are shell wrappers around perl one-liners, but it's still perl doing most of the work. I keep these in a subversion repository so I can shuffle them around between machines I use and propogate little changes as I make them.


    Code written by xdg and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.

Re: Private Utilities
by TimButterfield (Monk) on Nov 30, 2005 at 22:11 UTC

    Here are some scripts I find useful in our environment.

    • grepXXlog - perform a grep on the same log file name across multiple servers shares looking for a text string. We have multiple servers, each running the same process or set of processes. If there is a problem, we have to find out which server processed that item and look in that particular log file to see what happened. The default log file name is for the current date, but the script has parameters for -# (# of days old) and -note (open the log file in notepad if the text is found). The XX in the script name is for the specific process/share where the files are.
    • stripcr - modify a text file in place to replace whatever combination of \r \n with the \n for the current platform. This makes a great 'send to' shortcut on Windows.
    • binwords - open a binary file and look for combinations of ascii characters of a minimum specified length and output those strings. This is handy for seeing what calls an executable may be making.

Re: Private Utilities
by samtregar (Abbot) on Nov 30, 2005 at 23:44 UTC
    In my ~/bin is, among other things:

    • choose-x: a curses script which asks me whether I want to load the config for the LCD panel or the external CRT. My poorly supported graphics chip makes me choose before X starts if I want to be able to play movies.
    • a script which uses wmcrtl to find and raise a window in X. I bind keypresses and icons to invocations of this script - for example, clicking the email icon finds and raises my email window or opens it if none is found.
    • a script which sends a set of MP3s to my Dell-pod and creates a playlist for them.


Re: Private Utilities
by duelafn (Priest) on Dec 01, 2005 at 00:03 UTC

    How about a module (docs, Dean::Util) that removes dependency on itself from other modules. For example:

    # In some script/module use Dean::Util qw/map_pair nsign min_max/; # other code ...

    Then later to send the script to other machines:

    perl -MDean::Util -we insert_Dean_Util_functions

    This replaces the use Dean::Util line with the code for the subs requested (and optionally documentation).

    Good Day,

Re: Private Utilities
by graff (Chancellor) on Dec 01, 2005 at 02:08 UTC
    Seems like just about every day I have to pull something out of an oracle or mysql database, or do some sort of alteration to table data. But leaving the shell command line behind to use the oracle or mysql native CLI just causes too much constraint and discomfort.

    So I have two generic Perl/DBI utilities -- one to run "select/describe/show" type queries, one to run "update/insert/delete" type queries -- that just take the query text as a command-line arg, or take a file name that contains the query text. Here's the usage message for the mysql version of the "select" tool:

    Usage: mdbget -db database -s 'select sql' [options] [query_param.list +] or: [-db database] -f sql.file [options] [query_param.list +] options: -l : label columns (print list of column names as first line of ou +tput) -d delim : set field delimiter to 'delim' (default delim is tab) "-d sp" and "-d ' '" both work to produce single-space delimite +d data "-d csv" will produce "true CSV" output, adding double-quotes a +s needed NOTE: only "-d csv" will quote fields containing the delimiter +character (csv also turns on "-l", so column names are listed on fi +rst line) -w {norm|mark|keep} : control the treatment of whitespace within f +ields: "-w norm" (default) convert all whitespace strings to single sp +ace "-w mark" keep spaces as-is, convert newline to '\n', tab to '\ +t' "-w keep" make no alterations to white space at all query_param.list is needed if sql contains "?" placeholder(s) for par +am(s)
    The tools both use a special "DBI-wrapper" module I cooked up, that maps the "database" name to an appropriate user-id and password for connecting to the server, so both utils can be used with all the different databases I have to deal with.

    The placeholder support for the sql statements means I can pipe a list of field data from any other shell command or data file, which saves me tons of time. (update: and of course the big win for me is the ability to pipe query output to other shell commands)

    But it's definitely the sort of thing I tend to keep to myself and just a few trusted colleagues (especially the update/insert/delete tool).

Re: Private Utilities
by Anonymous Monk on Dec 01, 2005 at 04:39 UTC

    What's the surprise? That's what Perl is for. On the other hand, it would be really stupid for anyone to use Perl for any project with size.

    Considered by Aristotle: blatant troll
    Unconsidered by Arunbear: keep votes prevented reaping; Keep: 9, Edit: 0, Reap: 25

      On the other hand, it would be really stupid for anyone to use Perl for any project with size.

      Stupid like someone who hangs out on a forum for a language just to bash it? ;)

      No i'm not wasting an entire post just to feed the troll. Not script but a local module:

      package DBIx::Copy::Lock; use base DBIx::Copy; sub copy_one_table { my $self=shift; my $table=shift; my $dest = $self->{opts}->{table_translation_table}->{$table} || $ +table; $self->{dst}->do("LOCK TABLES $dest WRITE"); $self->SUPER::copy_one_table($table); $self->{dst}->do("UNLOCK TABLES"); }

      Comes in hand with an update/mirror script that uses DBIx::Copy but needed to lock each file (odd peice that DBIx::Copy seems to be missing by default.

      And a modified version of DBIx::Copy that does the copy in chunks. Original DBIx:Copy gets very angry and confused on large databases. Oh and this added the ability to make inserts delayed, both options togther help alot if you are trying to run a large update (100k+ rows) mid-day and don't want the database to stop responding to everyone ;).

      Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
Re: Private Utilities
by Aristotle (Chancellor) on Dec 01, 2005 at 05:29 UTC

    This is sm, short for Slackware make. I use it to build Slackware packages out of autoconf-based source tarballs, but half its raison d’être is to provide some defaults to the configure script, so non-Slackers might get some use out of it.

    This is ratbecause “tar” is backwards –, which attempts to make dealing with tarballs (and zipfiles) a little saner:

    I’m rather unhappy with the state of both; rat has at least one annoying bug. But they work sufficiently well for me that I don’t get irritated enough to actually fix them. And that’s why they’ve remained private…

    Makeshifts last the longest.

      Do you know checkinstall? It's a neat package building utility, and it can build Slack, Debian and RPM packages, though it's primarily a Slackware utility (it comes on slackware CDs in the /extra directory IIRC).

        Yes. It needs to be run as root, so any files created in the source tree during make install as well as the resultant package tarball are owned by root, which means I can’t move the package, and sometimes cannot blow away the source tree, without root permissions. It also knows nothing of DESTDIR, so you cannot run it with fakeroot, which means make install can wreak havoc at will. (Makefiles that try to register schemata with GConf are always great fun… grr.)

        Makeshifts last the longest.

Re: Private Utilities
by Intrepid (Deacon) on Dec 01, 2005 at 08:29 UTC
    <UPDATE> prompted by a reaction in the chatterbox

    If you get upset by things like seeing the company name "Microsoft" rendered in various creative / implicitly critical ways, please stop reading now; I don't want to inadvertantly help you even to a tiny degree with this code! Making even one of your days a tiny bit easier might distract you from the important recognition that you've got far worse problems than doskey macros to deal with (problems of an cognitive sort), and it would thus be uncompassionate of me. Shoo.


    I was just looking at how impoverished* my Windo$e CMD.exe prompt seemed (I go months without using one, but building Perl under Win32(native) a little while ago made me get re-acquainted with it). I decided to pull together a few doskey macros that could be loaded into a CMD session at any point (by running a batch *.cmd file). Here they are.

    * compared with my Cygwin shell

Re: Private Utilities
by Anonymous Monk on Dec 01, 2005 at 12:02 UTC
    i use this (way to often) to renumber image files so they'll sort in order.
    #!/usr/bin/perl # # blah*.jpg # blah1.jpg .. blah9.jpg blah10.jpg .. blah99.jpg blah100.jpg # -> blah001.jpg .. blah010.jpg .. blah100.jpg foreach ( @ARGV ) { next unless ($stem, $digits, $ext) = /(.*?)(\d+)\.([^\.]+)$/; $max = $len if ($len = length( $digits )) > $max; print "$_ $1\n"; } $fmt = "$stem\%0${max}d.$ext"; foreach ( @ARGV ) { next unless ($stem, $digits, $ext) = /(.*?)(\d+)\.([^\.]+)$/; $new = sprintf $fmt, $digits; rename $_, $new or warn $!; }
Re: Private Utilities
by hv (Parson) on Dec 01, 2005 at 13:42 UTC

    Here is the one I use more than any other: open a vi session in a new xterm. At any one time I usually have between 20 and 200 of such sessions open.


    vix [ -i ] [ -r ] [ -s ] [ filenames ... ] -i: create minimised (useful when opening many in one go) -r: readonly edit session -s: open all files in a single vi session

    The code:

    #!/usr/bin/perl -w my $xterm = '/usr/X11R6/bin/xterm'; my $vi = '/bin/vi'; my $single = 0; my @xopts = qw/ -cm +cn -dc -j -s +sb -sl 0 -wf -fg white -bg black /; my @vopts = (); while (@ARGV && $ARGV[0] =~ /^-/) { my $arg = shift; last if $arg eq '--'; push(@xopts, '-iconic'), next if $arg eq '-i'; push(@vopts, '-R'), next if $arg eq '-r'; $single = 1, next if $arg eq '-s'; die "unknown option '$arg'\n"; } @ARGV = '' unless @ARGV; for ($single ? \@ARGV : @ARGV) { my $pid = fork; die "fork: $!\n" unless defined $pid; next if $pid; my $name = $single ? "vix session" : $_; $name =~ s/lock\z/lock /; # avoid fwvm trickery exec $xterm, @xopts, -name => $name, -title => $name, -e => $vi, @vopts, $single ? @$_ : $_; }

    Update 2006/04/06: added hack to dodge 'lock' trickery.



      Goodness! If your vi is actually vim, you might consider using minibufexpl.vim.

        You can also use the new "tab pages" implemented in vim 7 (still beta) :)

        Hi, I'm a .signature virus! Copy me to your .signature file and help me propagate, thanks!
Re: Private Utilities
by cees (Curate) on Dec 01, 2005 at 14:06 UTC

    Here is a dirt simple one that just loads up the source of a perl module in vi. It is a shell script, but if you really wanted to, could be re-written in perl...

    #!/bin/sh DOC=`perldoc -l $1` if [ -n "$DOC" ] && [ -f "$DOC" ]; then vim $DOC fi

    I got tired of writing vi `perldoc -l <module-name>`, and thought pvi <module-name> saved me some key strokes.

    Cheers, Cees
Re: Private Utilities
by philcrow (Priest) on Dec 01, 2005 at 14:43 UTC
    I have a couple of oddities. One, called incgrep, works like recursive grep except for two features. First, it reports one line for each file that has the search string with the line numbers after like this:
    search_string: some_file 4 12 189 other_file 29 283
    This is very useful for quickly seeing which files are calling a certain sub, etc.

    The second feature is odder yet. If the search string is a directory name, then instead of looking for the string itself, it uses the file names in that directory as search strings looking for each of them. This was supposed to be useful for looking for all the templates used in a project:

    shell-prompt: incgrep global/template/dir App/ 24 114 App/Modules/ 41 App/ 181
    I don't actually use it that way much.

    Another script is showsub. It usually takes a sub name and a module file name. It dumps out the whole sub from that module. (It's not very smart, it looks for 'sub name' at the left margin and dumps from there to the first closing brace at the margin.) It can also take the output from incgrep. Then it looks in all the files mentioned there for the sub provided.

    Another one is searchinc. It takes a regex, a starting perl file and (optionally) a list of directories which could be part of @INC. It looks for the regex in the starting file and in anything it uses recursively. Again, its not overly smart and only looks for easy to spot use statements. I also have a version for C, since I once spent a bit of time digesting a large code base in C. The C version is more useful, Perl doesn't hide as many symbols.

    My most useful little tools are the ones the move me to the directories where our different projects live. I can type cdb AppName to move the build directory for an app and cda AppName to move to the lib path for it. These are my most typed commands.


Re: Private Utilities
by SolidState (Scribe) on Dec 01, 2005 at 15:29 UTC

    One little utility I wrote which others in my workplace have found useful is called 'fp', for "Full Path":

    use strict; use warnings; use Cwd qw(abs_path); my $file = $ARGV[0] || "."; die "Error - couldn't find (or read) '$file': $!\n" if !(-e $file); print abs_path($file) , "\n";

    The reason for writing it was that I frequently found myself copying file names from the terminal to email as a pointer to someone and it was getting annoying to write "pwd", copy the output, then copy the filename and paste it after the "pwd" output.

Re: Private Utilities
by holli (Monsignor) on Dec 01, 2005 at 16:55 UTC
    This is a little helper named ncopy. It copies files from one place to another.

    ncopy <files(s)> <target>
    <files(s)> is just a filename (wildcards possible) and <target> is an expression for the target of the copy operation. So far there is nothing new. Here comes the interesting part:

    In the target expression you can use the following to refer to parts of the source path and name:
    *0 first directory after root *1 second directory after root ... *-1 first directory above sourcefile *-2 second directory above sourcefile ... *n name of the sourcefile *s0 first suffix of the sourcefile *s1 second suffix oft the sourcefile
    So given the files a.txt and b.txt in c:\temp\foo\bar" and calling the script:
    C:\temp\foo\bar> *.txt .\*1\*n\*-1\t.*s0 mkpath C:\temp\foo\bar\foo\a\bar a.txt -> C:\temp\foo\bar\foo\a\bar\t.txt mkpath C:\temp\foo\bar\foo\b\bar b.txt -> C:\temp\foo\bar\foo\b\bar\t.txt
    As you can see you can easily transform file names while copying.

    It's only tested under Windows, but should be cross platform.

    holli, /regexed monk/
Re: Private Utilities
by neilwatson (Deacon) on Dec 01, 2005 at 18:03 UTC
    I have all types of scripts both Perl and otherwise. They range in purposes: user management, log parsing, CISCO work, database queries and others.

    While it is true that many scripts may not be useful for future jobs, one can never be sure. That's why I keep all this work in my Subversion repository.

    Neil Watson

Re: Private Utilities
by l3v3l (Monk) on Dec 01, 2005 at 18:05 UTC
    Perfect! I have been looking for just such a solution this morn and appreciate your post - here is one I just put together really quick ... to chunk up a given fasta file (unaligned sequences) in to N files for submission of multiple smaller jobs on a cluster:
    #!/usr/bin/perl -w use strict; my $num_ch = $ARGV[0] or die "must pass the # of chunks $!"; open (FH,"<$ARGV[1]") or die "must pass the file name to make chunks +of $!"; my @lines = (); $/ = ">"; while (<FH>){ chomp; next if /^$/; # get rid of blank lines push @lines,">$_"; } close FH; my $num_rec = scalar(@lines); print "number of records : $num_rec\n"; #die "Chunks exceed records!!" unless ($num_rec >= $num_ch); sub write_em { my $output = shift()."_chunk.fa"; my $ar_ref = shift; open (QRTR,">$output") or die "Cannot open $output : $!"; print QRTR @$ar_ref; close (QRTR) or die "cannot close $output : $!"; } my $cnt = 0; my $rng = int($num_rec/$num_ch) + ($num_rec%$num_ch ? 1 : 0); for (1..$num_ch) { write_em($_,[@lines[$cnt..($_ == $num_ch ? $#lines : ($cnt+($r +ng-1)))]]); $cnt += $rng; }
    Feel free to comment or point me in the right direction where I have gone astray - this just scratched a specific itch ...
      From what I understand, these files can be large. I also see that you're essentially reading the whole file into memory. The combination of those two could be bad. Before I propose a better solution, is it okay to put adjacent lines in different files? That is, let's say that I have a file that contains the following:
      Is it okay to split into two files like so:
      If so, I may have a really slick solution floating in my head...


      The only easy day was yesterday

        no problem!! round robin is fine - here is a way I have done it in a liner without having to read the entire file into mem (just an example) :
        # Choose first N FASTA records perl -ne 'BEGIN {$/=">";$o=0}{chomp;$o<N?(/^$/?next:print">$_"):last;$ +o++}' EXAMPLE.fa
        example usage:
        perl -ne 'BEGIN{$/=">";$o=0}{chomp;$o<22?(/^$/?next:print">$_"):last; +$o++}' b4x_est100.fa # print the first 22 records
Re: Private Utilities
by Spidy (Chaplain) on Dec 01, 2005 at 18:48 UTC
    I wrote an FTP script, because I was getting sick of the nag screen on my FTP's under the code section, as Not massively feature-rich, but it gets the job done for me, and is easy enough to fix up if there are issues.
Re: Private Utilities
by radiantmatrix (Parson) on Dec 02, 2005 at 20:29 UTC

    I use Windows at work, and use my Desktop as a workspace. However, I often am too lazy to clean my desktop off (which really just involves moving documents into a directory, archives into an 'Apps' directory {they are usually downloads}, and shortcuts off to a 'Shortcuts' directory). So, I let Perl do the heavy lifting for me:

    package main; use strict; use warnings; our $VERSION = '0.01'; our $BUILD = 'Oct 24, 2005'; #__modules__ use POSIX qw[_exit]; use Win32::TieRegistry; use File::Spec::Functions ('catdir','catfile'); use File::Copy; main( \@ARGV ); #_____________________________________________________________________ +__ main()_ sub main { # main ( \@argv ) my $argv = shift; $Registry->Delimiter('/'); my $sh_fold = $Registry->{'HKEY_CURRENT_USER/Software/Microsoft/Wi +ndows/CurrentVersion/Explorer/Shell Folders'}; my $desk = $sh_fold->{'Desktop'}; my $docs = $sh_fold->{'Personal'}; chdir $desk; opendir my $DESK, $desk or die ('Opening Desktop: '.$!); my (@doc, @dir, @exe, @lnk); for (readdir $DESK) { next if /^\.{1,2}$/; # skip . and .. if ( -d $_ ) { push @dir, $_ and next } next unless -f $_; # executable and other "non-document" types if ( /\.(?:exe|zip|tgz|tar|gz|com|msi|ini)$/i ) { push @exe, $_; } elsif (/\.lnk$/i) { next if /^CleanDesk/i; push @lnk, $_; } else { push @doc, $_; } } my $newdir = catdir($docs, 'Cleaned'); mkdir $newdir; $|=1; for (@doc) { print $_,' => '; my $new = catfile($newdir,$_); copy($_, $new) or do { warn "Skipping $_: $!"; next; }; print $new,"\n"; unlink($_); } mkdir catdir($newdir,'Apps'); for (@exe) { print $_,' => '; my $new = catfile($newdir,'Apps',$_); copy($_, $new) or do { warn "Skipping $_: $!"; next; }; print $new,"\n"; unlink($_); } for (@dir) { print $_,' => '; system('move',$_,$newdir); print catdir($newdir,$_),"\n"; } mkdir catdir($newdir,'Shortcuts'); for (@lnk) { print $_,' => '; my $new = catfile($newdir,'Shortcuts',$_); copy($_, $new) or do { warn "Skipping $_: $!"; next; }; print $new,"\n"; unlink($_); } _exit(0); } #_____________________________________________________________________ +_____ END_ _exit(250); ## unknown exit code. Should *never* happen; __END__ =head1 Cleans Desktop items into the My Documents folder =cut
    A collection of thoughts and links from the minds of geeks
    The Code that can be seen is not the true Code
    "In any sufficiently large group of people, most are idiots" - Kaa's Law

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://513033]
Approved by Old_Gray_Bear
Front-paged by Old_Gray_Bear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (3)
As of 2014-04-21 03:04 GMT
Find Nodes?
    Voting Booth?

    April first is:

    Results (490 votes), past polls