Convert retina graphics to non-retina graphics, for iOS

retina2nonretina.pl

#! /usr/bin/perl
# by Michael Peternell
# Created: 23. Okt. 2012
# Version 0.2

use strict;
use Cwd qw(abs_path);

#use Getopt::Long;

sub retina_to_lq_filename
{
	my $fn = shift;
	$fn =~ s/\@2x\././;
	return $fn;
}

sub widthOfRetinaImages
{
	local *SIPS;
	open(SIPS, "-|", "sips", "--getProperty", "pixelWidth", @_)
		or die("Cannot fork");
	my %result;
	my $filename;
	my $pixelWidth;
	while(<SIPS>)
	{
		#print;
		if(m/\/([^\/]+\@2x\.[a-z]+)/)
		{
			$filename = $1;
			#print "Filename: $filename\n";
		}
		elsif(m/pixelWidth:\D*(\d+)/)
		{
			$pixelWidth = $1;
			#print "PixelWidth: $pixelWidth\n";
			if($filename)
			{
				$result{$filename} = $pixelWidth;
				$filename = 0;
			}
		}
	}
	#print "End of w-function\n";
	return %result;
}

sub downsample
{
	my $output_directory = shift;
	my %result = widthOfRetinaImages(@_);
	my $retina_filename;
	foreach $retina_filename (keys %result)
	{
		my $value = $result{$retina_filename};
		my $lq_filename = retina_to_lq_filename($retina_filename);
		print "$retina_filename => $lq_filename\n";
		if($value >= 2)
		{
			my $lq_value = int($value / 2);
			print "Downsampling $retina_filename ........\n";
			system("sips", "--resampleWidth", $lq_value, $retina_filename, "--out", "$output_directory/$lq_filename");
		}
	}
}

sub downsample_directories
{
	my $input_dir = shift;
	my $output_dir = shift;
	chdir($input_dir);

	my @retina_pictures = glob('*@2x.*');
	#print join("\n", @retina_pictures), "\n\n";
	my @to_process;
	for my $retina_filename (@retina_pictures)
	{
		my $lq_filename = $output_dir."/".retina_to_lq_filename($retina_filename);
		my $retina_mtime = (stat($retina_filename))[9];
		my $lq_mtime = (stat($lq_filename))[9];
		if($retina_mtime >= $lq_mtime)
		{
			push @to_process, $retina_filename
		}
	}

	#print scalar(@to_process), " values need update\n";
	#print join("\n", @to_process), "\n\n";

	if(scalar(@to_process) > 0)
	{
		downsample($output_dir, @to_process);
	}
}

sub downsample_recursive
{
	my $input_dir = shift;
	my $output_dir = shift;
	my $max_depth = shift;
	if($max_depth <= 0)
	{
		return;
	}
	$input_dir = abs_path($input_dir);
	$output_dir = abs_path($output_dir);
	print "input-dir: $input_dir\n";
	print "output-dir: $output_dir\n";
	print "max_depth: $max_depth\n\n";
	downsample_directories($input_dir, $output_dir);
	if($max_depth == 1)
	{
		return;
	}

	

	# recurse into subdirectories
	chdir($input_dir);
	opendir(my $dh, $input_dir) or die("Cannot access directory: $input_dir");
	while(my $dirname = readdir $dh)
	{
		my $full_dirname = $input_dir . "/" . $dirname;
		if(!($dirname =~ m/^\./) and -d $full_dirname)
		{
			my $full_output_dirname = $output_dir . "/" . $dirname;
			mkdir $full_output_dirname unless -d $full_output_dirname;
			print "recursive call: $dirname\n";
			downsample_recursive($full_dirname, $full_output_dirname, ($max_depth - 1));
		}
	}
}

my $MAX_DEPTH = 5;

if(scalar(@ARGV) != 2)
{
	print "perl_retina: convert retina-graphics (e.g. bla\@2x.png) to non-retina (e.g bla.png)\n";
	print "Maximum recursive depth: $MAX_DEPTH\n";
	print "Usage: $0 input-directory output-directory\n";
	exit(2);
}

die("Input directory doesn't exist or not accessable\n", $ARGV[0]) unless -d $ARGV[0];
die("Output directory doesn't exist or not accessable\n", $ARGV[1]) unless -d $ARGV[1];


downsample_recursive($ARGV[0], $ARGV[1], $MAX_DEPTH);