Index: openacs-4/packages/acs-content-repository/tcl/image-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/image-procs.tcl,v diff -u -N -r1.13 -r1.14 --- openacs-4/packages/acs-content-repository/tcl/image-procs.tcl 1 Oct 2017 12:16:04 -0000 1.13 +++ openacs-4/packages/acs-content-repository/tcl/image-procs.tcl 14 Sep 2018 10:24:08 -0000 1.14 @@ -12,7 +12,7 @@ @cvs-id $Id$ } -namespace eval image:: {} +namespace eval image {} ad_proc -public image::new { {-name ""} @@ -158,6 +158,39 @@ return $size } +ad_proc -public image::get_info { + {-filename:required} + {-array:required} +} { + Get the width and height of an image file. + The width and height are returned as 'height' and 'width' entries in the array named in the parameter. + Uses ImageMagick instead of AOLserver function because it can handle more than + just gifs and jpegs. The plan is to add the ability to get more details later. + + This proc duplicates and seems somehow superseded by + image::imagemagick_identify, it might be a good idea to deprecate + it in the future. One important difference is this proc won't fail + in case of error. + + @param filename Name of the image file in the file system. + @param array Name of an array where you want the information returned. + + @see image::imagemagick_identify +} { + upvar 1 $array row + array set row { + height {} + width {} + } + + catch { + set identify_string [exec identify $filename] + regexp {[ ]+([0-9]+)[x]([0-9]+)[\+]*} $identify_string x width height + set row(width) $width + set row(height) $height + } +} + ad_proc -public image::imagemagick_identify { -filename } {