Last active
February 7, 2023 12:28
-
-
Save kkew3/f8bb5f3362fe2402061bcb353fe78f86 to your computer and use it in GitHub Desktop.
Use (a little more intelligent) bisection algorithm to resize images under $from_dir to appropriate small size, and move them to $to_dir. The whole process is performed interactively. This script is designed for macOS and requires imagemagick to run.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use warnings; | |
use strict; | |
use File::Basename qw(fileparse); | |
use File::Copy qw(cp mv); | |
###################################################################### | |
# Configuration # | |
###################################################################### | |
# directory from which to import images | |
my $from_dir = glob("~/Downloads/"); | |
# directory to which to import images | |
my $to_dir = glob("~/Documents/Diary/imgs/"); | |
# directory to which to save original images before resizing | |
my $img_dir = glob("~/Pictures/"); | |
# expected image KB (not KiB) size lower bound and upper bound | |
my ( $kb_lb, $kb_ub ) = ( 10, 50 ); | |
# don't ask and use larger size if current size lower bound is this many | |
# lower than current sie upper bound; see `resize_dialog` below | |
my $min_diff_compr_pcnt = 5; | |
# tmp image name without extension | |
my $tmpfile_name = "out"; | |
###################################################################### | |
# End of Configuration # | |
###################################################################### | |
# common patterns used below | |
my $pat_ext = qr{\.[^.]*$}; # filename extension | |
# colors | |
my $color_bold_green = "\033[1;32m"; | |
my $color_reset = "\033[0m"; | |
# global indicator whether current (tmp image) as been opened | |
my $tmpfile_opened = 0; | |
# global indicator of tmp files to be cleaned up | |
my @tmp_path_written = (); | |
# ensure on TTY | |
unless ( -t STDIN && -t STDOUT ) { | |
print STDERR "stdin and/or stdout is not TTY!\n"; | |
exit(-1); | |
} | |
# ensure on Darwin | |
unless ( $^O =~ m{darwin} ) { | |
print STDERR "require Darwin OS to run!\n"; | |
exit(-1); | |
} | |
# ensure existence of `magick` command | |
unless ( system( "which", "-s", "magick" ) == 0 ) { | |
print STDERR "require 'magick' command to run!\n"; | |
exit(-1); | |
} | |
# Usage. | |
sub usage { | |
print( "usage: call without argument.\n" | |
. "Return value:\n" | |
. " * 0) no error;\n" | |
. " * n) where n > 0, that many images are skipped due to error;\n" | |
. " * 130) keyboard interrupt;\n" | |
. " * -1) (or 255) fatal error and/or the script dies.\n" ); | |
} | |
# Glob images from $from_dir. | |
sub find_imgs { | |
my @files = (); | |
for my $ext (qw(jpg JPG jpeg JPEG png PNG bmp BMP)) { | |
push( @files, glob( $from_dir . "*.$ext" ) ); | |
} | |
return @files; | |
} | |
# List lower case basename without suffix from directory arg 0. | |
sub ls_names { | |
die unless @_ == 1; | |
my ($dir) = @_; | |
my @names = (); | |
for my $filename ( glob( $dir . "*" ) ) { | |
my $name = fileparse( $filename, $pat_ext ); | |
push( @names, lc($name) ); | |
} | |
return @names; | |
} | |
# Handle and echo answer arg 0. If arg 0 is empty, fill it with default | |
# answer arg 1. arg 1 should be either 'y' or 'n'. | |
# Return 1 if arg 0 is eventually 'y'; empty string otherwise. | |
sub handle_ans { | |
die unless @_ == 2; | |
my ( $ans, $default_ans ) = @_; | |
$ans =~ s{\s}{}g; | |
$ans = $default_ans unless $ans; | |
$ans = $ans eq "y"; | |
print( "You answered ", $ans ? "y" : "n", ".\n" ); | |
return $ans; | |
} | |
# Display rename dialog. The rename should be done later from src arg 0 | |
# to some path with the returned value 0 as basename. | |
# The dialog loops until aborted or there's no name conflicts with any | |
# of names under $to_dir. | |
# No rename will be actually done here. | |
# Return undef if the user doesn't want to continue processing current | |
# file; otherwise, return dest basename and src extension name. | |
sub rename_dialog { | |
die unless @_ == 1; | |
my ($src_path) = @_; | |
my ( $src_name, undef, $src_ext ) = fileparse( $src_path, $pat_ext ); | |
# if $src_name does not contain 'IMG', which is a signal that the image | |
# has not been properly named, and if it has no name conflict with any | |
# images under $to_dir, then by default skip renaming unless user requests | |
# to | |
if ( lc($src_name) !~ m{img} | |
&& !grep { $_ eq lc($src_name) } ( ls_names($to_dir) ) ) | |
{ | |
print( "The image seems have been properly named. " | |
. "Skip renaming? ([y]/n) " ); | |
my $ans; | |
$ans = handle_ans( $ans = <STDIN>, "y" ); | |
if ($ans) { | |
return ( $src_name . $src_ext, $src_ext ); | |
} | |
} | |
my $dst_name; | |
my $ps1 | |
= "Rename w/out ext (input nothing to not rename, or press " | |
. "Ctrl-d to not continue processing this image): "; | |
my $ps2 | |
= "Name already exists.\n" | |
. "Use another name (input nothing to not rename, or press " | |
. "Ctrl-d to not continue processing this image): "; | |
for ( print($ps1); $dst_name = <STDIN>; print($ps2) ) { | |
chomp($dst_name); | |
$dst_name = $src_name unless $dst_name; | |
last unless grep { $_ eq lc($dst_name) } ( ls_names($to_dir) ); | |
} | |
unless ( defined $dst_name ) { | |
# pressed Ctrl-d | |
print("\n"); # to break from Ctrl-d | |
print( "Stopped processing curreng image.\n" | |
. "Current image will be left intact.\n" ); | |
return undef; | |
} | |
$dst_name = $dst_name . $src_ext; | |
return ( $dst_name, $src_ext ); | |
} | |
# Indicate whether arg 0 (bytes) is higher, within range, or lower than | |
# the expected size in KB. | |
sub in_valid_size_range { | |
die unless @_ == 1; | |
my ($size) = @_; | |
my $lb = $kb_lb * 1000; | |
my $ub = $kb_ub * 1000; | |
if ( $size < $lb ) { | |
return -1; | |
} | |
if ( $size > $ub ) { | |
return 1; | |
} | |
return 0; | |
} | |
# Quote arg 1 if it contains space. | |
# Only for aesthetic purpose when printing filenames. | |
# Don't use this function when passing arguments to executable as shell | |
# quoting is not implemented thoroughly here. | |
sub shquote { | |
die unless @_ == 1; | |
my ($str) = @_; | |
return $str =~ m{\s} ? "\"$str\"" : $str; | |
} | |
sub system_die_on_err { | |
die unless @_ > 0; | |
my @args = @_; | |
system(@args) == 0 or die("above command returns nonzero $?"); | |
} | |
# Run magick's resize command with input arg 0, percent arg 1, and output | |
# arg 2. | |
sub run_resize { | |
die unless @_ == 3; | |
my ( $src_path, $pcnt, $dst_path ) = @_; | |
print( $color_bold_green, "> magick ", shquote($src_path), | |
" -resize ", $pcnt, "% ", | |
shquote($dst_path), "\n", $color_reset, | |
); | |
system_die_on_err( "magick", $src_path, "-resize", "$pcnt%", $dst_path ); | |
} | |
# Run macOS's open command with arg 0 if $tmpfile_opened is zero. | |
sub run_open { | |
die unless @_ == 1; | |
my ($file) = @_; | |
unless ($tmpfile_opened) { | |
$tmpfile_opened = 1; | |
print( $color_bold_green, "> open ", shquote($file), "\n", | |
$color_reset ); | |
system_die_on_err( "open", $file ); | |
} | |
} | |
# Display resize dialog that keeps resizing arg 0 to arg 1 until satisfied. | |
# If eventually not satisfied, return zero; else return nonzero. | |
sub resize_dialog { | |
die unless @_ == 2; | |
my ( $src_path, $dst_path ) = @_; | |
$tmpfile_opened = 0; | |
cp( $src_path, $dst_path ) or die("Failed to cp $src_path $dst_path"); | |
my $lo = 1; | |
my $hi = 100; | |
my $mid; | |
my $satisfied_once = 0; | |
my $curr_size = -s $dst_path; | |
my $cmp; | |
my $ans; | |
while (( $satisfied_once && $lo + $min_diff_compr_pcnt < $hi ) | |
|| ( !$satisfied_once && $lo < $hi ) ) | |
{ | |
$mid = int( ( $lo + $hi ) / 2 ); | |
run_resize( $src_path, $mid, $dst_path ); | |
$curr_size = -s $dst_path; | |
print( | |
"Compressed size = ", | |
$curr_size, "B (", $curr_size / 1000, | |
"KB); ", | |
); | |
$cmp = in_valid_size_range($curr_size); | |
if ( $cmp > 0 ) { | |
$hi = $mid - 1; | |
print("trying to make smaller.\n"); | |
} | |
elsif ( $cmp < 0 ) { | |
$lo = $mid + 1; | |
print("trying to make larger.\n"); | |
} | |
else { | |
print("\n"); | |
run_open($dst_path); | |
print("Click the opened window. Satisfy? (y/[n]) "); | |
$ans = handle_ans( $ans = <STDIN>, "n" ); | |
if ($ans) { | |
$satisfied_once = 1; | |
$hi = $mid; | |
print("Trying to make smaller.\n"); | |
} | |
else { | |
$lo = $mid + 1; | |
print("Trying to make larger.\n"); | |
} | |
} | |
} | |
if ( !$satisfied_once ) { | |
print("Never satisfied within size range.\n"); | |
print("Skipped current image.\n"); | |
return 0; | |
} | |
run_resize( $src_path, $hi, $dst_path ); | |
# After this call the size of $dst_path must lie in range, since $hi | |
# won't be changed after previous satisfaction. | |
print("Done for current image.\n"); | |
return 1; | |
} | |
# Display copy-to-$img_dir dialog. This will copy src arg 0 to dest | |
# basename arg 1 under $img_dir if user agreed and if there will be no | |
# name conflicts. Return nonzero if no error occurs; 0 otherwise. | |
sub copy_to_imgdir_dialog { | |
die unless @_ == 2; | |
my ( $src_path, $dst_name ) = @_; | |
my $dst_path = $img_dir . $dst_name; | |
my $ans; | |
print("Copy \"$src_path\" to \"$dst_path\"? (y/[n]) "); | |
$ans = handle_ans( $ans = <STDIN>, "n" ); | |
if ( !$ans ) { return 1; } | |
if ( grep { $_ eq lc($dst_name) } ( ls_names($img_dir) ) ) { | |
print("Name \"$dst_name\" already exists in \"$img_dir\".\n"); | |
print("Current image will be left intact."); | |
return 0; | |
} | |
cp( $src_path, $dst_path ) or die("Failed to cp $src_path $dst_path"); | |
return 1; | |
} | |
sub ensure_tmpfile_writable { | |
die unless @_ == 0; | |
my $ans; | |
if ( grep( m{^out$}, ( ls_names($to_dir) ) ) ) { | |
print( "Found names resembling tmpfile \"$tmpfile_name\" " | |
. "under \"$to_dir\":\n" ); | |
print("They will be overwritten if you proceed.\nProceed? (y/[n]) "); | |
$ans = handle_ans( $ans = <STDIN>, "n" ); | |
return $ans; | |
} | |
return 1; | |
} | |
sub assure_unlink_src { | |
die unless @_ == 1; | |
my ($src_path) = @_; | |
my $ans; | |
print("Continue removing \"$src_path\"? ([y]/n) "); | |
$ans = handle_ans( $ans = <STDIN>, "y" ); | |
if ($ans) { | |
if ( !unlink($src_path) ) { | |
print("Failed to remove \"$src_path\"."); | |
return 1; | |
} | |
} | |
return 0; | |
} | |
# Clean up tmp images used previously. | |
sub clean_up { | |
unlink(@tmp_path_written); | |
print( "These tmp images have been removed: ", | |
join( ", ", @tmp_path_written ), "\n" ); | |
} | |
sub main { | |
for my $arg (@ARGV) { | |
if ( $arg eq "-h" || $arg eq "--help" ) { | |
usage(); | |
return 0; | |
} | |
} | |
if ( !ensure_tmpfile_writable() ) { | |
print("Aborted.\n"); | |
return 1; | |
} | |
my $ans; | |
my $skip_count = 0; | |
my $success; | |
for my $src_path ( find_imgs() ) { | |
print("Found image: $src_path\nProceed? ([y]/n) "); | |
$ans = handle_ans( $ans = <STDIN>, "y" ); | |
if ( !$ans ) { | |
print("Finding next image.\n"); | |
next; | |
} | |
my ( $dst_name, $src_ext ) = rename_dialog($src_path); | |
if ( !$dst_name ) { | |
$skip_count += 1; | |
print("Finding next image.\n"); | |
next; | |
} | |
my $tmp_path = $to_dir . $tmpfile_name . $src_ext; | |
if ( !grep { $_ eq $tmp_path } @tmp_path_written ) { | |
push( @tmp_path_written, $tmp_path ); | |
} | |
$success = resize_dialog( $src_path, $tmp_path ); | |
if ( !$success ) { | |
$skip_count += 1; | |
print("Finding next image.\n"); | |
next; | |
} | |
my $dst_path = $to_dir . $dst_name; | |
mv( $tmp_path, $dst_path ) or die("Failed to mv $tmp_path $dst_path"); | |
print( "Renamed ", $tmp_path, " to ", $dst_path, ".\n" ); | |
$success = copy_to_imgdir_dialog( $src_path, $dst_name ); | |
if ( !$success ) { | |
$skip_count += 1; | |
print("Finding next image.\n"); | |
next; | |
} | |
$success = assure_unlink_src($src_path); | |
if ( !$success ) { | |
$skip_count += 1; | |
next; | |
} | |
} | |
print("All images under $from_dir have been processed or skipped.\n"); | |
if (@tmp_path_written) { | |
clean_up(); | |
} | |
return $skip_count; | |
} | |
$SIG{INT} = sub { clean_up(); exit(130); }; | |
eval { exit( main() ); }; | |
print("Just dead from this script with message $@\n"); | |
clean_up(); | |
exit(-1); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment