lib/Image/Info.pm

   1
   2 #############################################################################
   3 #
   4 # ATTENTION! This file is autogenerated from dev/Info.pm.tmpl - DO NOT EDIT!
   5 #
   6 #############################################################################
   7
   8 package Image::Info;
   9
  10 # Copyright 1999-2004, Gisle Aas.
  11 #
  12 # This library is free software; you can redistribute it and/or
  13 # modify it under the same terms as Perl v5.8.8 itself.
  14 #
  15 # Now maintained by Tels - (c) 2006 - 2008.
  16
  17 use strict;
  18 use vars qw($VERSION @EXPORT_OK);
  19
  20 $VERSION = '1.28';
  21
  22 require Exporter;
  23 *import = \&Exporter::import;
  24
  25 @EXPORT_OK = qw(image_info dim html_dim image_type determine_file_format);
  26
  27 # already required and failed sub-modules are remembered here
  28 my %mod_failure;
  29
  30 sub image_info
  31 {
  32     my $source = _source(shift);
  33     return $source if ref $source eq 'HASH'; # Pass on errors
  34
  35     # What sort of file is it?
  36     my $head = _head($source);
  37
  38     return $head if ref($head) eq 'HASH';       # error?
  39
  40     my $format = determine_file_format($head)
  41         or return { error => 'Unrecognized file format' };
  42
  43     no strict 'refs';
  44     my $mod = "Image::Info::$format";
  45     my $sub = "$mod\::process_file";
  46     my $info = bless [], "Image::Info::Result";
  47     eval {
  48         unless (defined &$sub) {
  49             # already required and failed?
  50             if (my $fail = $mod_failure{$mod}) {
  51                 die $fail;
  52             }
  53             eval "require $mod";
  54             if ($@) {
  55                 $mod_failure{$mod} = $@;
  56                 die $@;
  57             }
  58             die "$mod did not define &$sub" unless defined &$sub;
  59         }
  60
  61         my %cnf = @_;
  62         # call process_file()
  63         &$sub($info, $source, \%cnf);
  64         $info->clean_up;
  65     };
  66     return { error => $@ } if $@;
  67     return wantarray ? @$info : $info->[0];
  68 }
  69
  70 sub image_type
  71 {
  72     my $source = _source(shift);
  73     return $source if ref $source eq 'HASH'; # Pass on errors
  74
  75     # What sort of file is it?
  76     my $head = _head($source) or return _os_err("Can't read head");
  77     my $format = determine_file_format($head)
  78         or return { error => "Unrecognized file format" };
  79
  80     return { file_type => $format };
  81 }
  82
  83 sub _source
  84 {
  85     my $source = shift;
  86     if (!ref $source) {
  87         require Symbol;
  88         my $fh = Symbol::gensym();
  89         open($fh, $source) || return _os_err("Can't open $source");
  90         ${*$fh} = $source;  # keep filename in case somebody wants to know
  91         binmode($fh);
  92         $source = $fh;
  93     }
  94     elsif (ref($source) eq "SCALAR") {
  95         if ($] >= 5.008) {
  96             open(my $s, "<", $source) or return _os_err("Can't open string");
  97             $source = $s;
  98         }
  99         else {
 100             require IO::String;
 101             $source = IO::String->new($$source);
 102         }
 103     }
 104     else {
 105         seek($source, 0, 0) or return _os_err("Can't rewind");
 106     }
 107
 108     $source;
 109 }
 110
 111 sub _head
 112 {
 113     my $source = shift;
 114     my $head;
 115
 116     # tiny.pgm is 11 bytes
 117     my $to_read = 11;
 118     my $read = read($source, $head, $to_read);
 119
 120     return _os_err("Couldn't read $to_read bytes") if $read != $to_read;
 121
 122     if (ref($source) eq "IO::String") {
 123         # XXX workaround until we can trap seek() with a tied file handle
 124         $source->setpos(0);
 125     }
 126     else {
 127         seek($source, 0, 0) or return _os_err("Can't rewind");
 128     }
 129     $head;
 130 }
 131
 132 sub _os_err
 133 {
 134     return { error => "$_[0]: $!",
 135              Errno => $!+0,
 136            };
 137 }
 138
 139 sub determine_file_format
 140 {
 141    local($_) = @_;
 142    return "BMP" if /^BM/;
 143    return "GIF" if /^GIF8[79]a/;
 144    return "JPEG" if /^\xFF\xD8/;
 145    return "PNG" if /^\x89PNG\x0d\x0a\x1a\x0a/;
 146    return "PPM" if /^P[1-6]/;;
 147    return "SVG" if /^<\?xml/;
 148    return "TIFF" if /^MM\x00\x2a/;
 149    return "TIFF" if /^II\x2a\x00/;
 150    return "XBM" if /^#define\s+/;
 151    return "XPM" if /(^\/\* XPM \*\/)|(static\s+char\s+\*\w+\[\]\s*=\s*{\s*"\d+)/;
 152    return undef;
 153 }
 154
 155 sub dim
 156 {
 157     my $img = shift || return;
 158     my $x = $img->{width} || return;
 159     my $y = $img->{height} || return;
 160     wantarray ? ($x, $y) : "${x}x$y";
 161 }
 162
 163 sub html_dim
 164 {
 165     my($x, $y) = dim(@_);
 166     return "" unless $x;
 167     "width=\"$x\" height=\"$y\"";
 168 }
 169
 170 #############################################################################
 171 package Image::Info::Result;
 172
 173 sub push_info
 174 {
 175     my($self, $n, $key) = splice(@_, 0, 3);
 176     push(@{$self->[$n]{$key}}, @_);
 177 }
 178
 179 sub replace_info
 180 {
 181     my($self, $n, $key) = splice(@_, 0, 3);
 182     $self->[$n]{$key}[0] = $_[0];
 183 }
 184
 185 sub clean_up
 186 {
 187     my $self = shift;
 188     for (@$self) {
 189         for my $k (keys %$_) {
 190             my $a = $_->{$k};
 191             $_->{$k} = $a->[0] if @$a <= 1;
 192         }
 193     }
 194 }
 195
 196 sub get_info {
 197     my($self, $n, $key, $delete) = @_;
 198     my $v = $delete ? delete $self->[$n]{$key} : $self->[$n]{$key};
 199     $v ||= [];
 200     @$v;
 201 }
 202
 203 1;
 204
 205 __END__
 206
 207 =head1 NAME
 208
 209 Image::Info - Extract meta information from image files (DEPRECATED)
 210
 211 =head1 SYNOPSIS
 212
 213  use Image::Info qw(image_info dim);
 214
 215  my $info = image_info("image.jpg");
 216  if (my $error = $info->{error}) {
 217      die "Can't parse image info: $error\n";
 218  }
 219  my $color = $info->{color_type};
 220
 221  my $type = image_type("image.jpg");
 222  if (my $error = $type->{error}) {
 223      die "Can't determine file type: $error\n";
 224  }
 225  die "No gif files allowed!" if $type->{file_type} eq 'GIF';
 226
 227  my($w, $h) = dim($info);
 228
 229 =head1 DESCRIPTION
 230
 231 Please note that this module is B<deprecated> and should not be used.
 232 Alternatively, try one of the following modules:
 233
 234 L<Image::Size>, L<Image::ExifTool>.
 235
 236 The code in this module is old, unreviewed, hackish, still has
 237 numerous bugs and is incomplete in quite a few cases.
 238
 239 While this module is sort-of maintained (e.g. the most critical
 240 security-related bugs are fixed), no new features will be added
 241 and numerous minor bugs are very likely sprinkled through the entire
 242 code base. You have been warned.
 243
 244 This module provide functions to extract various kind of meta
 245 information from image files.
 246
 247 =head2 EXPORTS
 248
 249 Exports nothing by default, but can export the following methods
 250 on request:
 251
 252         image_info
 253         image_type
 254         dim
 255         html_dim
 256         determine_file_type
 257
 258 =head2 METHODS
 259
 260 The following functions are provided by the C<Image::Info> module:
 261
 262 =over
 263
 264 =item image_info( $file )
 265
 266 =item image_info( \$imgdata )
 267
 268 =item image_info( $file, key => value,... )
 269
 270 This function takes the name of a file or a file handle as argument
 271 and will return one or more hashes (actually hash references)
 272 describing the images inside the file.  If there is only one image in
 273 the file only one hash is returned.  In scalar context, only the hash
 274 for the first image is returned.
 275
 276 In case of error, and hash containing the "error" key will be
 277 returned.  The corresponding value will be an appropriate error
 278 message.
 279
 280 If a reference to a scalar is passed as argument to this function,
 281 then it is assumed that this scalar contains the raw image data
 282 directly.
 283
 284 The image_info() function also take optional key/value style arguments
 285 that can influence what information is returned.
 286
 287 =item image_type( \$imgdata )
 288
 289 Returns a hash with only one key, C<< file_type >>. The value
 290 will be the type of the file. On error, sets the two keys
 291 C<< error >> and C<< Errno >>.
 292
 293 This function is a dramatically faster alternative to the image_info
 294 function for situations in which you B<only> need to find the image type.
 295
 296 It uses only the internal file-type detection to do this, and thus does
 297 not need to load any of the image type-specific driver modules, and does
 298 not access to entire file. It also only needs access to the first 11
 299 bytes of the file.
 300
 301 To maintain some level of compatibility with image_info, image_type
 302 returns in the same format, with the same error message style. That is,
 303 it returns a HASH reference, with the C<< $type->{error} >> key set if
 304 there was an error.
 305
 306 On success, the HASH reference will contain the single key 'file_type',
 307 which represents the type of the file, expressed as the type code used for
 308 the various drivers ('GIF', 'JPEG', 'TIFF' and so on).
 309
 310 If there are multiple images within the file they will be ignored, as this
 311 function provides only the type of the overall file, not of the various
 312 images within it. This function will not return multiple hashes if the file
 313 contains multiple images.
 314
 315 Of course, in all (or at least effectively all) cases the type of the images
 316 inside the file is going to be the same as that of the file itself.
 317
 318 =item dim( $info_hash )
 319
 320 Takes an hash as returned from image_info() and returns the dimensions
 321 ($width, $height) of the image.  In scalar context returns the
 322 dimensions as a string.
 323
 324 =item html_dim( $info_hash )
 325
 326 Returns the dimensions as a string suitable for embedding directly
 327 into HTML or SVG <img>-tags. E.g.:
 328
 329    print "<img src="..." @{[html_dim($info)]}>\n";
 330
 331 =item determine_file_format( $filedata )
 332
 333 Determines the file format from the passed file data (a normal Perl
 334 scalar containing the first bytes of the file), and returns
 335 either undef for an unknown file format, or a string describing
 336 the format, like "BMP" or "JPEG".
 337
 338 =back
 339
 340 =head1 Image descriptions
 341
 342 The image_info() function returns meta information about each image in
 343 the form of a reference to a hash.  The hash keys used are in most
 344 cases based on the TIFF element names.  All lower case keys are
 345 mandatory for all file formats and will always be there unless an
 346 error occured (in which case the "error" key will be present.)  Mixed
 347 case keys will only be present when the corresponding information
 348 element is available in the image.
 349
 350 The following key names are common for any image format:
 351
 352 =over
 353
 354 =item file_media_type
 355
 356 This is the MIME type that is appropriate for the given file format.
 357 The corresponding value is a string like: "image/png" or "image/jpeg".
 358
 359 =item file_ext
 360
 361 The is the suggested file name extention for a file of the given file
 362 format.  The value is a 3 letter, lowercase string like "png", "jpg".
 363
 364 =item width
 365
 366 This is the number of pixels horizontally in the image.
 367
 368 =item height
 369
 370 This is the number of pixels vertically in the image.  (TIFF use the
 371 name ImageLength for this field.)
 372
 373 =item color_type
 374
 375 The value is a short string describing what kind of values the pixels
 376 encode.  The value can be one of the following:
 377
 378   Gray
 379   GrayA
 380   RGB
 381   RGBA
 382   CMYK
 383   YCbCr
 384   CIELab
 385
 386 These names can also be prefixed by "Indexed-" if the image is
 387 composed of indexes into a palette.  Of these, only "Indexed-RGB" is
 388 likely to occur.
 389
 390 It is similar to the TIFF field PhotometricInterpretation, but this
 391 name was found to be too long, so we used the PNG inpired term
 392 instead.
 393
 394 =item resolution
 395
 396 The value of this field normally gives the physical size of the image
 397 on screen or paper. When the unit specifier is missing then this field
 398 denotes the squareness of pixels in the image.
 399
 400 The syntax of this field is:
 401
 402    <res> <unit>
 403    <xres> "/" <yres> <unit>
 404    <xres> "/" <yres>
 405
 406 The <res>, <xres> and <yres> fields are numbers.  The <unit> is a
 407 string like C<dpi>, C<dpm> or C<dpcm> (denoting "dots per
 408 inch/cm/meter).
 409
 410 =item SamplesPerPixel
 411
 412 This says how many channels there are in the image.  For some image
 413 formats this number might be higher than the number implied from the
 414 C<color_type>.
 415
 416 =item BitsPerSample
 417
 418 This says how many bits are used to encode each of samples.  The value
 419 is a reference to an array containing numbers. The number of elements
 420 in the array should be the same as C<SamplesPerPixel>.
 421
 422 =item Comment
 423
 424 Textual comments found in the file.  The value is a reference to an
 425 array if there are multiple comments found.
 426
 427 =item Interlace
 428
 429 If the image is interlaced, then this tell which interlace method is
 430 used.
 431
 432 =item Compression
 433
 434 This tells you which compression algorithm is used.
 435
 436 =item Gamma
 437
 438 A number.
 439
 440 =item LastModificationTime
 441
 442 A ISO date string
 443
 444 =back
 445
 446 =head1 Supported Image Formats
 447
 448 The following image file formats are supported:
 449
 450 =over
 451
 452
 453 =item BMP
 454
 455 This module supports the Microsoft Device Independent Bitmap format
 456 (BMP, DIB, RLE).
 457
 458 For more information see L<Image::Info::BMP>.
 459
 460 =item GIF
 461
 462 Both GIF87a and GIF89a are supported and the version number is found
 463 as C<GIF_Version> for the first image.  GIF files can contain multiple
 464 images, and information for all images will be returned if
 465 image_info() is called in list context.  The Netscape-2.0 extention to
 466 loop animation sequences is represented by the C<GIF_Loop> key for the
 467 first image.  The value is either "forever" or a number indicating
 468 loop count.
 469
 470 =item JPEG
 471
 472 For JPEG files we extract information both from C<JFIF> and C<Exif>
 473 application chunks.
 474
 475 C<Exif> is the file format written by most digital cameras.  This
 476 encode things like timestamp, camera model, focal length, exposure
 477 time, aperture, flash usage, GPS position, etc.  The following web
 478 page contain description of the fields that can be present:
 479
 480  http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html
 481
 482 The C<Exif> spec can be found at:
 483
 484  http://www.exif.org/specifications.html
 485
 486 =item PNG
 487
 488 Information from IHDR, PLTE, gAMA, pHYs, tEXt, tIME chunks are
 489 extracted.  The sequence of chunks are also given by the C<PNG_Chunks>
 490 key.
 491
 492 =item PBM/PGM/PPM
 493
 494 All information available is extracted.
 495
 496 =item SVG
 497
 498 Provides a plethora of attributes and metadata of an SVG vector grafic.
 499
 500 =item TIFF
 501
 502 The C<TIFF> spec can be found at:
 503 L<http://partners.adobe.com/public/developer/tiff/>
 504
 505 The EXIF spec can be found at:
 506 L<http://www.exif.org/>
 507
 508 =item XBM
 509
 510 See L<Image::Info::XBM> for details.
 511
 512 =item XPM
 513
 514 See L<Image::Info::XPM> for details.
 515
 516 =back
 517
 518 =head1 CAVEATS
 519
 520 Note that while the module is still maintained, no new features
 521 will be added and numerous bugs remain throughout the code base.
 522
 523 Especially the EXIF parsing code is buggy, not tested at all,
 524 and quite incomplete (a lot of manufacturer's MakerNotes and tags are
 525 not parsed at all). If you want a stable, feature-complete, up-to-date
 526 and tested EXIF parsing library, please use L<Image::ExifTool>.
 527
 528 Likewise, the image parsing code is quite hackish and seems to contain
 529 an endless supply of bugs that crash, or hang with malformed input.
 530
 531 =head1 SEE ALSO
 532
 533 L<Image::Size>, L<Image::ExifTool>
 534
 535 =head1 AUTHORS
 536
 537 Copyright 1999-2004 Gisle Aas.
 538
 539 See the CREDITS file for a list of contributors and authors.
 540
 541 Now maintained by Tels - (c) 2006 - 2008.
 542
 543 =head1 LICENSE
 544
 545 This library is free software; you can redistribute it and/or
 546 modify it under the same terms as Perl v5.8.8 itself.
 547
 548 =cut