Skip to content

Instantly share code, notes, and snippets.

@protospork
Created August 10, 2012 15:16
Show Gist options
  • Save protospork/3314924 to your computer and use it in GitHub Desktop.
Save protospork/3314924 to your computer and use it in GitHub Desktop.
perl script for fixing file extensions
#!/usr/bin/perl
use Modern::Perl;
use File::MMagic;
# This script uses MAGIC (numbers) to rename images to have proper extensions.
# (Okay, so it just calls a module to do it)
# There's a unix hashbang up there but I'm only testing this in windows (strawberry perl 5.12)
# INSTALL:
# Step 1:
# Make sure you actually have perl (http://strawberryperl.com/).
# Open a cmd window/terminal, type `cpan -i Modern::Perl`, wait for it, then `cpan -i File::MMagic`
#
# Step 2:
# Windows: Make a file called fixext.bat containing the line 'perl "C:\path\to\fixext.pl"'.
# Put the .bat file in C:\Windows\System32 or anywhere else in your PATH.
#
# Linux: alias fixext='perl path/to/fixext.pl'
#
# Now you can invoke the script from any directory with "fixext".
# Aug 2012 by protospork. public domain and shit
my $recurse = 1;
#Scans into every subfolder. Can be disabled with the -l ("local") option
my $silent = 0;
#1 if you don't want to be told what the script is doing. you can also call the script with -q ("quiet").
#If you enable this, I recommend enabling the next option too.
my $preserve_ext = 0;
#1 if you want to always keep the original file extension,
#but append the real one (to make it clickable/fix thumbnailing). Matches -p (backwards q / "preserve")
my $all_types = 0;
#with this disabled, only scan jpe?g/gif/png (I recommend it stays disabled, you can use -e ("everything"))
if (@ARGV){
if ($ARGV[0] =~ /^-(\w+)/){ #SWITCHES
my $args = $1;
shift @ARGV;
if ($args =~ /l/){ $recurse = 0; } #l for "local"
if ($args =~ /q/){ $silent = 1; } #q for "quiet"
if ($args =~ /p/){ $preserve_ext = 1; } #p for "preserve" extensions (it's a backwards q)
if ($args =~ /e/){ $all_types = 1; } #e for "everything"
}
}
my $stay = 0;
sub fixext {
my $name;
if ($recurse){ $name = $_; } else { $name = shift; }
if (! $all_types && $name !~ /\.(jpe?g|gif|png|bmp)/i){ return; }
my $diskmime = File::MMagic->new->checktype_filename($name);
if ($diskmime !~ /image/){
return if $diskmime =~ /x-system|octet-stream/; #folders are x-system/x-unix, I think IO errors are x-system too
say 'not an image: '.$name unless $silent;
}
my $newext = $diskmime;
$newext =~ s{image/jpeg}{.jpg}i
|| $newext =~ s{image/png}{.png}i
|| $newext =~ s{image/gif}{.gif}i
|| $newext =~ s{(^|/)}{.}g; #should filename-safe any erroneous mimetypes
my $newname = $name;
$newname =~ s/(\.(jpe?g|gif|png))?$|(\.[^.]+?)?$//i unless $preserve_ext; #second match case added for -e
$newname .= $newext;
if ($name ne $newname){
if (! $silent){
if ($recurse){
say $File::Find::name.' => '.$newname;
} else {
say $name.' => '.$newname;
}
}
rename $name, $newname;
$stay++;
}
}
if (! $recurse){
#pre-File::Find search method, doesn't check subdirs
if ($all_types){
fixext $_ for <*>;
} else {
fixext $_ for <*.jpg *.jpeg>;
fixext $_ for <*.png>;
fixext $_ for <*.gif>;
}
} else {
#File::Find method, does
use File::Find;
# no warnings 'File::Find';
finddepth(\&fixext, '.');
}
#make the window hang around until you press the Any key
if ($stay && ! $silent){
$^O eq 'MSWin32'
? system 'pause'
: system 'read -p "Press any key to continue."';
exit;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment