File Coverage

blib/lib/Image/JpegCheck.pm

Criterion	Covered	Total	%
statement	52	55	94.5
branch	14	18	77.7
condition	4	6	66.6
subroutine	10	10	100.0
pod	1	1	100.0
total	81	90	90.0

package Image::JpegCheck;
use strict;
use warnings;
use 5.008001;
use bytes;
use Fcntl ':seek';
use Carp ();
our $VERSION = '0.10';
our @ISA = qw/Exporter/;
our @EXPORT = ('is_jpeg');

sub is_jpeg {
    my ($file, ) = @_;
    if (ref $file) {
        if (ref $file eq 'GLOB') {
            return Image::JpegCheck::_is_jpeg($file);
        } elsif (ref $file eq 'SCALAR') {
            open my $fh, '<', $file or die $!;
            return Image::JpegCheck::_is_jpeg($fh);
        } elsif (ref $file eq 'Path::Class::File') {
            return Image::JpegCheck::_is_jpeg($file->openr);
        } else {
            Carp::croak('is_jpeg requires file-glob or filename');
        }
    } else {
        open my $fh, '<', $file or die $!;
        binmode $fh;
        my $ret = Image::JpegCheck::_is_jpeg($fh);
        close $fh;
        return $ret;
    }
}

use constant {
    SIZE_FIRST     => 0xC0,         # Range of segment identifier codes
    SIZE_LAST      => 0xC3,         #  that hold size info.
    SECTION_MARKER => "\xFF",
    SOI            => "\xFF\xD8",
    EOI            => "\xFF\xD9",
    EOI_RE         => qr/\xFF\xD9\xFF*$/,
    READ_SIZE      => 512,
    BYTE_STUFFING  => "\xFF"x512,
};

sub _is_jpeg {
    my $fh = $_[0];
    my ($buf, $code, $marker, $len);

    read($fh, $buf, 2);
    return 0 if $buf ne SOI;

    while (1) {
        read($fh, $buf, 2);
        ($marker, $code) = unpack("a a", $buf); # read segment header

        while ( $code eq SECTION_MARKER && ($marker = $code) ) {
            read($fh, $buf, 1);
           ($code) = unpack("a", $buf);
       }
       read($fh, $buf, 2);
       $len = unpack( "n", $buf );
        $code = ord($code);

        if ($marker ne SECTION_MARKER) {
            return 0; # invalid marker
        } elsif (($code >= SIZE_FIRST) && ($code <= SIZE_LAST)) {
            return 1; # got a size info
        } else {
            seek $fh, $len-2, SEEK_CUR; # skip segment body
        }
    }
    die "should not reach here";
}

1;
__END__