Ignore:
Timestamp:
2021-02-26T19:39:51+13:00 (3 years ago)
Author:
anupama
Message:

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • main/trunk/greenstone2/perllib/cpan/Image/ExifTool/JPEGDigest.pm

    r24107 r34921  
    22# File:         JPEGDigest.pm
    33#
    4 # Description:  Lookup for JPEGDigest values
     4# Description:  Calculate JPEGDigest and JPEGQualityEstimate
    55#
    66# Revisions:    2008/09/15 - P. Harvey Created
     7#               2016/01/05 - PH Added calculation of JPEGQualityEstimate
    78#
    89# References:   JD) Jens Duttke
    910#               2) Franz Buchinger private communication
     11#               3) https://github.com/ImageMagick/ImageMagick/blob/master/coders/jpeg.c
    1012#------------------------------------------------------------------------------
    1113
     
    1416use vars qw($VERSION);
    1517
    16 $VERSION = '1.02';
     18$VERSION = '1.06';
    1719
    1820# the print conversion for the JPEGDigest tag
     
    282284    '4c3c425b4024b68c0de03904a825bc35:111111' => 'Adobe Lightroom, Quality 93% - 100%',
    283285
    284     # Tested with Adobe Photoshop CS2 Version 9.0.2 (Win) - "Save as..." (RGB/CYMK)
     286    # Tested with Adobe Photoshop CS2 Version 9.0.2 (Win) - "Save as..." (RGB/CMYK)
    285287    '683506a889c78d9bc230a0c7ee5f62f3:221111' => 'Adobe Photoshop, Quality 0',
    286288    'bc490651af6592cd1dbbbc4fa2cfa1fb:221111' => 'Adobe Photoshop, Quality 1',
     
    24432445
    24442446#------------------------------------------------------------------------------
    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
     2450sub 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;
     2458DQT: 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
    24462534# Inputs: 0) ExifTool object ref, 1) DQT segments array ref, 2) subsampling string
    24472535sub Calculate($$$)
    24482536{
    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');
    24532550        return;
    24542551    }
     
    24702567    # bulk up the documentation and slow down loading unnecessarily
    24712568    $Image::ExifTool::Extra{JPEGDigest}{PrintConv} = \%PrintConv;
    2472     $exifTool->FoundTag('JPEGDigest', $md5);
     2569    $et->FoundTag('JPEGDigest', $md5);
    24732570}
    24742571
     
    24802577=head1 NAME
    24812578
    2482 Image::ExifTool::JPEGDigest - Lookup for JPEGDigest values
     2579Image::ExifTool::JPEGDigest - Calculate JPEGDigest and JPEGQualityEstimate
    24832580
    24842581=head1 SYNOPSIS
     
    24892586
    24902587This module contains a lookup for values of the JPEG DQT digest, allowing
    2491 some image identification from JPEG data alone.
     2588some image identification from JPEG data alone.  It also calculates an
     2589estimated JPEG quality if requested.
    24922590
    24932591=head1 AUTHOR
    24942592
    2495 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     2593Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    24962594
    24972595This library is free software; you can redistribute it and/or modify it
    24982596under the same terms as Perl itself.
    24992597
     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
    25002606=head1 ACKNOWLEDGEMENTS
    25012607
Note: See TracChangeset for help on using the changeset viewer.