Archive for the ‘perl’ Category

Sort by File Size with du

Tuesday, March 2nd, 2010

Here is a handy Perl script I wrote a while back to sort the output from du -sh by file size. The standard sort command can’t do this because it doesn’t know how to compare values like “488M” and “5.0K.” My code will sort any lines where this values appear in the first field. I’m sure the Perl could be more compressed, but keeping it easy to read like this is more my style:


#!/usr/bin/perl -w
use strict;
use Data::Dumper;

my @lines;

while (<>) {
        chomp;
        push @lines, [unabbrev($_), $_];
        # print "$_: ", unabbrev($_), "\n";
}

# print Dumper \@lines;

for my $line (reverse sort { return $a->[0] <=> $b->[0] } @lines) {
        print $line->[1], "\n";
}

sub unabbrev {
        my $val = shift;
        if ($val =~ m/^\s*(\d+(\.\d+)?)([KMGB]?)/) {
                if ($3 eq 'K') {
                        $val = $1 * 1000;
                } elsif ($3 eq 'M') {
                        $val = $1 * 1000000;
                } elsif ($3 eq 'G') {
                        $val = $1 * 1000000000;
                } else { # B or nothing
                        $val = $1;
                }
        }
        return $val;
}

It’d be fun to re-write this in ruby—or even better, add it as a feature to GNU sort.

UPDATE: Reading the documentation for GNU coreutils (which contains sort), I see that sort does have an -h option (for –human-numeric-sort). Strangely, this option is not documented in the man page on Ubuntu 9.10 and is unrecognized by /usr/bin/sort. I guess I’ve got an old version.

If anyone is looking for a small open source project, sort’s implementation of this option could still be improved. Right now, according to the online docs, “values with different precisions like 6000K and 5M will be sorted incorrectly.” It’d be great if it fully implemented the rules for block size used by other coreutils programs.

Posted in linux, perl | No Comments »

Fancy rtouch

Monday, March 9th, 2009

Well, it turns out Ruby’s library functions for touch don’t let you specify a modification time; you can set the file to the current time only. I could just call out to the touch binary, but that wouldn’t be very portable. So I’m back to Perl. Here is the program with a -t [[CC]YY]MMDDhhmm[.SS] option, just like touch(1):

#!/usr/bin/perl -w
use strict;
use File::Find;
use Getopt::Std;
use Time::Local;

my $mtime;
my %opts;
getopts('ht:', \%opts);

if ($opts{h}) {
  usage();
  exit 0;
}

if ($opts{t}) {
  if ($opts{t} =~ m/(\d\d\d\d|\d\d)?(\d\d)(\d\d)(\d\d)(\d\d)(\.(\d\d))?/) {
    my @now = localtime;
    my $cent = $now[5] + 1900;
    my $secs = $now[0];
    if ($1) {
      if (length $1 > 2) {
        $cent = $1;
      } else {
        $cent = 100 * int($cent / 100) + $1;
      }
    }
    if ($7) {
      $secs = $7;
    }
    @now = ();
    $now[0] = $secs;		# seconds
    $now[1] = $5;		# minutes
    $now[2] = $4;		# hours
    $now[3] = $3;		# day of the month
    $now[4] = $2 - 1;		# month (0..11)
    $now[5] = $cent - 1900;	# years since 1900

    $mtime = timelocal(@now);
  } else {
    usage();
    exit 1;
  }
} else {
  $mtime = time;
}

for my $dir (@ARGV ? @ARGV : ('.')) {
  if (-e $dir) {
    find sub {
      utime $mtime, $mtime, $_;
    }, $dir;
  } else {
    open NOTHING, ">$dir";
    close NOTHING;
    utime $mtime, $mtime, $dir;
  }
}

sub usage {
  print "USAGE: $0 [-t [[CC]YY]MMDDhhmm[.SS]] [files...]\n";
}

I debated whether rtouch should create nonexistent files. The regular touch command creates any files that don’t exist. But since rtouch is recursive, I’m not sure creating files makes sense. But I figured it could still be convenient, so you could give it a bunch of arguments with the intent, “Touch all these files and everything in them, creating empty files whenever one doesn’t exist.”

(In case you haven’t guessed, this week is spring break!)

Posted in linux, perl, ruby | 1 Comment »

rtouch

Sunday, March 8th, 2009

By the way . . .

Upgrading Wordpress is annoying! There was lots of “delete this folder–except for file x and folder y.” Because of how I organize things, at one point I found it useful to write a recursive touch script. Here it is:

#!/usr/bin/perl -w
use strict;
use File::Find;

my @dirs = @ARGV ? @ARGV : ('.');

find sub {
    system("touch", $_);
}, @dirs;

It’s pretty simple: for instance, it doesn’t pass along any options to the touch program. But I thought I’d put that off until I can rewrite it in ruby. This Perl version was just because I needed it done quick.

Posted in linux, perl | No Comments »