#!/usr/bin/perl -w use strict; use warnings; ################################################## my $OS = GetOS(); my $LINUX = ($^O =~ m/LINUX/i); @ARGV or NiceExit("This program requires an argument.\n\nUsage: perl imgview.pl "); my $IMGFILE = shift(@ARGV); if (-d $IMGFILE || $IMGFILE =~ m/[?*]+/) { my @FILES = FindPictures($IMGFILE); $IMGFILE = shift(@FILES); } -e $IMGFILE or NiceExit("File not found - $IMGFILE"); -f $IMGFILE or NiceExit("Not a plain file - $IMGFILE"); my @SCRIPT = ; my $FOOTER = join("\n", @SCRIPT); my $FULLNAME = FindFullName($IMGFILE); my $FULLPATH = GetPathOnly($FULLNAME); my @FILES = FindPictures($FULLPATH); my $TOTALFILES = @FILES; my $IMAGES = ''; RESTART: my $FILENAME = GetFileName($IMGFILE); my $COUNT = WhichImage($FILENAME); my @FILEINFO = stat($IMGFILE); my $FILESIZE = $FILEINFO[7]; $FILESIZE > 4 or NiceExit("File is too small - $IMGFILE"); my $FILEDATE = CustomDate($FILEINFO[9], 'MMM D YYYY h:mm:ssa'); $FILEDATE =~ s/ / /g; my $FILEMODE = sprintf('%.3o', $FILEINFO[2] & 511); $FULLNAME = FindFullName($IMGFILE); $IMAGES = ($COUNT+1) . " of $TOTALFILES"; my $HTML = "

~ | Last Modified: " . $FILEDATE . " | Mode: " . $FILEMODE . " | $IMAGES

"; local *OUTFILE; open OUTFILE, ">imgview.html" or die "\nError: Could not create output file - imgview.html\n"; print OUTFILE $HTML, "\n\n"; print OUTFILE $FOOTER; close OUTFILE; my $CMD = "yad --html --uri=imgview.html --print-uri --maximized --center --button=Close:1 --button='Use As Background':2 --button='Edit':3 --button='Show Folder':4 --button='Delete':5 --button='Previous':6 --button='Next':7 --buttons-layout=center --title='IMAGINE Image Viewer - $FULLNAME (" . Commify($FILESIZE) . " bytes)' > imgview.tmp"; print "\nExecuting : $CMD\n\n"; my $EXITCODE = system($CMD); print "\nExit code = $EXITCODE\n"; if ($EXITCODE == 512) { SetLinuxWallpaper($FULLNAME, 'stretch'); ShowDesktop(); } if ($EXITCODE == 1024) { OpenFileManager($FULLPATH); } if ($EXITCODE == 768) { EditPhoto($FULLNAME); } if ($EXITCODE == 1536 || $EXITCODE == 1792) # PREV OR NEXT BUTTONS { my $FOUND = -1; for (my $i = 0; $i < @FILES; $i++) { if (uc(GetFileName($FILES[$i])) eq uc($FILENAME)) { $FOUND = $i; last; } } if ($FOUND >= 0) { if ($EXITCODE == 1792) { if (++$FOUND >= @FILES) { $FOUND = 0; }} if ($EXITCODE == 1536) { if (--$FOUND < 0) { $FOUND = $#FILES; }} $IMGFILE = $FILES[$FOUND]; goto RESTART; } } exit; ################################################## # This is a quick shortcut to read a file: @ARGV = ('imgview.tmp'); print "\nThe following links were clicked in this order : \n\n\t"; while (<>) # Read one line at a time from temp file { my $LINK = ($_ =~ m/link([0-9]+)$/) ? $1 : 0; print " $LINK"; } ################################################## sub EditPhoto { my $FILE = $_[0]; system("lazpaint $FILE"); } ################################################## sub OpenFileManager { my $PATH = defined $_[0] ? $_[0] : '~'; RunLinux("pcmanfm-qt --new-window $PATH"); } ################################################## sub GetPathOnly { my $FULLNAME = defined $_[0] ? $_[0] : ''; my $P = rindex($FULLNAME, '/'); return ($P < 0) ? '' : substr($FULLNAME, 0, $P); } ################################################## sub WhichImage { my $THIS = uc($_[0]); for (my $i = 0; $i < @FILES; $i++) { if (uc(GetFileName($FILES[$i])) eq $THIS) { return $i; } } return -1; } ################################################## # String | v2023.5.28 # This function removes whitespace from the left # and right side of STRING. Whitespace is here defined # as any character whose ASCII value is less than 33. # This includes SPACE, TAB, ESC, NULL, CR, LF, etc... # # A benchmark test shows that this function is slightly # more efficient than using regex especially when a # string only contains one or two spaces that need # to be trimmed. # # Usage: STRING = Trim(STRING) # sub Trim { defined $_[0] and length($_[0]) or return ''; my $L = length($_[0]); my $P = 0; while ($P <= $L && ord(substr($_[0], $P++, 1)) < 33) {} $P--; while ($P <= $L && ord(substr($_[0], $L--, 1)) < 33) {} return substr($_[0], $P, $L - $P + 2); } ################################################## # v2019.6.15 # Just like Trim(), this function can remove spaces # or tabs from before and after STRING but it can also # remove any other character, whatever is found in SUBSTR. # Usage: STRING = TrimChar(STRING, SUBSTR) # sub TrimChar { defined $_[0] or return ''; my $L = length($_[0]); $L or return ''; defined $_[1] or return $_[0]; length($_[1]) or return $_[0]; my $START = 0; my $LAST = 0; while ($L--) { if (index($_[1], substr($_[0], $L, 1)) < 0) { $START = $L; $LAST or $LAST = $L + 1; } } return substr($_[0], $START, $LAST - $START); } ################################################## # # This function returns the OS type as a number. # 1=DOS 2=WINDOWS 3=LINUX 4=OSX 9=OTHER # Usage: INTEGER = GetOS() # sub GetOS { my $OS = uc($^O); index($OS, 'LINUX') >= 0 ? 3 : index($OS, 'MSWIN') >= 0 ? 2 : index($OS, 'DOS') >= 0 ? 1 : index($OS, 'DARWIN') >= 0 ? 4 : 9; } ################################################## sub FindPictures { my $PATH = defined $_[0] ? $_[0] : '.'; my $JPG = `find $PATH -maxdepth 1 -type f -name *.jpg -exec realpath {} \\;`; my $BMP = `find $PATH -maxdepth 1 -type f -name *.bmp -exec realpath {} \\;`; my $GIF = `find $PATH -maxdepth 1 -type f -name *.gif -exec realpath {} \\;`; my $PNG = `find $PATH -maxdepth 1 -type f -name *.png -exec realpath {} \\;`; my $TIF = `find $PATH -maxdepth 1 -type f -name *.tif -exec realpath {} \\;`; my $PCX = `find $PATH -maxdepth 1 -type f -name *.pcx -exec realpath {} \\;`; my @FILES = split(/[\r\n]+/, "$JPG\n$BMP\n$GIF\n$PNG\n$TIF\n$PCX"); return @FILES; } ################################################## sub FindFullName { my $FILE = defined $_[0] ? $_[0] : ''; -e $FILE or return $ENV{PWD}; my $FILENAME = ''; my $RELPATH = ''; my $P = rindex($FILE, '/'); if ($P >= 0) { $FILENAME = substr($FILE, $P + 1); $RELPATH = substr($FILE, 0, $P); } my $FULLNAME = `find $RELPATH -maxdepth 1 -name "$FILENAME" -exec realpath {} \\;`; $FULLNAME =~ tr|\r\n\0||d; return $FULLNAME; } ################################################## # System | v2024.2.13 # Show desktop, minimize all windows # # This function causes Windows and Linux to minimize # all windows and show the desktop icons. It might # not work on other operating systems. # # Note: On Windows, calling this function repeatedly will # minimize all windows and then restore all windows. # # Usage: ShowDesktop() # sub ShowDesktop { $^O =~ m/DOS/i and return 0; $^O =~ m/MSWIN/i or return RunLinux('wmctrl -k on'); # On Windows, we create a tiny JS file and run it. # This solution works on all Windows. my $JSCODE = 'WScript.CreateObject("Shell.Application").ToggleDesktop();'; my $TEMPFILE = TempFile('ShowDesktop.js'); CreateFile($TEMPFILE, $JSCODE); system("WSCRIPT.EXE $TEMPFILE"); return 1; } ################################################## # v2019.11.28 # This function expects a relative path which may # begin with . or .. and returns an absolute path. # Usage: FULLPATH = AbsPath(PATH) # sub AbsPath { defined $_[0] or return ''; my $P = Trim($_[0]); length($P) or return ''; $OS > 2 or $P =~ tr#\\#/#; if (vec($P, 0, 8) == 46) # Starts with . or .. { return JoinPath(GetCurrentDirectory(), $P); } elsif (vec($P, 0, 8) == 47) # Starts with / or \ { return JoinPath(GetCurrentDrive() . '/', $P); } elsif (vec($P, 1, 8) == 58) # Starts with a drive letter? { if (vec($P, 2, 8) != 47) # Missing / or \ { my $DRIVE = substr($P, 0, 2); my $PATH_WITHOUT_DRIVE = substr(GetCurrentDirectory($DRIVE), 2); $P = substr($P, 2); # If the path is "C:WORK" or something like that, then # it is clearly missing a part. The drive letter # must always be followed by a backslash. return JoinPath($DRIVE . '/', $PATH_WITHOUT_DRIVE, $P); } return JoinPath($P, ''); } return JoinPath(GetCurrentDirectory(), $P); } ################################################## # v2019.11.28 # Returns the current working directory. (If a drive # letter is specified, then it returns the current # directory of that drive. This applies to DOS/Windows # only where each drive has its own current directory.) # Usage: STRING = GetCurrentDirectory([DRIVE]) # Example: GetCurrentDirectory('D:') --> 'D:\WORK' # sub GetCurrentDirectory { if ($OS < 3) { my $DRIVE = defined $_[0] ? substr($_[0], 0, 2) : ''; return Trim(`CD $DRIVE`); } return Trim(exists($ENV{PWD}) ? $ENV{PWD} : `pwd`); } ################################################## # v2019.7.13 # This function joins two names into a single path by # adding / in between the names. It also simplifies the # resulting path by removing repeated \\ // characters, # and tries to resolve the "." and ".." in a path name # to literal names only. # Usage: STRING = JoinPath(STRING, [STRING], [STRING]]) # sub JoinPath { @_ or return ''; my @A; my $P; foreach $P (@_) # Collapse array { defined $P or next; length($P) or next; $OS > 2 or $P =~ tr#/#\\#; push(@A, $P); # Change "/" to "\" on DOS/Win } @A or return ''; $P = shift(@A); # Extract first element $P = Trim($P); my $L = length($P); $L or return ''; # Remove prefix if (uc(substr($P, 0, 8)) eq 'FILE:///') { $P = substr($P, 8); } # Detect drive letter / start point on DOS/Win my $DRIVE = ''; my $BACKSLASH = ''; my $SEPARATOR = '/'; if ($OS < 3) { if (vec($P, 1, 8) == 58) { $DRIVE = substr($P, 0, 2); $P = substr($P, 2, $L); } if (vec($P, 0, 8) == 92) { $BACKSLASH = '\\'; $P = substr($P, 1, $L); } $SEPARATOR = '\\'; } unshift(@A, $P); # Put it back # Split along each separator @A = split("\\$SEPARATOR", join($SEPARATOR, @A)); # Process each section of path my $TRIM = $OS > 2 ? '/' : '/\\'; for (my $i = 0; $i < @A; $i++) { # Remove leading and trailing slashes $A[$i] = TrimChar($A[$i], $TRIM); # Remove "." or zero-length string if ($A[$i] eq '.' || length($A[$i]) == 0) { splice(@A, $i--, 1); next; } # Resolve ".." if ($A[$i] eq '..') { if ($i > 0) { splice(@A, --$i, 2); $i--; } else { splice(@A, $i, 1); $i--; } } } return $DRIVE . $BACKSLASH . join($SEPARATOR, @A); } ################################################## # File | v2023.12.19 # Returns the file name and extension from a full name # # This function expects a full path and returns # the file name only with the extension. # See Also: GetFileNameOnly() # # Usage: FILENAME = GetFileName(FULLNAME) # sub GetFileName { my $F = defined $_[0] ? $_[0] : ''; # Remove line breaks, spaces, tabs, null character and # quotation marks from the front and end of the string: $F =~ s/^[\"\0\r\n\t ]+|[\"\0\r\n\t ]+$//g; $F =~ tr|\\|/|; # Change all \ to / my $P = rindex($F, '/'); # Find the last / return ($P < 0) ? $F : substr($F, $P + 1); } ################################################## sub Alert { my $MSG = join("\n", @_); print "\n\nIMAGINE Image Viewer\n\n$MSG\n\n"; $MSG =~ s/>/>/g; $MSG =~ s//g; local *OUTFILE; open OUTFILE, ">imgview.html" or die "\nError: Could not create output file - imgview.html\n"; print OUTFILE '

', $MSG; close OUTFILE; my $CMD = "yad --html --uri=imgview.html --width=400 --height=200 --center --button=OK:1 --buttons-layout=center --title='IMAGINE Image Viewer'"; system($CMD); } ################################################## # Linux | v2024.2.13 # Updates the desktop background wallpaper on Linux # # This function changes the desktop background wallpaper # to a new image on Linux. The new image can be either a # canvas reference or a string holding the exact # file name of an image including full path. # # This function updates three things at the same time: # It updates 1) the desktop wallpaper image, 2) the # image layout, and the 3) background color. # Leaving one of the arguments undefined causes # the function to skip that change. # # This function is designed to work on Linux. # # MODE : color | stretch | fit | center | tile | zoom # # COLOR should be given as an integer such as 0xff99ff for pink. # # Usage: STATUS = SetLinuxWallpaper([FILENAME OR CANVASREF, [MODE, [COLOR]]]) # sub SetLinuxWallpaper { no warnings; my $CANVAS = defined $_[0] && length(ref($_[0])) ? $_[0] : 0; my $FILE = defined $_[0] && !length(ref($_[0])) ? FilterFileName($_[0]) : ''; my $MODE = defined $_[1] ? lc($_[1]) : ''; my $COLOR = defined $_[2] ? int($_[2]) : 0x000811; if ($LINUX) { if (length($FILE) && $MODE ne 'color') { RunLinux("pcmanfm-qt --wallpaper-mode=stretch --set-wallpaper=\"$FILE\""); } elsif (defined $_[2] || $MODE eq 'color') { # my $TEMPFILE = TempFile('bg####.bmp'); # $CANVAS = NewCanvas(100, 100, 24, $COLOR); # SaveBMP($CANVAS, $TEMPFILE); # return RunLinux("pcmanfm-qt --wallpaper-mode=tile --set-wallpaper=\"$TEMPFILE\""); } if (defined $_[1] && $MODE =~ m/stretch|fit|center|tile|zoom/) { return RunLinux("pcmanfm-qt --wallpaper-mode=$MODE"); } return 1; } return 0; } ################################################## # File | v2022.11.25 # This function removes illegal characters from # a file name such as: $ % ? * < > | " \t \r \n \0 # and any character whose ASCII value is 0-31. # # Usage: FILENAME = FilterFileName(FILENAME) # sub FilterFileName { defined $_[0] or return ''; my $F = length($_[0]) > 65535 ? substr($_[0], 0, 65535) : $_[0]; $F =~ tr`<>*%$?\"\|\x00-\x1F``d; return $F; } ################################################## # Linux | v2024.2.13 # Executes a linux program if it exists # # This function executes a Linux program and # returns 1 if the program is found in the PATH, # or zero if the program could not be found. # # Usage: INTEGER = RunLinux(STRING...) # sub RunLinux { my $CMD = Trim(join(' ', @_)); my $PRG = ($CMD =~ m/^([a-zA-Z0-9_\/\-.~!]+)/) ? $1 : ''; if (length(`which $PRG`)) { system("$CMD &"); return 1; } return 0; } ################################################## sub NiceExit { Alert(@_); exit; } ################################################## sub EXIT { # Cleanup } ################################################## # String | v2018.6.5 # Inserts commas into a number # # This function inserts commas into a number at # every 3 digits and returns a string. # # This one-liner was originally written by # Martin Fabiani (strat) and was posted on the PerlMonks # website at www.PerlMonks.org/?node_id=157725 # # Usage: STRING = Commify(INTEGER) # sub Commify { my $N = reverse $_[0]; $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return scalar reverse $N; } ################################################## # File | v2024.2.14 # Creates a new file and writes something in it # # This function creates a file in binary mode and # writes a string into it. If the file has already # existed, the old content will be erased and # replaced with the new content. # Returns 1 on success or 0 if something went wrong. # # This function can have two or more arguments. # The first argument must be the file name, # followed by string(s) to be written to the # file in binary mode starting at the # beginning of the file. # # Usage: STATUS = CreateFile(FILENAME, [STRINGS...]) # sub CreateFile { @_ or return 0; # Must have at least 1 argument! defined $_[0] or return 0; my $F = shift; $F =~ tr`\x00-\x1F"*?|<>``d; # Remove illegal characters. length($F) or return 0; # No file name? # If the file already exists and happens to be a directory or # something other than a plain file, then we must return zero. if (-e $F) { -f $F or return 0; } my $SIZE = 0; local *FILE; open(FILE, ">$F") or return 0; # Create the file. binmode FILE; foreach (@_) { defined $_ && length($_) or next; $SIZE += length($_); print FILE $_; } close FILE; chmod 0660, $F; return (-f $F && -s $F == $SIZE) ? 1 : 0; # Verify file size. } ################################################## # Time | v2022.2.11 # This function converts time to custom format. # Example: # 'DDD MMM D YYYY h:mm:ssa' => 'Fri Feb 11 2022 9:33:13p' # 'YYYY-MM-DD HHmm' => '2022-11-02 2133' # 'MMMM D, DDD Haa' => 'July 4, Wednesday 6pm' # # The following words in the format field will # be replaced with values: # # YYYY => four-digit year, i.e. '1997' # YY => two-digit year, i.e. '97' # MMMM => the name of the month, i.e. 'August' # MMM => three-letter name of month, 'Jul' # MM => two-digit month, i.e. '06' # M => month as a number, '6' # DDDD => day of the week, i.e. 'Friday' # DDD => three-letter day of the week, 'Fri' # DD => two-digit day of the month, '08' # D => day as a number, '8' # HH => two-digit hour in 24-hour format, '08' # H => hour in 24-hour format, '8' # hh => two-digit hour in 12-hour format, '05' # h => hour in 12-hour format, '5' # mm => two-digit minute, '07' # m => minute as a number, '7' # ss => two-digit second, '09' # s => minute as a second, '9' # A => the letters 'A' or 'P' # a => just 'a' or 'p' # AA => the letters 'AM' or 'PM' # aa => just 'am' or 'pm' # # Usage: STRING = CustomDate([TIME], [FORMAT]) # sub CustomDate { my $TIME = defined $_[0] ? $_[0] : time; my $FORMAT = defined $_[1] ? $_[1] : 'YYYY-MM-DD hh:mm:ssxx'; my ($SEC, $MIN, $HR, $DAY, $MONTH, $YR, $DAY_OF_WEEK) = localtime($TIME < 0 ? time : $TIME); my $MO = qw(January February March April May June July August September October November December)[$MONTH]; $DAY_OF_WEEK = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday)[$DAY_OF_WEEK]; $YR += 1900; $MONTH++; my $HR12 = $HR > 0 ? $HR : 12; $HR12 < 13 or $HR12 -= 12; # The following line will split $FORMAT every time a different character # is encountered. This line was written by Egon Choroba. Thank you! my @F; push @F, $1 while $FORMAT =~ /((.)\2*)/g; foreach(@F) { if ($_ eq 'YYYY') { $_ = $YR; } elsif ($_ eq 'YY') { $_ = substr($YR, 2, 2); } elsif ($_ eq 'MMMM') { $_ = $MO; } elsif ($_ eq 'MMM') { $_ = substr($MO, 0, 3); } elsif ($_ eq 'MM') { $_ = sprintf('%.02d', $MONTH); } elsif ($_ eq 'M') { $_ = $MONTH; } elsif ($_ eq 'DDDD') { $_ = $DAY_OF_WEEK; } elsif ($_ eq 'DDD') { $_ = substr($DAY_OF_WEEK, 0, 3); } elsif ($_ eq 'DD') { $_ = sprintf('%.02d', $DAY); } elsif ($_ eq 'D') { $_ = $DAY; } elsif ($_ eq 'HH') { $_ = sprintf('%.02d', $HR); } elsif ($_ eq 'H') { $_ = $HR; } elsif ($_ eq 'hh') { $_ = sprintf('%.02d', $HR12); } elsif ($_ eq 'h') { $_ = $HR12; } elsif ($_ eq 'mm') { $_ = sprintf('%.02d', $MIN); } elsif ($_ eq 'm') { $_ = $MIN; } elsif ($_ eq 'ss') { $_ = sprintf('%.02d', $SEC); } elsif ($_ eq 's') { $_ = $SEC; } elsif ($_ eq 'AA') { $_ = ($HR12 < 12) ? 'AM' : 'PM'; } elsif ($_ eq 'A') { $_ = ($HR12 < 12) ? 'A' : 'P'; } elsif ($_ eq 'aa') { $_ = ($HR12 < 12) ? 'am' : 'pm'; } elsif ($_ eq 'a') { $_ = ($HR12 < 12) ? 'a' : 'p'; } } return join('', @F); } ################################################## # Terminal | v2024.4.22 # This function clears the terminal window. # It has been tested on Linux, Windows, DOS, and MacOS. # It may or may not work in other environments. # # Usage: CLS([COLOR]) # sub CLS { if ($^O =~ m/DOS/i) { return system('COMMAND.COM /C CLS'); } if ($^O =~ m/LINUX/i) { return print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; } if ($^O =~ m/MSWIN/i) { system('CLS'); system('COLOR 07'); return 1; } if ($^O =~ m/DARWIN/i) { return print "\x1B[3J"; } } ################################################## __DATA__