- Timestamp:
- 2021-02-26T19:39:51+13:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/cpan/Image/ExifTool/JPEGDigest.pm
r24107 r34921 2 2 # File: JPEGDigest.pm 3 3 # 4 # Description: Lookup for JPEGDigest values4 # Description: Calculate JPEGDigest and JPEGQualityEstimate 5 5 # 6 6 # Revisions: 2008/09/15 - P. Harvey Created 7 # 2016/01/05 - PH Added calculation of JPEGQualityEstimate 7 8 # 8 9 # References: JD) Jens Duttke 9 10 # 2) Franz Buchinger private communication 11 # 3) https://github.com/ImageMagick/ImageMagick/blob/master/coders/jpeg.c 10 12 #------------------------------------------------------------------------------ 11 13 … … 14 16 use vars qw($VERSION); 15 17 16 $VERSION = '1.0 2';18 $VERSION = '1.06'; 17 19 18 20 # the print conversion for the JPEGDigest tag … … 282 284 '4c3c425b4024b68c0de03904a825bc35:111111' => 'Adobe Lightroom, Quality 93% - 100%', 283 285 284 # Tested with Adobe Photoshop CS2 Version 9.0.2 (Win) - "Save as..." (RGB/C YMK)286 # Tested with Adobe Photoshop CS2 Version 9.0.2 (Win) - "Save as..." (RGB/CMYK) 285 287 '683506a889c78d9bc230a0c7ee5f62f3:221111' => 'Adobe Photoshop, Quality 0', 286 288 'bc490651af6592cd1dbbbc4fa2cfa1fb:221111' => 'Adobe Photoshop, Quality 1', … … 2443 2445 2444 2446 #------------------------------------------------------------------------------ 2445 # Calculate JPEGDigest 2447 # Estimate JPEG quality from quantization tables (ref 3) 2448 # Inputs: 0) 1) DQT segments array ref 2449 # Returns: JPEG quality, or undefined if it can't be calculated 2450 sub EstimateQuality($) 2451 { 2452 local $_; 2453 my $dqtList = shift; 2454 my ($i, $dqt, @qtbl, $quality, @hash, @sums); 2455 2456 # unpack DQT segments and sum quantization tables 2457 my $sum=0; 2458 DQT: foreach $dqt (@$dqtList) { 2459 next unless defined $dqt; 2460 for ($i=1; $i+64<=length($dqt); $i+=65) { 2461 my @qt = unpack("x$i C64", $dqt); 2462 $sum += $_ foreach @qt; 2463 push @qtbl, \@qt; 2464 last DQT if @qtbl >= 4; 2465 } 2466 } 2467 return undef unless @qtbl; 2468 2469 my $qval = $qtbl[0][2] + $qtbl[0][53]; 2470 if (@qtbl > 1) { 2471 # color JPEG 2472 $qval += $qtbl[1][0] + $qtbl[1][63]; 2473 @hash =( 2474 1020, 1015, 932, 848, 780, 735, 702, 679, 660, 645, 2475 632, 623, 613, 607, 600, 594, 589, 585, 581, 571, 2476 555, 542, 529, 514, 494, 474, 457, 439, 424, 410, 2477 397, 386, 373, 364, 351, 341, 334, 324, 317, 309, 2478 299, 294, 287, 279, 274, 267, 262, 257, 251, 247, 2479 243, 237, 232, 227, 222, 217, 213, 207, 202, 198, 2480 192, 188, 183, 177, 173, 168, 163, 157, 153, 148, 2481 143, 139, 132, 128, 125, 119, 115, 108, 104, 99, 2482 94, 90, 84, 79, 74, 70, 64, 59, 55, 49, 2483 45, 40, 34, 30, 25, 20, 15, 11, 6, 4 2484 ); 2485 @sums = ( 2486 32640, 32635, 32266, 31495, 30665, 29804, 29146, 28599, 28104, 27670, 2487 27225, 26725, 26210, 25716, 25240, 24789, 24373, 23946, 23572, 22846, 2488 21801, 20842, 19949, 19121, 18386, 17651, 16998, 16349, 15800, 15247, 2489 14783, 14321, 13859, 13535, 13081, 12702, 12423, 12056, 11779, 11513, 2490 11135, 10955, 10676, 10392, 10208, 9928, 9747, 9564, 9369, 9193, 2491 9017, 8822, 8639, 8458, 8270, 8084, 7896, 7710, 7527, 7347, 2492 7156, 6977, 6788, 6607, 6422, 6236, 6054, 5867, 5684, 5495, 2493 5305, 5128, 4945, 4751, 4638, 4442, 4248, 4065, 3888, 3698, 2494 3509, 3326, 3139, 2957, 2775, 2586, 2405, 2216, 2037, 1846, 2495 1666, 1483, 1297, 1109, 927, 735, 554, 375, 201, 128 2496 ); 2497 } else { 2498 # greyscale JPEG 2499 @hash = ( 2500 510, 505, 422, 380, 355, 338, 326, 318, 311, 305, 2501 300, 297, 293, 291, 288, 286, 284, 283, 281, 280, 2502 279, 278, 277, 273, 262, 251, 243, 233, 225, 218, 2503 211, 205, 198, 193, 186, 181, 177, 172, 168, 164, 2504 158, 156, 152, 148, 145, 142, 139, 136, 133, 131, 2505 129, 126, 123, 120, 118, 115, 113, 110, 107, 105, 2506 102, 100, 97, 94, 92, 89, 87, 83, 81, 79, 2507 76, 74, 70, 68, 66, 63, 61, 57, 55, 52, 2508 50, 48, 44, 42, 39, 37, 34, 31, 29, 26, 2509 24, 21, 18, 16, 13, 11, 8, 6, 3, 2 2510 ); 2511 @sums = ( 2512 16320, 16315, 15946, 15277, 14655, 14073, 13623, 13230, 12859, 12560, 2513 12240, 11861, 11456, 11081, 10714, 10360, 10027, 9679, 9368, 9056, 2514 8680, 8331, 7995, 7668, 7376, 7084, 6823, 6562, 6345, 6125, 2515 5939, 5756, 5571, 5421, 5240, 5086, 4976, 4829, 4719, 4616, 2516 4463, 4393, 4280, 4166, 4092, 3980, 3909, 3835, 3755, 3688, 2517 3621, 3541, 3467, 3396, 3323, 3247, 3170, 3096, 3021, 2952, 2518 2874, 2804, 2727, 2657, 2583, 2509, 2437, 2362, 2290, 2211, 2519 2136, 2068, 1996, 1915, 1858, 1773, 1692, 1620, 1552, 1477, 2520 1398, 1326, 1251, 1179, 1109, 1031, 961, 884, 814, 736, 2521 667, 592, 518, 441, 369, 292, 221, 151, 86, 64 2522 ); 2523 } 2524 for ($i=0; $i<100; ++$i) { 2525 next if $qval < $hash[$i] and $sum < $sums[$i]; 2526 $quality = $i + 1 if ($qval <= $hash[$i] and $sum <= $sums[$i]) or $i >= 50; 2527 last; 2528 } 2529 return $quality; 2530 } 2531 2532 #------------------------------------------------------------------------------ 2533 # Calculate JPEGDigest and/or JPEGQualityEstimate 2446 2534 # Inputs: 0) ExifTool object ref, 1) DQT segments array ref, 2) subsampling string 2447 2535 sub Calculate($$$) 2448 2536 { 2449 my ($exifTool, $dqtList, $subSampling) = @_; 2450 2451 unless (eval 'require Digest::MD5') { 2452 $exifTool->Warn('Digest::MD5 must be installed to calculate JPEGDigest'); 2537 my ($et, $dqtList, $subSampling) = @_; 2538 2539 # estimate JPEG quality if requested 2540 my $all = ($$et{OPTIONS}{RequestAll} and $$et{OPTIONS}{RequestAll} > 2); 2541 if ($all or $$et{REQ_TAG_LOOKUP}{jpegqualityestimate}) { 2542 my $quality = EstimateQuality($dqtList); 2543 $quality = '<unknown>' unless defined $quality; 2544 $et->FoundTag('JPEGQualityEstimate', $quality); 2545 } 2546 return unless ($all or $$et{REQ_TAG_LOOKUP}{jpegdigest}) and $subSampling; 2547 2548 unless (eval { require Digest::MD5 }) { 2549 $et->Warn('Digest::MD5 must be installed to calculate JPEGDigest'); 2453 2550 return; 2454 2551 } … … 2470 2567 # bulk up the documentation and slow down loading unnecessarily 2471 2568 $Image::ExifTool::Extra{JPEGDigest}{PrintConv} = \%PrintConv; 2472 $e xifTool->FoundTag('JPEGDigest', $md5);2569 $et->FoundTag('JPEGDigest', $md5); 2473 2570 } 2474 2571 … … 2480 2577 =head1 NAME 2481 2578 2482 Image::ExifTool::JPEGDigest - Lookup for JPEGDigest values2579 Image::ExifTool::JPEGDigest - Calculate JPEGDigest and JPEGQualityEstimate 2483 2580 2484 2581 =head1 SYNOPSIS … … 2489 2586 2490 2587 This module contains a lookup for values of the JPEG DQT digest, allowing 2491 some image identification from JPEG data alone. 2588 some image identification from JPEG data alone. It also calculates an 2589 estimated JPEG quality if requested. 2492 2590 2493 2591 =head1 AUTHOR 2494 2592 2495 Copyright 2003-20 11, Phil Harvey (phil at owl.phy.queensu.ca)2593 Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com) 2496 2594 2497 2595 This library is free software; you can redistribute it and/or modify it 2498 2596 under the same terms as Perl itself. 2499 2597 2598 =head1 REFERENCES 2599 2600 =over 4 2601 2602 =item L<https://github.com/ImageMagick/ImageMagick/blob/master/coders/jpeg.c> 2603 2604 =back 2605 2500 2606 =head1 ACKNOWLEDGEMENTS 2501 2607
Note:
See TracChangeset
for help on using the changeset viewer.