Sunflower at 20:24, 27 June 2021

2021-06-27T20:24:14Z

← Older revision		Revision as of 20:24, 27 June 2021
Line 4:		Line 4:
	# ftp://ftp.imagemagick.org/pub/ImageMagick/ImageMagick.tar.gz		# ftp://ftp.imagemagick.org/pub/ImageMagick/ImageMagick.tar.gz
	# for jp(e)g resizing: Don't forget to install libjpeg-dev !!!		# for jp(e)g resizing: Don't forget to install libjpeg-dev !!!
		⚫

	use strict;		use strict;
	use Image::Magick;		use Image::Magick;
	use Getopt::Std;		use Getopt::Std;
		⚫

	sub usage {		sub usage {
	print << "END";		print << "END";

⚫
	Usage $0 [-h] [-i] [-p] [-d directory] [-n newdirectory]		Usage $0 [-h] [-i] [-p] [-d directory] [-n newdirectory]
	Resizes pictures from folder -d directory to -p percent of original size and		Resizes pictures from folder -d directory to -p percent of original size and
	copies them into new folder -n newdirectory.		copies them into new folder -n newdirectory.

⚫
	Options:		Options:
	-h print this help		-h print this help
Line 27:		Line 27:
	exit 42;		exit 42;
	}		}


	# path where pictures come from		# path where pictures come from
	my $path;		my $path;
Line 34:		Line 34:
	my ($bild, $image);		my ($bild, $image);
	my $size;		my $size;


	my %opts = ();		my %opts = ();
	getopts( "ihp:d:n:", \%opts);		getopts( "ihp:d:n:", \%opts);


	if ( $opts{h} or ( ! $opts{p} ) or ( ! $opts{i} and ! $opts{d} )) {		if ( $opts{h} or ( ! $opts{p} ) or ( ! $opts{i} and ! $opts{d} )) {
	usage();		usage();

Sunflower: Die Seite wurde neu angelegt: „ #!/usr/bin/perl -w # resizes images in a folder to be specified # you will get the imagemackick-module from: # ftp://ftp.imagemagick.org/pub/ImageMagick/Image…“

2012-03-07T22:00:53Z

Die Seite wurde neu angelegt: „ #!/usr/bin/perl -w # resizes images in a folder to be specified # you will get the imagemackick-module from: # ftp://ftp.imagemagick.org/pub/ImageMagick/Image…“

New page

#!/usr/bin/perl -w
# resizes images in a folder to be specified
# you will get the imagemackick-module from:
# ftp://ftp.imagemagick.org/pub/ImageMagick/ImageMagick.tar.gz
# for jp(e)g resizing: Don't forget to install libjpeg-dev !!!

use strict;
use Image::Magick;
use Getopt::Std;

sub usage {
print << "END";

Usage $0 [-h] [-i] [-p] [-d directory] [-n newdirectory]
Resizes pictures from folder -d directory to -p percent of original size and
copies them into new folder -n newdirectory.

Options:
-h print this help
-i use interactive mode
(if you don't know what to do, use this one)
-p percentage of resizing
-d Path to directory of the original pictures
-n new directory for resized pictures
(otherwise default "new" is used)
END
exit 42;
}

# path where pictures come from
my $path;
# path where pictures go to
my $new;
my ($bild, $image);
my $size;

my %opts = ();
getopts( "ihp:d:n:", \%opts);

if ( $opts{h} or ( ! $opts{p} ) or ( ! $opts{i} and ! $opts{d} )) {
usage();
} elsif ( $opts{i} ) {
while ( ! $path ) {
print "Where are the pictures (path)?\n";
chomp ( $path = <STDIN> );
}
print "Where should the resized pictures go (folder)?\n";
print "(Default: new)\n";
chomp ( $new = <STDIN> );
if ( ! $new ) {
$new = "new";
}
print "Enter new size in percent\n";
chomp ( $size = <STDIN> );
while ( $size !~ m/^[0-9]+$/ ) {
print "Value must be numeric and >0\n";
chomp ( $size = <STDIN> );
}
if ( $size > 1000 ) {
die ("Resize factor >1000 not allowed (mind your disk",
"space)!\n")
}
} else { #opt=d; opt=n
$path = $opts{d};
$new = $opts{n};
$new = "new" if (! $opts{n});
$size = $opts{p};
}

if ( ! $path ) {
print "You must specify a folder.\n";
exit 1;
}
if ( ! $size ) {
print "You must specify a size in percent.\n";
exit 1;
}
if ( ! -d "$new" ) {
print "$new not existing, creating it\n";
mkdir ($new, 0740) or die "Could not create $new: $!";
}
opendir( IMG, $path) or die "Could not open $path: $!";
my @picts = readdir( IMG );
@picts = sort @picts;
# remove "." and ".." listings
shift @picts;
shift @picts;

foreach( @picts ) {
$bild = $_;
$image = Image::Magick->new;

open(IMAGE, "$path/$bild");
$image ->Read(file=>\*IMAGE );

my $width = $image->Get('width');
my $height = $image->Get('height');
my $newwidth = $width*($size/100);
my $newheight = $height*($size/100);
print "$_: Width: $width, Height: $height\n";
print "$_: Resized to: $newwidth, $newheight\n";
$image ->Resize( geometry=>"$newwidth x $newheight");
my $z = $image -> Write("$new/$bild");
}
close(IMAGE);
print "Stored into $new\n";

ResizeXpercent.pl - Revision history

Sunflower at 20:24, 27 June 2021

Sunflower: Die Seite wurde neu angelegt: „ #!/usr/bin/perl -w # resizes images in a folder to be specified # you will get the imagemackick-module from: # ftp://ftp.imagemagick.org/pub/ImageMagick/Image…“