/usr/share/perl5/Image/Info/WBMP.pm is in libimage-info-perl 1.41-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | # -*- perl -*-
#
# Copyright (C) 2013 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
package Image::Info::WBMP;
use strict;
use vars qw($VERSION @EXPORT_OK);
$VERSION = '0.01';
require Exporter;
*import = \&Exporter::import;
@EXPORT_OK = qw(wbmp_image_info);
sub process_file {
my($info, $fh) = @_;
# wbmp files have no magic, so no signature check
$info->push_info(0, 'file_media_type' => 'image/vnd.wap.wbmp');
$info->push_info(0, 'file_ext' => 'wbmp');
# logic taken from netpbm's wbmptopbm.c and adapted to perl
my $readint = sub {
my $sum = 0;
my $pos = 0;
my $c;
do {
$c = ord(getc $fh);
$sum = ($sum << 7*$pos++) | ($c & 0x7f);
} while($c & 0x80);
return $sum;
};
my $readheader = sub {
my $h = shift;
if ($h & 0x60 == 0) {
# type 00: read multi-byte bitfield
my $c;
do { $c = ord(getc $fh) } while($c & 0x80);
} elsif ($h & 0x60 == 0x60) {
# type 11: read name/value pair
for(my $i=0; $i < (($h & 0x70) >> 4) + ($h & 0x0f); $i++) { getc $fh }
}
};
my $c;
$c = $readint->();
$c == 0
or die "Unrecognized WBMP type (got $c)";
$c = ord(getc $fh); # FixHeaderField
while($c & 0x80) { # ExtheaderFields
$c = ord(getc $fh);
$readheader->($c);
}
my $w = $readint->();
my $h = $readint->();
$info->push_info(0, 'width', $w);
$info->push_info(0, 'height', $h);
}
sub wbmp_image_info {
my $source = Image::Info::_source(shift);
return $source if ref $source eq 'HASH'; # Pass on errors
return Image::Info::_image_info_for_format('WBMP', $source);
}
1;
__END__
=head1 NAME
Image::Info::WBMP - WBMP support for Image::Info
=head1 SYNOPSIS
use Image::Info qw(dim);
use Image::Info::WBMP qw(wbmp_image_info);
my $info = wbmp_image_info("image.xpm");
if (my $error = $info->{error}) {
die "Can't parse image info: $error\n";
}
my($w, $h) = dim($info);
=head1 DESCRIPTION
wbmp is a magic-less file format, so using L<Image::Info>'s
C<image_info> or C<image_type> does not work here. Instead, the user
has to determine the file type himself, e.g. by relying on the file
suffix or mime type, and use the C<wbmp_image_info> function instead.
The returned value looks the same like L<Image::Info>'s C<image_info>
and may be used in a call to the C<dim> function.
=head1 AUTHOR
Slaven Rezic <srezic@cpan.org>
=begin register
NO MAGIC: true
wbmp files have no magic, so cannot be used with the normal
Image::Info functions. See L<Image::Info::WBMP> for more information.
=end register
=cut
|