exiftool-rb/exiftool_vendored.rb

#------------------------------------------------------------------------------
# File:         LIF.pm
#
# Description:  Read LIF (Leica Image File) files
#
# Revisions:    2021-06-21 - P. Harvey Created
#------------------------------------------------------------------------------

package Image::ExifTool::LIF;

use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::XMP;

$VERSION = '1.01';

%Image::ExifTool::LIF::Main = (
    GROUPS => { 0 => 'XML', 1 => 'XML', 2 => 'Image' },
    PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
    VARS => { NO_ID => 1 },
    NOTES => q{
        Tags extracted from Leica Image Format (LIF) imaging files.  As well as the
        tags listed below, all available information is extracted from the
        XML-format metadata in the LIF header.
    },
    TimeStampList => {
        Groups => { 2 => 'Time' },
        ValueConv => q{
            my $unixTimeZero = 134774 * 24 * 3600;
            my @vals = split ' ', $val;
            foreach (@vals) {
                if (/[^0-9a-f]/i) {
                    $_ = '0000:00:00 00:00:00';
                } elsif (length $_ > 8) {
                    my $lo = hex substr($_, -8);
                    my $hi = hex substr($_, 0, -8);
                    $_ = 1e-7 * ($hi * 4294967296 + $lo);
                } else {
                    $_ = 1e-7 * hex($_);
                }
                # shift from Jan 1, 1601 to Jan 1, 1970
                $_ = Image::ExifTool::ConvertUnixTime($_ - $unixTimeZero);
            }
            return \@vals;
        },
    },
);

#------------------------------------------------------------------------------
# Shorten obscenely long LIF tag names
# Inputs: Tag name
# Returns: Shortened tag name
sub ShortenTagNames($)
{
    local $_;
    $_ = shift;
    s/DescriptionDimensionsDimensionDescription/Dimensions/;
    s/DescriptionChannelsChannelDescription/Channel/;
    s/ShutterListShutter/Shutter/;
    s/SettingDefinition/Setting/;
    s/AdditionalZPositionListAdditionalZPosition/AdditionalZPosition/;
    s/LMSDataContainerHeader//g;
    s/FilterWheelWheel/FilterWheel/;
    s/FilterWheelFilter/FilterWheel/;
    s/DetectorListDetector/Detector/;
    s/OnlineDyeSeparationOnlineDyeSeparation/OnlineDyeSeparation/;
    s/AotfListAotf/Aotf/;
    s/SettingAotfLaserLineSetting/SettingAotfLaser/;
    s/DataROISetROISet/DataROISet/;
    s/AdditionalZPosition/AddZPos/;
    s/FRAPplusBlock_FRAPBlock_FRAP_PrePost_Info/FRAP_/;
    s/FRAPplusBlock_FRAPBlock_FRAP_(Master)?/FRAP_/;
    s/LDM_Block_SequentialLDM_Block_Sequential_/LDM_/;
    s/ATLConfocalSetting/ATLConfocal/;
    s/LaserArrayLaser/Laser/;
    s/LDM_Master/LDM_/;
    s/(List)?ATLConfocal/ATL_/;
    s/Separation/Sep/;
    s/BleachPointsElement/BleachPoint/;
    s/BeamPositionBeamPosition/BeamPosition/;
    s/DataROISetPossible(ROI)?/DataROISet/;
    s/RoiElementChildrenElementDataROISingle(Roi)?/Roi/;
    s/InfoLaserLineSettingArrayLaserLineSetting/LastLineSetting/;
    s/FilterWheelWheelNameFilterName/FilterWheelFilterName/;
    s/LUT_ListLut/Lut/;
    s/ROI_ListRoiRoidata/ROI_/;
    s/LaserLineSettingArrayLaserLineSetting/LaserLineSetting/;
    return $_;
}

#------------------------------------------------------------------------------
# Extract metadata from a LIF image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid LIF file
sub ProcessLIF($$)
{
    my ($et, $dirInfo) = @_;
    my $raf = $$dirInfo{RAF};
    my $buff;

    # verify this is a valid LIF file
    return 0 unless $raf->Read($buff, 15) == 15 and $buff =~ /^\x70\0{3}.{4}\x2a.{4}<\0/s;

    $et->SetFileType();
    SetByteOrder('II');

    my $size = Get32u(\$buff, 4);       # XML chunk size
    my $len = Get32u(\$buff, 9) * 2;    # XML data length

    $size < $len and $et->Error('Corrupted LIF XML block'), return 1;
    $size > 100000000 and $et->Error('LIF XML block too large'), return 1;

    $raf->Seek(-2, 1) and $raf->Read($buff, $len) == $len or $et->Error('Truncated LIF XML block'), return 1;

    my $tagTablePtr = GetTagTable('Image::ExifTool::LIF::Main');

    # convert from UCS2 to UTF8
    my $xml = Image::ExifTool::Decode($et, $buff, 'UCS2', 'II', 'UTF8');

    my %dirInfo = ( DataPt => \$xml );

    $$et{XmpIgnoreProps} = [ 'LMSDataContainerHeader', 'Element', 'Children', 'Data', 'Image', 'Attachment' ];
    $$et{ShortenXmpTags} = \&ShortenTagNames;

    $et->ProcessDirectory(\%dirInfo, $tagTablePtr);

    return 1;
}

1;  # end

__END__

=head1 NAME

Image::ExifTool::LIF - Read LIF meta information

=head1 SYNOPSIS

This module is used by Image::ExifTool

=head1 DESCRIPTION

This module contains definitions required by Image::ExifTool to read
metadata from Leica Image File (LIF) images.

=head1 AUTHOR

Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<Image::ExifTool::TagNames/LIF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>

=cut