This commit is contained in:
2018-08-08 23:12:47 -07:00
parent cbf6506290
commit ff19eeab6c
232 changed files with 319180 additions and 1246 deletions

717
MainMenu.nib/designable.nib generated Normal file
View File

@@ -0,0 +1,717 @@
<?xml version="1.0" encoding="UTF-8"?>
<document type="com.apple.InterfaceBuilder3.Cocoa.XIB" version="3.0" toolsVersion="14113" targetRuntime="MacOSX.Cocoa" propertyAccessControl="none">
<dependencies>
<plugIn identifier="com.apple.InterfaceBuilder.CocoaPlugin" version="14113"/>
<plugIn identifier="com.apple.WebKitIBPlugin" version="14113"/>
<capability name="box content view" minToolsVersion="7.0"/>
<capability name="documents saved in the Xcode 8 format" minToolsVersion="8.0"/>
</dependencies>
<objects>
<customObject id="-2" userLabel="File's Owner" customClass="NSApplication">
<connections>
<outlet property="delegate" destination="207" id="210"/>
</connections>
</customObject>
<customObject id="-1" userLabel="First Responder" customClass="FirstResponder"/>
<customObject id="-3" userLabel="Application" customClass="NSObject">
<connections>
<outlet property="delegate" destination="207" id="446"/>
</connections>
</customObject>
<customObject id="207" userLabel="ScriptExecController" customClass="ScriptExecController">
<connections>
<outlet property="aboutMenuItem" destination="232" id="238"/>
<outlet property="dropletBox" destination="494" id="502"/>
<outlet property="dropletDropFilesLabel" destination="499" id="507"/>
<outlet property="dropletMessageTextField" destination="505" id="508"/>
<outlet property="dropletProgressIndicator" destination="496" id="504"/>
<outlet property="dropletShaderView" destination="519" id="w2q-dA-smc"/>
<outlet property="dropletWindow" destination="490" id="512"/>
<outlet property="hideMenuItem" destination="134" id="239"/>
<outlet property="openRecentMenuItem" destination="FvD-xH-BRz" id="V8D-h2-Uw1"/>
<outlet property="progressBarCancelButton" destination="206" id="299"/>
<outlet property="progressBarDetailsLabel" destination="290" id="300"/>
<outlet property="progressBarDetailsTriangle" destination="288" id="301"/>
<outlet property="progressBarIndicator" destination="204" id="298"/>
<outlet property="progressBarMessageTextField" destination="205" id="297"/>
<outlet property="progressBarTextView" destination="307" id="516"/>
<outlet property="progressBarWindow" destination="21" id="296"/>
<outlet property="quitMenuItem" destination="136" id="240"/>
<outlet property="textWindow" destination="216" id="dD5-aT-ujC"/>
<outlet property="textWindowCancelButton" destination="220" id="uuU-Xb-xDZ"/>
<outlet property="textWindowMessageTextField" destination="366" id="bT3-oV-9zc"/>
<outlet property="textWindowProgressIndicator" destination="230" id="AXd-F1-wQr"/>
<outlet property="textWindowTextView" destination="225" id="FZy-wJ-th1"/>
<outlet property="webView" destination="258" id="GEt-Hd-OFL"/>
<outlet property="webViewCancelButton" destination="251" id="i5n-LY-nJs"/>
<outlet property="webViewMessageTextField" destination="509" id="Unv-5h-E6P"/>
<outlet property="webViewProgressIndicator" destination="277" id="Hun-a2-4wC"/>
<outlet property="webViewWindow" destination="247" id="9lw-Pg-xRw"/>
<outlet property="windowMenu" destination="24" id="328"/>
</connections>
</customObject>
<window allowsToolTipsWhenApplicationIsInactive="NO" autorecalculatesKeyViewLoop="NO" releasedWhenClosed="NO" visibleAtLaunch="NO" frameAutosaveName="ProgressBarWindow" animationBehavior="default" id="21" userLabel="ProgressWindow">
<windowStyleMask key="styleMask" titled="YES" miniaturizable="YES" resizable="YES"/>
<rect key="contentRect" x="472" y="537" width="600" height="83"/>
<rect key="screenRect" x="0.0" y="0.0" width="1440" height="878"/>
<value key="minSize" type="size" width="600" height="83"/>
<value key="maxSize" type="size" width="1200" height="83"/>
<view key="contentView" id="2">
<rect key="frame" x="0.0" y="0.0" width="600" height="83"/>
<autoresizingMask key="autoresizingMask"/>
<subviews>
<progressIndicator wantsLayer="YES" verticalHuggingPriority="750" maxValue="100" bezeled="NO" indeterminate="YES" style="bar" id="204">
<rect key="frame" x="18" y="27" width="472" height="20"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" flexibleMinY="YES"/>
</progressIndicator>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="205">
<rect key="frame" x="18" y="55" width="565" height="17"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" flexibleMinY="YES"/>
<textFieldCell key="cell" lineBreakMode="clipping" sendsActionOnEndEditing="YES" baseWritingDirection="leftToRight" alignment="left" id="472">
<font key="font" metaFont="system"/>
<color key="textColor" name="controlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
<button verticalHuggingPriority="750" id="206">
<rect key="frame" x="500" y="20" width="86" height="32"/>
<autoresizingMask key="autoresizingMask" flexibleMinX="YES" flexibleMinY="YES"/>
<buttonCell key="cell" type="push" title="Quit" bezelStyle="rounded" alignment="center" borderStyle="border" inset="2" id="473">
<behavior key="behavior" pushIn="YES" lightByBackground="YES" lightByGray="YES"/>
<font key="font" metaFont="system"/>
<string key="keyEquivalent" base64-UTF8="YES">
Gw
</string>
</buttonCell>
<connections>
<action selector="cancel:" target="207" id="215"/>
</connections>
</button>
<button toolTip="Show details" horizontalHuggingPriority="750" verticalHuggingPriority="750" id="288">
<rect key="frame" x="20" y="10" width="13" height="13"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<buttonCell key="cell" type="disclosureTriangle" bezelStyle="disclosure" imagePosition="above" alignment="left" controlSize="small" borderStyle="border" inset="2" id="474">
<behavior key="behavior" pushIn="YES" changeBackground="YES" changeGray="YES" lightByContents="YES"/>
<font key="font" metaFont="smallSystem"/>
</buttonCell>
<connections>
<action selector="toggleDetails:" target="207" id="303"/>
</connections>
</button>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="290">
<rect key="frame" x="33" y="7" width="41" height="17"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<textFieldCell key="cell" controlSize="small" scrollable="YES" lineBreakMode="clipping" sendsActionOnEndEditing="YES" title="Details" id="475">
<font key="font" metaFont="smallSystem"/>
<color key="textColor" name="controlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
<scrollView autohidesScrollers="YES" horizontalLineScroll="10" horizontalPageScroll="10" verticalLineScroll="10" verticalPageScroll="10" hasHorizontalScroller="NO" usesPredominantAxisScrolling="NO" id="304">
<rect key="frame" x="20" y="-203" width="555" height="202"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" flexibleMinY="YES"/>
<clipView key="contentView" drawsBackground="NO" copiesOnScroll="NO" id="2mm-QF-kpX">
<rect key="frame" x="1" y="1" width="553" height="200"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<subviews>
<textView editable="NO" importsGraphics="NO" richText="NO" verticallyResizable="YES" findStyle="panel" allowsDocumentBackgroundColorChange="YES" linkDetection="YES" id="307">
<rect key="frame" x="0.0" y="0.0" width="553" height="200"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<color key="textColor" name="textColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="textBackgroundColor" catalog="System" colorSpace="catalog"/>
<size key="minSize" width="553" height="200"/>
<size key="maxSize" width="553" height="10000000"/>
<color key="insertionPointColor" name="textColor" catalog="System" colorSpace="catalog"/>
<connections>
<outlet property="delegate" destination="207" id="489"/>
</connections>
</textView>
</subviews>
</clipView>
<scroller key="horizontalScroller" hidden="YES" verticalHuggingPriority="750" doubleValue="1" horizontal="YES" id="481">
<rect key="frame" x="-100" y="-100" width="87" height="18"/>
<autoresizingMask key="autoresizingMask"/>
</scroller>
<scroller key="verticalScroller" hidden="YES" verticalHuggingPriority="750" doubleValue="0.39849624060150374" horizontal="NO" id="480">
<rect key="frame" x="323" y="1" width="15" height="200"/>
<autoresizingMask key="autoresizingMask"/>
</scroller>
</scrollView>
</subviews>
</view>
<connections>
<outlet property="delegate" destination="207" id="377"/>
</connections>
<point key="canvasLocation" x="87" y="313"/>
</window>
<menu title="MainMenu" systemMenu="main" id="29" userLabel="MainMenu">
<items>
<menuItem title="Application" id="56">
<menu key="submenu" title="Application" systemMenu="apple" id="57">
<items>
<menuItem title="About" id="232">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="orderFrontStandardAboutPanel:" target="-2" id="237"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="233">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Preferences..." id="reA-2d-BZ0">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="menuItemSelected:" target="207" id="x6l-Tq-pHp"/>
</connections>
</menuItem>
<menuItem title="Check for updates..." id="jWa-5b-mBK" userLabel="Check for updates...">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="menuItemSelected:" target="207" id="VBb-a8-Cku"/>
</connections>
</menuItem>
<menuItem title="Services" id="235">
<menu key="submenu" title="Services" systemMenu="services" id="234"/>
</menuItem>
<menuItem isSeparatorItem="YES" id="236">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Hide" keyEquivalent="h" id="134">
<connections>
<action selector="hide:" target="-2" id="152"/>
</connections>
</menuItem>
<menuItem title="Hide Others" keyEquivalent="h" id="145">
<modifierMask key="keyEquivalentModifierMask" option="YES" command="YES"/>
<connections>
<action selector="hideOtherApplications:" target="-2" id="146"/>
</connections>
</menuItem>
<menuItem title="Show All" id="150">
<connections>
<action selector="unhideAllApplications:" target="-2" id="153"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="149">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Quit" keyEquivalent="q" id="136">
<connections>
<action selector="terminate:" target="-2" id="139"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="File" id="83">
<menu key="submenu" title="File" id="81">
<items>
<menuItem title="Open…" keyEquivalent="o" id="72">
<connections>
<action selector="openFiles:" target="207" id="524"/>
</connections>
</menuItem>
<menuItem title="Open Recent" id="FvD-xH-BRz">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Open Recent" systemMenu="recentDocuments" id="QHk-NS-To3">
<items>
<menuItem title="Clear Menu" id="CWw-N0-5lz">
<modifierMask key="keyEquivalentModifierMask"/>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem isSeparatorItem="YES" id="79">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Close" keyEquivalent="w" id="73">
<connections>
<action selector="performClose:" target="-1" id="193"/>
</connections>
</menuItem>
<menuItem title="Save to File…" keyEquivalent="s" id="75">
<connections>
<action selector="saveToFile:" target="207" id="523"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="74">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Page Setup…" keyEquivalent="P" id="77">
<connections>
<action selector="runPageLayout:" target="-1" id="87"/>
</connections>
</menuItem>
<menuItem title="Print…" keyEquivalent="p" id="78">
<connections>
<action selector="print:" target="-1" id="86"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Edit" id="OYz-zT-LAM">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Edit" id="gbe-PM-Daj">
<items>
<menuItem title="Undo" keyEquivalent="z" id="6BN-ih-O2m">
<connections>
<action selector="undo:" target="-1" id="oH0-3R-wus"/>
</connections>
</menuItem>
<menuItem title="Redo" keyEquivalent="z" id="TgQ-5S-p2w">
<modifierMask key="keyEquivalentModifierMask" option="YES" command="YES"/>
<connections>
<action selector="redo:" target="-1" id="bxh-7G-6rR"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="ktb-NS-TU3"/>
<menuItem title="Cut" keyEquivalent="x" id="yLq-sd-YR5">
<connections>
<action selector="cut:" target="-1" id="46i-iL-VLK"/>
</connections>
</menuItem>
<menuItem title="Copy" keyEquivalent="c" id="s3v-O1-6pA">
<connections>
<action selector="copy:" target="-1" id="jxG-ij-fh7"/>
</connections>
</menuItem>
<menuItem title="Paste" keyEquivalent="v" id="6Ld-ut-13f">
<connections>
<action selector="paste:" target="-1" id="PGw-sA-Gma"/>
</connections>
</menuItem>
<menuItem title="Paste and Match Style" keyEquivalent="V" id="GyB-HZ-4kH">
<modifierMask key="keyEquivalentModifierMask" option="YES" command="YES"/>
<connections>
<action selector="pasteAsPlainText:" target="-1" id="AlS-iZ-R4l"/>
</connections>
</menuItem>
<menuItem title="Delete" id="YkA-TP-1J9">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="delete:" target="-1" id="cE3-5v-CP0"/>
</connections>
</menuItem>
<menuItem title="Select All" keyEquivalent="a" id="z4j-fk-SUb">
<connections>
<action selector="selectAll:" target="-1" id="eM9-h9-WVo"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="FXg-ZR-vZj"/>
<menuItem title="Find" id="amO-Yt-228">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Find" id="9XE-hK-Hbc">
<items>
<menuItem title="Find…" tag="1" keyEquivalent="f" id="yA2-y8-dhZ">
<connections>
<action selector="performFindPanelAction:" target="-1" id="zqc-0l-nEk"/>
</connections>
</menuItem>
<menuItem title="Find and Replace…" tag="12" keyEquivalent="f" id="ceF-be-hip">
<modifierMask key="keyEquivalentModifierMask" option="YES" command="YES"/>
<connections>
<action selector="performFindPanelAction:" target="-1" id="Fno-81-Q2N"/>
</connections>
</menuItem>
<menuItem title="Find Next" tag="2" keyEquivalent="g" id="6FX-CW-rwT">
<connections>
<action selector="performFindPanelAction:" target="-1" id="AeZ-8e-DSZ"/>
</connections>
</menuItem>
<menuItem title="Find Previous" tag="3" keyEquivalent="G" id="kIR-xV-7pl">
<connections>
<action selector="performFindPanelAction:" target="-1" id="ALM-eS-1XU"/>
</connections>
</menuItem>
<menuItem title="Use Selection for Find" tag="7" keyEquivalent="e" id="yTY-2E-Cp9">
<connections>
<action selector="performFindPanelAction:" target="-1" id="Gbj-g6-cYJ"/>
</connections>
</menuItem>
<menuItem title="Jump to Selection" keyEquivalent="j" id="80n-rn-d7I">
<connections>
<action selector="centerSelectionInVisibleArea:" target="-1" id="qfH-cs-Cdv"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Spelling and Grammar" id="uWG-xr-cNT">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Spelling" id="Xoa-7u-7zM">
<items>
<menuItem title="Show Spelling and Grammar" keyEquivalent=":" id="rZl-3I-YFV">
<connections>
<action selector="showGuessPanel:" target="-1" id="CSh-4b-cGc"/>
</connections>
</menuItem>
<menuItem title="Check Document Now" keyEquivalent=";" id="tjk-pc-YjK">
<connections>
<action selector="checkSpelling:" target="-1" id="O3S-v5-8Ra"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="ohv-rn-e7b"/>
<menuItem title="Check Spelling While Typing" id="E3o-iC-0NO">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleContinuousSpellChecking:" target="-1" id="k4Q-aZ-O6y"/>
</connections>
</menuItem>
<menuItem title="Check Grammar With Spelling" id="mUP-Jd-Tu1">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleGrammarChecking:" target="-1" id="Ypd-WC-IMS"/>
</connections>
</menuItem>
<menuItem title="Correct Spelling Automatically" id="qq3-jk-TYN">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticSpellingCorrection:" target="-1" id="Ob8-wh-bLR"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Substitutions" id="8Ti-fk-PNH">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Substitutions" id="NeW-07-aln">
<items>
<menuItem title="Show Substitutions" id="DXm-9z-Sle">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="orderFrontSubstitutionsPanel:" target="-1" id="z43-IC-kpA"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="aVP-JA-dKq"/>
<menuItem title="Smart Copy/Paste" id="Pcq-B9-JQ5">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleSmartInsertDelete:" target="-1" id="iu4-Nn-DU4"/>
</connections>
</menuItem>
<menuItem title="Smart Quotes" id="iDT-WP-ISR">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticQuoteSubstitution:" target="-1" id="pnI-ku-LV9"/>
</connections>
</menuItem>
<menuItem title="Smart Dashes" id="QFc-JW-5qE">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticDashSubstitution:" target="-1" id="pY9-lv-EM7"/>
</connections>
</menuItem>
<menuItem title="Smart Links" id="opP-BJ-vhR">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticLinkDetection:" target="-1" id="lfD-XD-tfO"/>
</connections>
</menuItem>
<menuItem title="Data Detectors" id="zWu-P7-fpg">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticDataDetection:" target="-1" id="EAz-S6-L7B"/>
</connections>
</menuItem>
<menuItem title="Text Replacement" id="2R8-fL-H32">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="toggleAutomaticTextReplacement:" target="-1" id="7Lb-Uz-uJ9"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Transformations" id="v1A-Fi-A5j">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Transformations" id="B0B-bK-IZ3">
<items>
<menuItem title="Make Upper Case" id="1P0-qI-ZAM">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="uppercaseWord:" target="-1" id="cre-Qh-bSZ"/>
</connections>
</menuItem>
<menuItem title="Make Lower Case" id="sK6-Xl-9uz">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="lowercaseWord:" target="-1" id="qid-xu-iAw"/>
</connections>
</menuItem>
<menuItem title="Capitalize" id="zvd-g7-rwM">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="capitalizeWord:" target="-1" id="0tj-lN-nE0"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Speech" id="bsj-0j-07E">
<modifierMask key="keyEquivalentModifierMask"/>
<menu key="submenu" title="Speech" id="r3p-Q2-qJZ">
<items>
<menuItem title="Start Speaking" id="8Hl-RR-cUq">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="startSpeaking:" target="-1" id="Zbb-Tp-HBE"/>
</connections>
</menuItem>
<menuItem title="Stop Speaking" id="SLa-Tk-XGJ">
<modifierMask key="keyEquivalentModifierMask"/>
<connections>
<action selector="stopSpeaking:" target="-1" id="Oyc-KO-3qC"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="View" id="KUk-6o-tke">
<menu key="submenu" title="View" id="ITS-DI-OJD">
<items>
<menuItem title="Make Text Bigger" keyEquivalent="+" id="Qae-cV-V7J">
<connections>
<action selector="makeTextBigger:" target="207" id="cHK-EO-JtV"/>
</connections>
</menuItem>
<menuItem title="Make Text Smaller" keyEquivalent="-" id="Gv4-oc-1eL">
<connections>
<action selector="makeTextSmaller:" target="207" id="JTY-6k-ZKY"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
<menuItem title="Window" id="19">
<menu key="submenu" title="Window" systemMenu="window" id="24">
<items>
<menuItem title="Zoom" keyEquivalent="z" id="197">
<modifierMask key="keyEquivalentModifierMask" shift="YES" command="YES"/>
<connections>
<action selector="performZoom:" target="-1" id="198"/>
</connections>
</menuItem>
<menuItem title="Minimize" keyEquivalent="m" id="23">
<connections>
<action selector="performMiniaturize:" target="-1" id="37"/>
</connections>
</menuItem>
<menuItem isSeparatorItem="YES" id="322">
<modifierMask key="keyEquivalentModifierMask" command="YES"/>
</menuItem>
<menuItem title="Bring All to Front" id="5">
<connections>
<action selector="arrangeInFront:" target="-1" id="39"/>
</connections>
</menuItem>
</items>
</menu>
</menuItem>
</items>
<connections>
<outlet property="delegate" destination="207" id="525"/>
</connections>
<point key="canvasLocation" x="36" y="0.0"/>
</menu>
<window allowsToolTipsWhenApplicationIsInactive="NO" autorecalculatesKeyViewLoop="NO" releasedWhenClosed="NO" visibleAtLaunch="NO" frameAutosaveName="TextWindow" animationBehavior="default" id="216" userLabel="TextOutputWindow">
<windowStyleMask key="styleMask" titled="YES" miniaturizable="YES" resizable="YES"/>
<rect key="contentRect" x="297" y="408" width="580" height="420"/>
<rect key="screenRect" x="0.0" y="0.0" width="1440" height="878"/>
<value key="minSize" type="size" width="400" height="200"/>
<view key="contentView" id="217">
<rect key="frame" x="0.0" y="0.0" width="580" height="420"/>
<autoresizingMask key="autoresizingMask"/>
<subviews>
<button verticalHuggingPriority="750" id="220">
<rect key="frame" x="488" y="7" width="86" height="32"/>
<autoresizingMask key="autoresizingMask" flexibleMinX="YES" flexibleMaxY="YES"/>
<buttonCell key="cell" type="push" title="Quit" bezelStyle="rounded" alignment="center" borderStyle="border" inset="2" id="476">
<behavior key="behavior" pushIn="YES" lightByBackground="YES" lightByGray="YES"/>
<font key="font" metaFont="system"/>
<string key="keyEquivalent" base64-UTF8="YES">
Gw
</string>
</buttonCell>
<connections>
<action selector="cancel:" target="207" id="223"/>
</connections>
</button>
<scrollView autohidesScrollers="YES" horizontalLineScroll="10" horizontalPageScroll="10" verticalLineScroll="10" verticalPageScroll="10" hasHorizontalScroller="NO" usesPredominantAxisScrolling="NO" id="226">
<rect key="frame" x="9" y="45" width="561" height="367"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<clipView key="contentView" drawsBackground="NO" copiesOnScroll="NO" id="Hk1-72-Owa">
<rect key="frame" x="1" y="1" width="559" height="365"/>
<autoresizingMask key="autoresizingMask"/>
<subviews>
<textView editable="NO" importsGraphics="NO" richText="NO" verticallyResizable="YES" usesFontPanel="YES" findStyle="panel" allowsDocumentBackgroundColorChange="YES" linkDetection="YES" id="225">
<rect key="frame" x="0.0" y="0.0" width="559" height="365"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<color key="textColor" name="textColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="textBackgroundColor" catalog="System" colorSpace="catalog"/>
<size key="minSize" width="559" height="365"/>
<size key="maxSize" width="561" height="10000000"/>
<color key="insertionPointColor" name="textColor" catalog="System" colorSpace="catalog"/>
<connections>
<outlet property="delegate" destination="207" id="488"/>
</connections>
</textView>
</subviews>
</clipView>
<scroller key="horizontalScroller" hidden="YES" verticalHuggingPriority="750" doubleValue="1" horizontal="YES" id="483">
<rect key="frame" x="-100" y="-100" width="87" height="18"/>
<autoresizingMask key="autoresizingMask"/>
</scroller>
<scroller key="verticalScroller" hidden="YES" verticalHuggingPriority="750" doubleValue="1" horizontal="NO" id="482">
<rect key="frame" x="-30" y="1" width="15" height="340"/>
<autoresizingMask key="autoresizingMask"/>
</scroller>
</scrollView>
<progressIndicator horizontalHuggingPriority="750" verticalHuggingPriority="750" maxValue="100" displayedWhenStopped="NO" bezeled="NO" indeterminate="YES" controlSize="small" style="spinning" id="230">
<rect key="frame" x="15" y="18" width="16" height="16"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMaxY="YES"/>
</progressIndicator>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="366">
<rect key="frame" x="43" y="17" width="429" height="17"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" flexibleMaxY="YES"/>
<textFieldCell key="cell" scrollable="YES" lineBreakMode="clipping" sendsActionOnEndEditing="YES" id="477">
<font key="font" metaFont="system"/>
<color key="textColor" name="controlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
</subviews>
</view>
<connections>
<outlet property="delegate" destination="207" id="376"/>
</connections>
<point key="canvasLocation" x="-478" y="370"/>
</window>
<window allowsToolTipsWhenApplicationIsInactive="NO" autorecalculatesKeyViewLoop="NO" releasedWhenClosed="NO" visibleAtLaunch="NO" frameAutosaveName="WebViewWindow" animationBehavior="default" id="247" userLabel="WebOutputWindow">
<windowStyleMask key="styleMask" titled="YES" miniaturizable="YES" resizable="YES"/>
<rect key="contentRect" x="297" y="408" width="580" height="420"/>
<rect key="screenRect" x="0.0" y="0.0" width="1440" height="878"/>
<value key="minSize" type="size" width="400" height="200"/>
<view key="contentView" id="248">
<rect key="frame" x="0.0" y="0.0" width="580" height="420"/>
<autoresizingMask key="autoresizingMask"/>
<subviews>
<button verticalHuggingPriority="750" id="251">
<rect key="frame" x="485" y="6" width="86" height="32"/>
<autoresizingMask key="autoresizingMask" flexibleMinX="YES" flexibleMaxY="YES"/>
<buttonCell key="cell" type="push" title="Quit" bezelStyle="rounded" alignment="center" state="on" borderStyle="border" inset="2" id="478">
<behavior key="behavior" pushIn="YES" lightByBackground="YES" lightByGray="YES"/>
<font key="font" metaFont="system"/>
<string key="keyEquivalent" base64-UTF8="YES">
Gw
</string>
</buttonCell>
<connections>
<action selector="cancel:" target="207" id="267"/>
</connections>
</button>
<box boxType="oldStyle" borderType="line" titlePosition="noTitle" id="257">
<rect key="frame" x="8" y="45" width="563" height="367"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<view key="contentView" id="X4z-hY-QR7">
<rect key="frame" x="1" y="1" width="561" height="365"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<subviews>
<webView maintainsBackForwardList="NO" id="258" customClass="STDragWebView">
<rect key="frame" x="-1" y="0.0" width="562" height="365"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<webPreferences key="preferences" defaultFontSize="12" defaultFixedFontSize="12">
<nil key="identifier"/>
</webPreferences>
<connections>
<outlet property="UIDelegate" destination="207" id="378"/>
<outlet property="downloadDelegate" destination="207" id="382"/>
<outlet property="dragDelegate" destination="207" id="kaI-rz-1Ps"/>
<outlet property="frameLoadDelegate" destination="207" id="381"/>
<outlet property="policyDelegate" destination="207" id="380"/>
<outlet property="resourceLoadDelegate" destination="207" id="379"/>
</connections>
</webView>
</subviews>
</view>
</box>
<progressIndicator horizontalHuggingPriority="750" verticalHuggingPriority="750" maxValue="100" displayedWhenStopped="NO" bezeled="NO" indeterminate="YES" controlSize="small" style="spinning" id="277">
<rect key="frame" x="16" y="15" width="16" height="16"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMaxY="YES"/>
</progressIndicator>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="509">
<rect key="frame" x="37" y="14" width="429" height="17"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" flexibleMaxY="YES"/>
<textFieldCell key="cell" scrollable="YES" lineBreakMode="clipping" sendsActionOnEndEditing="YES" id="510">
<font key="font" metaFont="system"/>
<color key="textColor" name="controlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
</subviews>
</view>
<connections>
<outlet property="delegate" destination="207" id="375"/>
</connections>
</window>
<window title="Droplet" allowsToolTipsWhenApplicationIsInactive="NO" autorecalculatesKeyViewLoop="NO" visibleAtLaunch="NO" frameAutosaveName="DropletWindow" animationBehavior="default" id="490" userLabel="DropletWindow">
<windowStyleMask key="styleMask" titled="YES" closable="YES" miniaturizable="YES"/>
<rect key="contentRect" x="157" y="273" width="294" height="280"/>
<rect key="screenRect" x="0.0" y="0.0" width="1440" height="878"/>
<view key="contentView" id="491">
<rect key="frame" x="0.0" y="0.0" width="294" height="280"/>
<autoresizingMask key="autoresizingMask"/>
<subviews>
<textField hidden="YES" verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="519">
<rect key="frame" x="0.0" y="0.0" width="294" height="280"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<textFieldCell key="cell" enabled="NO" allowsUndo="NO" sendsActionOnEndEditing="YES" drawsBackground="YES" id="520">
<font key="font" metaFont="system"/>
<color key="textColor" name="controlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="disabledControlTextColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
<box autoresizesSubviews="NO" borderType="line" titlePosition="noTitle" id="494">
<rect key="frame" x="17" y="16" width="260" height="246"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<view key="contentView" id="q0i-G4-K1a">
<rect key="frame" x="1" y="1" width="258" height="244"/>
<autoresizingMask key="autoresizingMask" widthSizable="YES" heightSizable="YES"/>
<subviews>
<progressIndicator wantsLayer="YES" horizontalHuggingPriority="750" verticalHuggingPriority="750" maxValue="100" displayedWhenStopped="NO" bezeled="NO" indeterminate="YES" style="spinning" id="496">
<rect key="frame" x="112" y="128" width="32" height="32"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
</progressIndicator>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="499">
<rect key="frame" x="92" y="112" width="71" height="34"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<textFieldCell key="cell" controlSize="mini" sendsActionOnEndEditing="YES" alignment="center" title="Drop files here" id="500">
<font key="font" metaFont="system"/>
<color key="textColor" name="disabledControlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
<textField verticalHuggingPriority="750" allowsCharacterPickerTouchBarItem="YES" id="505">
<rect key="frame" x="18" y="44" width="218" height="76"/>
<autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMinY="YES"/>
<textFieldCell key="cell" controlSize="small" sendsActionOnEndEditing="YES" alignment="center" id="506">
<font key="font" metaFont="smallSystem"/>
<color key="textColor" name="disabledControlTextColor" catalog="System" colorSpace="catalog"/>
<color key="backgroundColor" name="controlColor" catalog="System" colorSpace="catalog"/>
</textFieldCell>
</textField>
</subviews>
</view>
</box>
</subviews>
</view>
<connections>
<outlet property="delegate" destination="207" id="RFt-L5-f73"/>
</connections>
<point key="canvasLocation" x="608" y="262"/>
</window>
</objects>
</document>

BIN
MainMenu.nib/keyedobjects.nib generated Normal file

Binary file not shown.

View File

@@ -1,342 +0,0 @@
<?php
/**
* PHP CLI Progress bar
*
* PHP 5
*
* Licensed under The MIT License
* Redistributions of files must retain the above copyright notice.
*
* @copyright Copyright 2011, Andy Dawson
* @link http://ad7six.com
* @license MIT License (http://www.opensource.org/licenses/mit-license.php)
*/
/**
* ProgressBar
*
* Static wrapper class for generating progress bars for cli tasks
*
*/
class ProgressBar
{
/**
* Merged with options passed in start function
*/
protected static $defaults = array(
'format' => "\r:message::padding:%.01f%% %2\$d/%3\$d Est: %4\$s. Elapsed: %5\$s [%6\$s]",
'message' => 'Running',
'size' => 30,
'width' => null
);
/**
* Runtime options
*/
protected static $options = array();
/**
* How much have we done already
*/
protected static $done = 0;
/**
* The format string used for the rendered status bar - see $defaults
*/
protected static $format;
/**
* message to display prefixing the progress bar text
*/
protected static $message;
/**
* How many chars to use for the progress bar itself. Not to be confused with $width
*/
protected static $size = 30;
/**
* When did we start (timestamp)
*/
protected static $start;
/**
* The width in characters the whole rendered string must fit in. defaults to the width of the
* terminal window
*/
protected static $width;
/**
* What's the total number of times we're going to call set
*/
protected static $total;
/**
* Show a progress bar, actually not usually called explicitly. Called by next()
*
* @param int $done what fraction of $total to set as progress uses internal counter if not passed
*
* @static
* @return string, the formatted progress bar prefixed with a carriage return
*/
public static function display($done = null)
{
if ($done) {
self::$done = $done;
}
$now = time();
if (self::$total) {
$fractionComplete = (double) (self::$done / self::$total);
} else {
$fractionComplete = 0;
}
$bar = floor($fractionComplete * self::$size);
$barSize = min($bar, self::$size);
$barContents = str_repeat('=', $barSize);
if ($bar < self::$size) {
$barContents .= '>';
$barContents .= str_repeat(' ', self::$size - $barSize);
} elseif ($fractionComplete > 1) {
$barContents .= '!';
} else {
$barContents .= '=';
}
$percent = number_format($fractionComplete * 100, 0);
$elapsed = $now - self::$start;
if (self::$done) {
$rate = $elapsed / self::$done;
} else {
$rate = 0;
}
$left = self::$total - self::$done;
$etc = round($rate * $left, 2);
if (self::$done) {
$etcNowText = '< 1 sec';
} else {
$etcNowText = '???';
}
$timeRemaining = self::humanTime($etc, $etcNowText);
$timeElapsed = self::humanTime($elapsed);
$return = sprintf(
self::$format,
$percent,
self::$done,
self::$total,
$timeRemaining,
$timeElapsed,
$barContents
);
$width = strlen(preg_replace('@(?:\r|:\w+:)@', '', $return));
if (strlen(self::$message) > (self::$width - $width - 3)) {
$message = substr(self::$message, 0, (self::$width - $width - 4)) . '...';
$padding = '';
echo "\n" . strlen($return);
} else {
$message = self::$message;
$width += strlen($message);
$padding = str_repeat(' ', (self::$width - $width));
}
$return = str_replace(':message:', $message, $return);
$return = str_replace(':padding:', $padding, $return);
return $return;
}
/**
* reset internal state, and send a new line so that the progress bar text is "finished"
*
* @static
* @return string, a new line
*/
public static function finish()
{
self::reset();
return "\n";
}
/**
* Increment the internal counter, and returns the result of display
*
* @param int $inc Amount to increment the internal counter
* @param string $message If passed, overrides the existing message
*
* @static
* @return string - the progress bar
*/
public static function next($inc = 1, $message = '')
{
self::$done += $inc;
if ($message) {
self::$message = $message;
}
return self::display();
}
/**
* Called by start and finish
*
* @param array $options array
*
* @static
* @return void
*/
public static function reset($options = array())
{
$options = array_merge(self::$defaults, $options);
if (empty($options['done'])) {
$options['done'] = 0;
}
if (empty($options['start'])) {
$options['start'] = time();
}
if (empty($options['total'])) {
$options['total'] = 0;
}
self::$done = $options['done'];
self::$format = $options['format'];
self::$message = $options['message'];
self::$size = $options['size'];
self::$start = $options['start'];
self::$total = $options['total'];
self::setWidth($options['width']);
}
/**
* change the message to be used the next time the display method is called
*
* @param string $message the string to display
*
* @static
* @return void
*/
public static function setMessage($message = '')
{
self::$message = $message;
}
/**
* change the total on a running progress bar
*
* @param int $total the new number of times we're expecting to run for
*
* @static
* @return void
*/
public static function setTotal($total = '')
{
self::$total = $total;
}
/**
* Initialize a progress bar
*
* @param mixed $total number of times we're going to call set
* @param int $message message to prefix the bar with
* @param int $options overrides for default options
*
* @static
* @return string - the progress bar string with 0 progress
*/
public static function start($total = null, $message = '', $options = array())
{
if ($message) {
$options['message'] = $message;
}
$options['total'] = $total;
$options['start'] = time();
self::reset($options);
return self::display();
}
/**
* Convert a number of seconds into something human readable like "2 days, 4 hrs"
*
* @param int $seconds how far in the future/past to display
* @param string $nowText if there are no seconds, what text to display
*
* @static
* @return string representation of the time
*/
protected static function humanTime($seconds, $nowText = '< 1 sec')
{
$prefix = '';
if ($seconds < 0) {
$prefix = '- ';
$seconds = -$seconds;
}
$days = $hours = $minutes = 0;
if ($seconds >= 86400) {
$days = (int) ($seconds / 86400);
$seconds = $seconds - $days * 86400;
}
if ($seconds >= 3600) {
$hours = (int) ($seconds / 3600);
$seconds = $seconds - $hours * 3600;
}
if ($seconds >= 60) {
$minutes = (int) ($seconds / 60);
$seconds = $seconds - $minutes * 60;
}
$seconds = (int) $seconds;
$return = array();
if ($days) {
$return[] = "$days days";
}
if ($hours) {
$return[] = "$hours hrs";
}
if ($minutes) {
$return[] = "$minutes mins";
}
if ($seconds) {
$return[] = "$seconds secs";
}
if (!$return) {
return $nowText;
}
return $prefix . implode(array_slice($return, 0, 2), ', ');
}
/**
* Set the width the rendered text must fit in
*
* @param int $width passed in options
*
* @static
* @return void
*/
protected static function setWidth($width = null)
{
if ($width === null) {
if (DIRECTORY_SEPARATOR === '/') {
$width = `tput cols`;
}
if ($width < 80) {
$width = 80;
}
}
self::$width = $width;
}
}

521
Yuba.php
View File

@@ -1,41 +1,42 @@
#!/usr/bin/php
<?php
// Yuba
// //
//////////////////////////////////////////
$version = "0.6.1.2";
$version = "0.6.9";
ini_set('memory_limit', '4096M');
date_default_timezone_set("America/Los_Angeles");
$time_start = microtime(true);
include('ProgressBar.php');
// Includes & Prefs
//////////////////////////////////////////
require("functions.php");
require("filetypes.php");
$wopt_noprofile = 1;
$p = unserialize(file_get_contents("prefs.php"));
// Path & application variables
//////////////////////////////////////////
if (in_array("-nohash", $argv)) { $wopt_hash = 0; } else { $wopt_hash = 1; }
if (in_array("-nothumbs", $argv)) { $wopt_thumbs = 0; } else { $wopt_thumbs = 1; }
if (in_array("-nometa", $argv)) { $wopt_meta = 0; } else { $wopt_meta = 1; }
if (!isset($argv[1])) { echo "Input error"; die; }
$zpath = realpath(@$argv[1]);
$bdest = realpath(@$argv[2]);
if (!is_dir($zpath) | !is_dir($bdest)) { echo "Usage: walk <path> <dest>"; die; }
if (@$argv[2]) { $bdest = realpath($argv[2]); } else { $bdest = realpath($p['bdest']); }
if (!is_dir($zpath) | !is_dir($bdest)) { echo "Filepath error"; die; }
// Check for bundle
if ($zpath == "/") { $blabel = "root"; } else { $blabel = preg_replace("/[^A-Za-z0-9\.]/", "_", basename($zpath)); }
if (is_writable($zpath)) { $wopt_paranoid = 1; } else { $wopt_paranoid = 0; }
if (is_writable($zpath)) { $p['paranoid'] = 1; } else { $p['paranoid'] = 0; }
$bpath = chop($bdest,"/")."/".substr(crc32($zpath),0,3)."_".$blabel.".bundle";
if (!is_dir($bpath)) { mkdir($bpath); }
if (!is_dir($bpath."/thumbs")) { mkdir($bpath."/thumbs"); }
$wopt_hash_limit = 1; // don't hash if exceeds in gigs, 0 for unlimited
$wopt_thumb_size = "512";
// Treat these directories as files
$wopt_bundles = array( "app",
$p['bundles'] = array( "app",
"bundle",
"sparsebundle",
"photoslibrary",
@@ -49,12 +50,12 @@ $wopt_bundles = array( "app",
"rtfd"
);
foreach ($wopt_bundles as $bundle) {
$wopt_nodescend[] = "*.".$bundle;
foreach ($p['bundles'] as $bundle) {
$p['nodescend'][] = "*.".$bundle;
}
// Ignore matching files and directories
$wopt_ignore = array( ".DS_Store",
$p['ignore'] = array( ".DS_Store",
".DocumentRevisions-V100",
".Spotlight-V100",
".TemporaryItems",
@@ -65,278 +66,24 @@ $wopt_ignore = array( ".DS_Store",
".neofinder.abemeda.volinfo.xml"
);
$max_label = 50;
// Metadata tools
$bin_gfi = "/Applications/Xcode.app/Contents/Developer/usr/bin/GetFileInfo";
$bin_mediainfo = "/opt/local/bin/mediainfo";
$bin_exiftool = "/opt/local/bin/exiftool";
$bin_tq = "/opt/local/bin/ql-thumbnail-lossy";
$bin_tv = "/opt/local/bin/vipsthumbnail";
$bin_tf = "/usr/local/bin/ffmpegthumbnailer";
$bin_gfi = __DIR__."/bin/GetFileInfo";
$bin_mediainfo = __DIR__."/bin/mediainfo";
$bin_exiftool = __DIR__."/bin/exiftool";
$bin_ffmpeg = __DIR__."/bin/ffmpeg";
$bin_qlthumb = __DIR__."/bin/ql-thumbnail";
// Media extensions
// Banner
//////////////////////////////////////////
$t_files['ffmpeg'] = array( "mkv",
"avi",
"mpeg",
"mpg",
"vob",
"mp4",
"m4v",
"m2v",
"m2ts",
"asf",
"wmv",
"rm",
"divx",
"fla",
"flv",
"webm" );
$t_files['vips'] = array( "jpg",
"jpeg",
"tif",
"tiff",
"gif",
"psd",
"png" );
$m_files = array( "mkv",
"ogg",
"avi",
"wav",
"mpeg",
"mpg",
"vob",
"mp4",
"m2v",
"mp3",
"asf",
"wma",
"wmv",
"qt",
"mov",
"rm",
"ifo",
"ac3",
"dts",
"aac",
"ape",
"flac",
"aiff",
"m2ts" );
$e_files = array( "ai",
"aiff",
"ape",
"asf",
"avi",
"bmp",
"divx",
"dng",
"doc",
"docx",
"eps",
"epub",
"exe",
"exif",
"fla",
"flac",
"flv",
"gif",
"icc",
"iso",
"jpg",
"jpeg",
"m2ts",
"m4a",
"m4b",
"m4v",
"mkv",
"mobi",
"azw",
"azw3",
"mov",
"qt",
"mp3",
"mp4",
"mpeg",
"mpg",
"m2v",
"nef",
"numbers",
"ogg",
"pages",
"pdf",
"pict",
"png",
"ppm",
"ppt",
"psd",
"psb",
"qif",
"raw",
"rtf",
"sr2",
"srf",
"svg",
"swf",
"tiff",
"tif",
"torrent",
"vcf",
"vob",
"wav",
"webm",
"wma",
"wmv",
"xls",
"xlsx",
"xmp",
"zip" );
foreach ($e_files as $ext) { $e_files[] = strtoupper($ext); }
foreach ($m_files as $ext) { $m_files[] = strtoupper($ext); }
foreach ($t_files['ffmpeg'] as $ext) { $t_files['ffmpeg'][] = strtoupper($ext); }
foreach ($t_files['vips'] as $ext) { $t_files['vips'][] = strtoupper($ext); }
// Functions
//////////////////////////////////////////
/*
function getParents($zpath, $pathname) {
$path = dirname($pathname);
$parts = explode("/",trim(substr($path,strlen(basename($zpath))),"/"));
foreach ($parts as $index => $part) {
$parents[] = array($part, md5($zpath."/".implode("/",array_slice($parts, 0, $index+1))));
}
return $parents;
}
*/
function shortlabel($pathname, $max, $min = null) {
$basename = basename($pathname);
$suffix = "(...).".pathinfo($basename,PATHINFO_EXTENSION);
if (strlen($basename) > $max) {
$return = substr($basename, 0, ($max-strlen($suffix))).$suffix;
} else {
$return = $basename;
}
if (strlen($return) < $min) {
$out = $return.@str_repeat(" ", ($min-strlen($return)));
} else {
$out = $return;
}
return $out;
}
function human_filesize($bytes, $decimals = 2) {
$size = array('B','kB','MB','GB','TB','PB','EB','ZB','YB');
$factor = floor((strlen($bytes) - 1) / 3);
return sprintf("%.{$decimals}f", $bytes / pow(1024, $factor)) . @$size[$factor];
}
function stringPrint($string) {
echo $string.@str_repeat(" ", (10-strlen($string)));
}
function getWoptString() {
global $wopt_bundles, $wopt_ignore, $wopt_hash, $wopt_hash_limit, $wopt_meta, $wopt_thumbs, $wopt_thumb_size, $wopt_paranoid;
return array( array("bundles", $wopt_bundles),
array("ignore", $wopt_ignore),
array("hash", $wopt_hash),
array("wopt_hash_limit", $wopt_hash_limit),
array("metadata", $wopt_meta),
array("thumbs", $wopt_thumbs),
array("thumb_size", $wopt_thumb_size),
array("wopt_paranoid", $wopt_paranoid),
);
}
class plistParser extends XMLReader {
public function parseString($string) { $this->XML($string); return $this->process(); }
private function process() {
$this->read();
if($this->nodeType !== XMLReader::DOC_TYPE || $this->name !== "plist") { throw new Exception(sprintf("Error parsing plist. nodeType: %d -- Name: %s", $this->nodeType, $this->name), 2); }
if(!$this->next("plist") || $this->nodeType !== XMLReader::ELEMENT || $this->name !== "plist") { throw new Exception(sprintf("Error parsing plist. nodeType: %d -- Name: %s", $this->nodeType, $this->name), 3); }
$plist = array(); while($this->read()) { if($this->nodeType == XMLReader::ELEMENT) { $plist[] = $this->parse_node(); } }
if(count($plist) == 1 && $plist[0]) { return $plist[0]; } else { return $plist; }
}
private function parse_node() {
if($this->nodeType !== XMLReader::ELEMENT) return;
switch($this->name) {
case 'data': return base64_decode($this->getNodeText()); break;
case 'real': return floatval($this->getNodeText()); break;
case 'string': return $this->getNodeText(); break;
case 'integer': return intval($this->getNodeText()); break;
case 'date': return $this->getNodeText(); break;
case 'true': return true; break;
case 'false': return false; break;
case 'array': return $this->parse_array(); break;
case 'dict': return $this->parse_dict(); break;
default: throw new Exception(sprintf("Not a valid plist. %s is not a valid type", $this->name), 4);
}
}
private function parse_dict() {
$array = array(); $this->nextOfType(XMLReader::ELEMENT);
do { if($this->nodeType !== XMLReader::ELEMENT || $this->name !== "key") { if(!$this->next("key")) { return $array; } } $key = $this->getNodeText(); $this->nextOfType(XMLReader::ELEMENT); $array[$key] = $this->parse_node(); $this->nextOfType(XMLReader::ELEMENT, XMLReader::END_ELEMENT); }
while($this->nodeType && !$this->isNodeOfTypeName(XMLReader::END_ELEMENT, "dict")); return $array;
}
private function parse_array() {
$array = array(); $this->nextOfType(XMLReader::ELEMENT);
do { $array[] = $this->parse_node(); $this->nextOfType(XMLReader::ELEMENT, XMLReader::END_ELEMENT); }
while($this->nodeType && !$this->isNodeOfTypeName(XMLReader::END_ELEMENT, "array")); return $array;
}
private function getNodeText() { $string = $this->readString(); $this->nextOfType(XMLReader::END_ELEMENT); return $string; }
private function nextOfType() { $types = func_get_args(); $this->read(); while($this->nodeType && !(in_array($this->nodeType, $types))) { $this->read(); } }
private function isNodeOfTypeName($type, $name) { return $this->nodeType === $type && $this->name === $name; }
}
function parseMediaInfo ($xml) {
$xml = simplexml_load_string($xml);
$data = array();
$data['version'] = (string) $xml['version'];
foreach ($xml->File->track as $track) {
$trackType = strtolower($track['type']);
$trackId = isset($track['streamid']) ? $track['streamid'] : 1;
$trackId = (string)$trackId;
$trackData = [];
foreach ($track as $rawKey => $rawVal) {
$key = strtolower($rawKey);
$val = (string)$rawVal;
if ($key == 'stream_identifier') { continue; }
if (!array_key_exists($key, $trackData)) {
$trackData[$key] = array($val);
} elseif (!in_array($val, $trackData[$key])) {
$trackData[$key][] = $val;
}
}
if ($trackType == 'general') {
$data['file']['general'] = $trackData;
} else {
$data['file'][$trackType][$trackId] = $trackData;
}
}
return $data;
}
function bashcolor($str,$fgcolor="white",$bgcolor=null) {
static $fgcolors = array('black' => '0;30', 'dark gray' => '1;30', 'blue' => '0;34', 'light blue' => '1;34', 'green' => '0;32', 'light green' => '1;32', 'cyan' => '0;36', 'light cyan' => '1;36', 'red' => '0;31', 'light red' => '1;31', 'purple' => '0;35', 'light purple' => '1;35', 'brown' => '0;33', 'yellow' => '1;33', 'light gray' => '0;37', 'white' => '1;37', 'underline' => '4');
static $bgcolors = array('black' => '40', 'red' => '41', 'green' => '42', 'yellow' => '43', 'blue' => '44', 'magenta' => '45', 'cyan' => '46', 'light gray' => '47');
$out="";
if (!isset($fgcolors[$fgcolor])) { $fgcolor='white'; }
if (!isset($bgcolors[$bgcolor])) { $bgcolor=null; }
if ($fgcolor) { $out .= "\033[{$fgcolors[$fgcolor]}m"; }
if ($bgcolor) { $out .= "\033[{$bgcolors[$bgcolor]}m"; }
$out .= $str."\033[0m";
return $out;
}
$banner = "Yuba: ".$zpath." -> ".$bpath;
echo $banner."\n".str_repeat("-", strlen($banner))."\n";
// Disk info
//////////////////////////////////////////
echo "Gathering system info...\n";
$host = gethostname();
$disks = shell_exec("diskutil list 2>&1");
@@ -382,13 +129,19 @@ if ($zpath == "/") {
$type = "Folder";
}
$profile = shell_exec("system_profiler SPHardwareDataType SPStorageDataType SPThunderboltDataType SPUSBDataType 2>&1");
if ($wopt_noprofile) {
$profile = "disabled";
} else {
$profile = shell_exec("system_profiler SPHardwareDataType SPStorageDataType SPThunderboltDataType SPUSBDataType 2>&1");
}
$qlmanage = shell_exec("qlmanage -m 2>&1");
$sysvers = shell_exec("sw_vers 2>&1");
// Database
//////////////////////////////////////////
echo "Building database...\n";
$stamp = date("Y-m-d_H-i-s", time());
$dbo = new PDO("sqlite:".$bpath."/".$stamp.".sqlite3");
@@ -594,7 +347,7 @@ $dbo->exec("CREATE TABLE files (
$stmt = $dbo->prepare("INSERT INTO _walkwalk VALUES (:version, :opts, :host, :uid, :zpath, :bpath, :type, :passed_file, :passed_dir, :passed_link, :passed_total, :nodescended, :ignored, :dupes, :stats, :qlmanage, :sysvers, :diskutil, :disks, :profile, :status)");
$stmt->BindValue(":version",$version);
$stmt->BindValue(":opts",serialize(getWoptString()));
$stmt->BindValue(":opts",serialize($p));
$stmt->BindValue(":host",$host);
$stmt->BindValue(":uid",posix_getuid());
$stmt->BindValue(":zpath",$zpath);
@@ -612,36 +365,37 @@ $stmt->execute();
// Iterator
//////////////////////////////////////////
$passed_file = $passed_dir = $passed_link = $nodescended = $ignored = 0;
$first_run = 1;
$passed_file = $passed_dir = $passed_link = $passed_total = $nodescended = $ignored = 0;
$files = new RecursiveIteratorIterator(
new RecursiveCallbackFilterIterator(
new RecursiveDirectoryIterator(
$zpath,
RecursiveDirectoryIterator::SKIP_DOTS
),
function ($current, $key, $iterator) use ($wopt_ignore, $wopt_nodescend) {
global $nodescended, $ignored, $passed_file, $passed_dir, $passed_link;
function ($current, $key, $iterator) use ($p) {
global $nodescended, $ignored, $passed_file, $passed_dir, $passed_link, $passed_total, $first_run;
$clean = true;
// identify ignore files
if (is_array($wopt_ignore)) {
foreach ($wopt_ignore as $wildcard) {
if (is_array($p['ignore'])) {
foreach ($p['ignore'] as $wildcard) {
if (fnmatch($wildcard, $current->getFilename())) {
$clean = false;
$ignored++;
if ($first_run) { $ignored++; }
}
}
}
// identify nodescend dirs
if (is_array($wopt_nodescend)) {
foreach ($wopt_nodescend as $wildcard) {
if (is_array($p['nodescend'])) {
foreach ($p['nodescend'] as $wildcard) {
if (fnmatch($wildcard, $current->getPath())) {
$clean = false;
$nodescended++;
if ($first_run) { $nodescended++; }
}
}
}
//tally stats
if ($clean) {
if ($clean && $first_run) {
if ($current->getType() == "file") {
$passed_file++;
} elseif ($current->getType() == "dir") {
@@ -649,6 +403,7 @@ $files = new RecursiveIteratorIterator(
} elseif ($current->getType() == "link") {
$passed_link++;
}
$passed_total++;
}
return $clean;
}
@@ -657,60 +412,58 @@ $files = new RecursiveIteratorIterator(
RecursiveIteratorIterator::CATCH_GET_CHILD
);
// Banner
// Tally
//////////////////////////////////////////
echo "Yuba ".$version."\n";
echo "-----------------------------------------------\n";
$banner = $zpath." -> ".$bpath;
echo $banner."\n";
echo str_repeat("-", strlen($banner))."\n";
foreach ($files as $null) { }
$first_run = 0;
// Permissions
//////////////////////////////////////////
if (posix_getuid()) {
echo bashcolor("You are not root. Checking file readability: ", "red");
echo ProgressBar::start($passed_total,"File permissions");
echo "\n";
echo "You are not root. Checking file readability";
$oops = 0;
foreach ($files as $splFileInfo) {
$path = $splFileInfo->getRealPath();
if (!is_readable($path)) {
if ($path && !is_readable($path)) {
$oops = 1;
echo "x";
} else {
echo ".";
}
echo ProgressBar::next();
//echo "\t".$path."\n";
}
echo ProgressBar::finish();
echo "\n\n";
echo "\n";
if ($oops) {
echo "Some files could not be read. Continue? (Y/n)";
$line = trim(fgets(fopen("php://stdin","r")));
$line = $line ?: "y";
if($line != "y"){
echo "Exiting!\n"; die;
}
echo "Some files could not be read. Stopping.";
die;
}
} else {
echo bashcolor("Running as root. Some QuickLook plugins may not be available.", "red");
echo "\n\n";
echo "Running as root. Some QuickLook plugins may not be available.";
echo "\n";
}
$fixatimes = 0;
if ($wopt_paranoid) {
echo bashcolor("\nFilesystem is writable. You can choose:\n(c) Preserve ctimes (default)\n(a) Preserve atimes\n", "purple");
$line = trim(fgets(fopen("php://stdin","r"))) ?: "c";
if ($line == "a") { $fixatimes = 1; }
if ($p['paranoid']) {
echo "Filesystem is writable. ";
if ($p['fixatimes']) {
echo "Preserving atimes.";
} else {
echo "Preserving ctimes.";
}
echo "\n";
}
// Pool DB
@@ -726,9 +479,11 @@ $dbp->exec("CREATE TABLE IF NOT EXISTS thumbs (fid TEXT, created INTEGER, relati
// Prescan
//////////////////////////////////////////
$i = 0;
$family = array();
$fids = array();
echo ProgressBar::start($passed_total,"Prescan");
foreach ($files as $splFileInfo) {
$pathname = $splFileInfo->getPathname();
@@ -762,28 +517,21 @@ foreach ($files as $splFileInfo) {
$family[$pkey]['children'][] = $key;
if ($i % 5000 == 0) {
echo "\r\033[K\rPrescan: ".$pathname;
}
$i++;
echo ProgressBar::next();
}
echo "\r\033[K\rPrescan: done\n";
echo ProgressBar::finish();
// Debug record of duplicate FIDs
$dupes = array_filter($dx, function($a) { return count($a) > 2; });
ob_start();
var_dump($dupes);
$dxo = ob_get_clean();
$dupes = array_filter($dx, function($a) { return count($a) > 1; });
$dxo = var_export($dupes, true);
if (strlen($dxo)) {
file_put_contents($bpath."/".$stamp."_dupes.txt",$dxo);
$dupecount = count($dupes,COUNT_RECURSIVE) - count($dupes);
echo "\n".bashcolor(floor(($dupecount/$i)*100)." percent of files look like duplicates","green")."\n\n";
echo floor(($dupecount/$passed_total)*100)." percent of files look like duplicates\n";
}
// Write family to DB
@@ -796,11 +544,10 @@ $message .= $passed_link." links, ";
$message .= $ignored." ignored, ";
$message .= ($dupecount ? $dupecount : 0)." dupes";
echo ProgressBar::start($i,$message);
echo ProgressBar::start(count($family),$message);
foreach ($family as $key => $item) {
echo ProgressBar::next();
$stmt = $dbo->prepare("INSERT INTO family VALUES (:pid, :fid, :children)");
$stmt->BindValue(":pid",$key);
if (@$item['fid']) {
@@ -811,6 +558,8 @@ foreach ($family as $key => $item) {
}
$stmt->execute();
echo ProgressBar::next();
}
echo ProgressBar::finish();
@@ -822,7 +571,7 @@ $stmt = "UPDATE _walkwalk SET ";
$stmt .= "passed_file=".$passed_file.", ";
$stmt .= "passed_dir=".$passed_dir.", ";
$stmt .= "passed_link=".$passed_link.", ";
$stmt .= "passed_total=".$i.", ";
$stmt .= "passed_total=".$passed_total.", ";
$stmt .= "nodescended=".$nodescended.", ";
$stmt .= "ignored=".$ignored.", ";
$stmt .= "dupes=".($dupecount ? $dupecount : 0);
@@ -831,13 +580,9 @@ $dbo->exec($stmt);
// Thumbnails
//////////////////////////////////////////
if ($wopt_thumbs) {
if ($p['thumbs']) {
$message = "Generating thumbnails...";
echo ProgressBar::start(count($fx),$message);
$tempdir = "/tmp/".$blabel."_".$stamp;
if (!is_dir($tempdir)) { mkdir($tempdir); }
echo ProgressBar::start(count($fx),"Generating thumbnails");
foreach ($fx as $array) {
@@ -845,24 +590,25 @@ if ($wopt_thumbs) {
$pathname = $array[1];
$ext = pathinfo($pathname,PATHINFO_EXTENSION);
$tpath = $bpath."/thumbs/".substr($fid, 0, 2);
if (!is_dir($tpath)) { mkdir($tpath); }
$tfile = $tpath."/".$fid.".jpg";
// HACK for ql-thumbnail bug
$t_skip = array("emlx");
if (count($t_skip) && in_array($ext, $t_skip)) {
echo ProgressBar::next(1, "Skipping ".shortlabel(basename($pathname),$max_label));
echo ProgressBar::next("Skipping ".shortlabel($pathname));
continue;
}
// if no thumb file, then poll database
if (file_exists($tfile)) {
echo ProgressBar::next(1, "Thumb file found for ".shortlabel(basename($pathname),$max_label));
echo ProgressBar::next("Thumb file found for ".shortlabel($pathname));
continue;
} elseif ($dbp->query("SELECT EXISTS(SELECT 1 FROM thumbs WHERE fid='".$fid."')")->fetch()[0]) {
echo ProgressBar::next(1, "Thumb record found for ".shortlabel(basename($pathname),$max_label));
echo ProgressBar::next("Thumb record found for ".shortlabel($pathname));
continue;
} else {
echo ProgressBar::next(1, "Generating thumb for ".shortlabel(basename($pathname),$max_label));
echo ProgressBar::next("Generating thumb for ".shortlabel($pathname));
}
$stmt = $dbp->prepare("INSERT INTO thumbs VALUES (:fid, :created, :relative_path, :width, :height, :tool)");
@@ -870,31 +616,31 @@ if ($wopt_thumbs) {
$stmt->BindValue(":created",time());
$shellpath = escapeshellarg($pathname);
$tempfile = $tempdir."/".$fid.".jpg";
// first try to make a thumb with external tools
$cmd = null;
if (in_array($ext, $t_files['vips'])) {
$cmd = $bin_tv." ".$shellpath." -o ".$tempfile."[Q=90,optimize_coding] --size=".$wopt_thumb_size;
$stmt->BindValue(":tool","vips");
if (in_array($ext, $t_files['sips'])) {
//$cmd = $bin_tv." ".$shellpath." -o ".$tfile."[Q=90,optimize_coding] --size=".$p['thumb_size'];
$cmd = "sips -s format jpeg -s formatOptions 80 --resampleHeightWidthMax ".$p['thumb_size']." ".$shellpath." --out ".$tfile;
$stmt->BindValue(":tool","sips");
} elseif (in_array($ext, $t_files['ffmpeg'])) {
$cmd = $bin_tf." -i ".$shellpath." -o ".$tempfile." -s ".$wopt_thumb_size." -c jpg -q 8.5";
//$cmd = $bin_tf." -i ".$shellpath." -o ".$tfile." -s ".$p['thumb_size']." -c jpg -q 8.5";
$cmd = $bin_ffmpeg." -ss $(( $(".$bin_mediainfo." --Inform='Video;%Duration%' ".$shellpath.") / 10000 )) -i ".$shellpath." -vframes 1 -filter:v scale='400:-1' -q:v 3 ".$tfile;
$stmt->BindValue(":tool","ffmpeg");
}
if ($cmd) { shell_exec($cmd." 2>&1"); }
// if those tools failed, try quicklook
if (!@filesize($tempfile)) {
$cmd = $bin_tq." ".$shellpath." ".$tempfile." public.jpeg-2000 ".$wopt_thumb_size." ".$wopt_thumb_size." .8";
if (!@filesize($tfile)) {
//$cmd = $bin_qlthumb." ".$shellpath." ".$tfile." public.jpeg-2000 ".$p['thumb_size']." ".$p['thumb_size']." .8";
$cmd = $bin_qlthumb." ".$shellpath." ".$tfile." public.jpeg ".$p['thumb_size']." ".$p['thumb_size']." .8";
shell_exec($cmd." 2>&1");
$stmt->BindValue(":tool","quicklook");
}
// success, move thumb into the bundle
if (file_exists($tempfile) && @filesize($tempfile)) {
if (!is_dir($tpath)) { mkdir($tpath); }
rename($tempfile,$tfile);
if (file_exists($tfile) && @filesize($tfile)) {
$stmt->BindValue(":relative_path",substr($tfile, strlen($bpath)));
list($width, $height) = getimagesize($tfile);
$stmt->BindValue(":width",$width);
@@ -912,10 +658,9 @@ if ($wopt_thumbs) {
// External metadata
//////////////////////////////////////////
if ($wopt_meta) {
if ($p['meta']) {
$message = "Collecting external metadata...";
echo ProgressBar::start(count($fx),$message);
echo ProgressBar::start(count($fx),"Collecting external metadata");
foreach ($fx as $array) {
@@ -925,10 +670,10 @@ if ($wopt_meta) {
$ext = pathinfo($pathname,PATHINFO_EXTENSION);
if (!in_array($ext, $e_files) && !in_array($ext, $m_files)) {
echo ProgressBar::next(1, "Not a media file: ".shortlabel($pathname,$max_label));
echo ProgressBar::next("Not a media file: ".shortlabel($pathname));
continue;
} else {
echo ProgressBar::next(1, "Metadata: ".shortlabel($pathname,$max_label));
echo ProgressBar::next("Metadata: ".shortlabel($pathname));
}
if (in_array($ext, $e_files)) {
@@ -961,10 +706,10 @@ if ($wopt_meta) {
// Hashes
//////////////////////////////////////////
if ($wopt_hash) {
if ($p['hash']) {
if ($wopt_hash_limit) {
$message = "Generating hashes for files under".$wopt_hash_limit."GB";
if ($p['hash_limit']) {
$message = "Generating hashes for files under ".$p['hash_limit']."GB";
} else {
$message = "Generating hashes for all files";
}
@@ -975,14 +720,14 @@ if ($wopt_hash) {
$fid = $array[0];
$pathname = $array[1];
$size = filesize($pathname);
$limit = $wopt_hash_limit*1000000000;
$limit = $p['hash_limit']*1000000000;
$check = $dbp->query("SELECT EXISTS(SELECT 1 FROM md5 WHERE fid='".$fid."')")->fetch()[0];
if ($check) {
echo ProgressBar::next(1, "Hash already exists: ".shortlabel($pathname,$max_label));
} elseif ($wopt_hash_limit && ($size > $limit)) {
echo ProgressBar::next(1, "Too big to hash: ".shortlabel($pathname,$max_label)." (".human_filesize($size).")");
echo ProgressBar::next("Hash already exists: ".shortlabel($pathname));
} elseif ($p['hash_limit'] && ($size > $limit)) {
echo ProgressBar::next("Too big to hash: ".shortlabel($pathname)." (".human_filesize($size).")");
} else {
echo ProgressBar::next(1, "Generating hash: ".shortlabel($pathname,$max_label));
echo ProgressBar::next("Generating hash: ".shortlabel($pathname));
$stmt = $dbp->prepare("INSERT INTO md5 VALUES (:fid, :hash)");
$stmt->BindValue(":fid",$fid);
$stmt->BindValue(":hash",md5_file($pathname));
@@ -997,11 +742,12 @@ if ($wopt_hash) {
// Files
//////////////////////////////////////////
echo ProgressBar::start($i);
echo ProgressBar::start($passed_total,"Processing files");
$j = 0;
foreach ($files as $splFileInfo) {
echo "\n";
// DB
$stmt = $dbo->prepare("INSERT INTO files VALUES (:pid, :fid, :Pathname, :Path, :Filename, :Extension, :Type, :Inode, :Perms, :Owner, :ATime, :CTime, :MTime, :LinkTarget, :RealPath, :stat, :items, :newest, :gfi_type, :gfi_attr, :gfi_created, :Size, :Title, :PixelWidth, :PixelHeight, :Duration, :DateTimeOriginal, :Origin, :GPS, :Author, :spotlight, :kMDItemDateAdded, :kMDItemLastUsedDate, :kMDItemUseCount, :kMDItemContentModificationDate, :kMDItemContentType, :kMDItemCreator, :kMDItemFSCreatorCode, :kMDItemKind, :kMDItemFSTypeCode, :kMDItemUserTags, :kMDItemFSInvisible, :kMDItemNumberOfPages, :kMDItemPageHeight, :kMDItemPageWidth, :kMDItemWhereFroms, :kMDItemEncodingApplications, :has_exif, :has_mediainfo, :has_hash, :thumb_filename, :thumb_width, :thumb_height, :ProfileDescription, :BitDepth, :Compression, :Orientation, :LensType, :VideoFormat, :AudioFormat, :Tracks, :Profile, :Bitrate)");
@@ -1010,7 +756,7 @@ foreach ($files as $splFileInfo) {
$type = $splFileInfo->getType();
if ($type == "dir") {
foreach ($wopt_bundles as $bundle) {
foreach ($p['bundles'] as $bundle) {
$check = ".".$bundle;
if (substr($splFileInfo->getFilename(), -(strlen($check)), strlen($check)) == $check) { $type = "bundle"; }
}
@@ -1052,14 +798,14 @@ foreach ($files as $splFileInfo) {
}
stringPrint(shortlabel(basename($pathname),$max_label,$max_label+10));
echo shortlabel($pathname,50,1);
// ------------------------------------------------ //
// Get stat
if ($type != "link") {
$stat = chop(@shell_exec("stat -x ".$shellpath." 2>&1"));
$stat = chop(@shell_exec("stat -x ".$shellpath." 2>&1"));
} else {
$stat = null;
}
@@ -1067,7 +813,7 @@ foreach ($files as $splFileInfo) {
// Cache stat
if ($type != "link" && $wopt_paranoid) {
if ($type != "link" && $p['paranoid']) {
$pre_access = null;
$pre_modify = null;
$pre_change = null;
@@ -1313,16 +1059,9 @@ function parseItem($data, $item) {
unset($breakout);
print_r($fetch_exif);
print_r($fetch_media);
//print_r($fetch_exif);
//print_r($fetch_media);
} else {
stringPrint(" ");
stringPrint(" ");
stringPrint(" ");
stringPrint(" ");
}
// Write to DB
@@ -1332,16 +1071,14 @@ function parseItem($data, $item) {
// Set fileatime back to original value
if ($type != "link" && is_writable($pathname) && $fixatimes) {
if ($type != "link" && is_writable($pathname) && $p['fixatimes']) {
@exec("touch -at `date -r ".$atime." +%Y%m%d%H%M.%S` ".$shellpath." 2>&1");
stringPrint("touch");
}
echo "\n";
// Double check stat for file against pre-run value
if ($type != "link" && $wopt_paranoid) {
if ($type != "link" && $p['paranoid']) {
$restat = chop(@shell_exec("stat -x ".$shellpath." 2>&1"));
$post_access = null;
@@ -1366,18 +1103,12 @@ function parseItem($data, $item) {
$message[] = "CTIME";
}
if (count($message)) { stringPrint("Change: ".implode(", ", $message)); }
if (count($message)) { stringPrint("Changed: ".implode(", ", $message)); }
}
$update = ProgressBar::next(1, substr($pathname,0,80));
if (floor($j/100) == ($j/100)) {
echo "\n\n-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n";
echo $update;
echo "\n-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n\n";
}
$j++;
echo "\n";
echo ProgressBar::next();
}

BIN
bin/GetFileInfo Executable file

Binary file not shown.

6697
bin/exiftool Executable file

File diff suppressed because it is too large Load Diff

BIN
bin/ffmpeg Executable file

Binary file not shown.

View File

@@ -0,0 +1,378 @@
#------------------------------------------------------------------------------
# File: RandomAccess.pm
#
# Description: Buffer to support random access reading of sequential file
#
# Revisions: 02/11/2004 - P. Harvey Created
# 02/20/2004 - P. Harvey Added flag to disable SeekTest in new()
# 11/18/2004 - P. Harvey Fixed bug with seek relative to end of file
# 01/02/2005 - P. Harvey Added DEBUG code
# 01/09/2006 - P. Harvey Fixed bug in ReadLine() when using
# multi-character EOL sequences
# 02/20/2006 - P. Harvey Fixed bug where seek past end of file could
# generate "substr outside string" warning
# 06/10/2006 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
# 11/23/2006 - P. Harvey Limit reads to < 0x80000000 bytes
# 11/26/2008 - P. Harvey Fixed bug in ReadLine when reading from a
# scalar with a multi-character newline
# 01/24/2009 - PH Protect against reading too much at once
#
# Notes: Calls the normal file i/o routines unless SeekTest() fails, in
# which case the file is buffered in memory to allow random access.
# SeekTest() is called automatically when the object is created
# unless specified.
#
# May also be used for string i/o (just pass a scalar reference)
#
# Legal: Copyright (c) 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#------------------------------------------------------------------------------
package File::RandomAccess;
use strict;
require 5.002;
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = '1.10';
@ISA = qw(Exporter);
sub Read($$$);
# constants
my $CHUNK_SIZE = 8192; # size of chunks to read from file (must be power of 2)
my $SLURP_CHUNKS = 16; # read this many chunks at a time when slurping
#------------------------------------------------------------------------------
# Create new RandomAccess object
# Inputs: 0) reference to RandomAccess object or RandomAccess class name
# 1) file reference or scalar reference
# 2) flag set if file is already random access (disables automatic SeekTest)
sub new($$;$)
{
my ($that, $filePt, $isRandom) = @_;
my $class = ref($that) || $that;
my $self;
if (ref $filePt eq 'SCALAR') {
# string i/o
$self = {
BUFF_PT => $filePt,
POS => 0,
LEN => length($$filePt),
TESTED => -1,
};
bless $self, $class;
} else {
# file i/o
my $buff = '';
$self = {
FILE_PT => $filePt, # file pointer
BUFF_PT => \$buff, # reference to file data
POS => 0, # current position in file
LEN => 0, # data length
TESTED => 0, # 0=untested, 1=passed, -1=failed (requires buffering)
};
bless $self, $class;
$self->SeekTest() unless $isRandom;
}
return $self;
}
#------------------------------------------------------------------------------
# Enable DEBUG code
# Inputs: 0) reference to RandomAccess object
sub Debug($)
{
my $self = shift;
$self->{DEBUG} = { };
}
#------------------------------------------------------------------------------
# Perform seek test and turn on buffering if necessary
# Inputs: 0) reference to RandomAccess object
# Returns: 1 if seek test passed (ie. no buffering required)
# Notes: Must be done before any other i/o
sub SeekTest($)
{
my $self = shift;
unless ($self->{TESTED}) {
my $fp = $self->{FILE_PT};
if (seek($fp, 1, 1) and seek($fp, -1, 1)) {
$self->{TESTED} = 1; # test passed
} else {
$self->{TESTED} = -1; # test failed (requires buffering)
}
}
return $self->{TESTED} == 1 ? 1 : 0;
}
#------------------------------------------------------------------------------
# Get current position in file
# Inputs: 0) reference to RandomAccess object
# Returns: current position in file
sub Tell($)
{
my $self = shift;
my $rtnVal;
if ($self->{TESTED} < 0) {
$rtnVal = $self->{POS};
} else {
$rtnVal = tell($self->{FILE_PT});
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Seek to position in file
# Inputs: 0) reference to RandomAccess object
# 1) position, 2) whence (0 or undef=from start, 1=from cur pos, 2=from end)
# Returns: 1 on success
# Notes: When buffered, this doesn't quite behave like seek() since it will return
# success even if you seek outside the limits of the file. However if you
# do this, you will get an error on your next Read().
sub Seek($$;$)
{
my ($self, $num, $whence) = @_;
$whence = 0 unless defined $whence;
my $rtnVal;
if ($self->{TESTED} < 0) {
my $newPos;
if ($whence == 0) {
$newPos = $num; # from start of file
} elsif ($whence == 1) {
$newPos = $num + $self->{POS}; # relative to current position
} else {
$self->Slurp(); # read whole file into buffer
$newPos = $num + $self->{LEN}; # relative to end of file
}
if ($newPos >= 0) {
$self->{POS} = $newPos;
$rtnVal = 1;
}
} else {
$rtnVal = seek($self->{FILE_PT}, $num, $whence);
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Read from the file
# Inputs: 0) reference to RandomAccess object, 1) buffer, 2) bytes to read
# Returns: Number of bytes read
sub Read($$$)
{
my $self = shift;
my $len = $_[1];
my $rtnVal;
# protect against reading too much at once
# (also from dying with a "Negative length" error)
if ($len & 0xf8000000) {
return 0 if $len < 0;
# read in smaller blocks because Windows attempts to pre-allocate
# memory for the full size, which can lead to an out-of-memory error
my $maxLen = 0x4000000; # (MUST be less than bitmask in "if" above)
my $num = Read($self, $_[0], $maxLen);
return $num if $num < $maxLen;
for (;;) {
$len -= $maxLen;
last if $len <= 0;
my $l = $len < $maxLen ? $len : $maxLen;
my $buff;
my $n = Read($self, $buff, $l);
last unless $n;
$_[0] .= $buff;
$num += $n;
last if $n < $l;
}
return $num;
}
# read through our buffer if necessary
if ($self->{TESTED} < 0) {
my $buff;
my $newPos = $self->{POS} + $len;
# number of bytes to read from file
my $num = $newPos - $self->{LEN};
if ($num > 0 and $self->{FILE_PT}) {
# read data from file in multiples of $CHUNK_SIZE
$num = (($num - 1) | ($CHUNK_SIZE - 1)) + 1;
$num = read($self->{FILE_PT}, $buff, $num);
if ($num) {
${$self->{BUFF_PT}} .= $buff;
$self->{LEN} += $num;
}
}
# number of bytes left in data buffer
$num = $self->{LEN} - $self->{POS};
if ($len <= $num) {
$rtnVal = $len;
} elsif ($num <= 0) {
$_[0] = '';
return 0;
} else {
$rtnVal = $num;
}
# return data from our buffer
$_[0] = substr(${$self->{BUFF_PT}}, $self->{POS}, $rtnVal);
$self->{POS} += $rtnVal;
} else {
# read directly from file
$_[0] = '' unless defined $_[0];
$rtnVal = read($self->{FILE_PT}, $_[0], $len) || 0;
}
if ($self->{DEBUG}) {
my $pos = $self->Tell() - $rtnVal;
unless ($self->{DEBUG}->{$pos} and $self->{DEBUG}->{$pos} > $rtnVal) {
$self->{DEBUG}->{$pos} = $rtnVal;
}
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Read a line from file (end of line is $/)
# Inputs: 0) reference to RandomAccess object, 1) buffer
# Returns: Number of bytes read
sub ReadLine($$)
{
my $self = shift;
my $rtnVal;
my $fp = $self->{FILE_PT};
if ($self->{TESTED} < 0) {
my ($num, $buff);
my $pos = $self->{POS};
if ($fp) {
# make sure we have some data after the current position
while ($self->{LEN} <= $pos) {
$num = read($fp, $buff, $CHUNK_SIZE);
return 0 unless $num;
${$self->{BUFF_PT}} .= $buff;
$self->{LEN} += $num;
}
# scan and read until we find the EOL (or hit EOF)
for (;;) {
$pos = index(${$self->{BUFF_PT}}, $/, $pos);
if ($pos >= 0) {
$pos += length($/);
last;
}
$pos = $self->{LEN}; # have scanned to end of buffer
$num = read($fp, $buff, $CHUNK_SIZE) or last;
${$self->{BUFF_PT}} .= $buff;
$self->{LEN} += $num;
}
} else {
# string i/o
$pos = index(${$self->{BUFF_PT}}, $/, $pos);
if ($pos < 0) {
$pos = $self->{LEN};
$self->{POS} = $pos if $self->{POS} > $pos;
} else {
$pos += length($/);
}
}
# read the line from our buffer
$rtnVal = $pos - $self->{POS};
$_[0] = substr(${$self->{BUFF_PT}}, $self->{POS}, $rtnVal);
$self->{POS} = $pos;
} else {
$_[0] = <$fp>;
if (defined $_[0]) {
$rtnVal = length($_[0]);
} else {
$rtnVal = 0;
}
}
if ($self->{DEBUG}) {
my $pos = $self->Tell() - $rtnVal;
unless ($self->{DEBUG}->{$pos} and $self->{DEBUG}->{$pos} > $rtnVal) {
$self->{DEBUG}->{$pos} = $rtnVal;
}
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Read whole file into buffer (without changing read pointer)
# Inputs: 0) reference to RandomAccess object
sub Slurp($)
{
my $self = shift;
my $fp = $self->{FILE_PT} || return;
# read whole file into buffer (in large chunks)
my ($buff, $num);
while (($num = read($fp, $buff, $CHUNK_SIZE * $SLURP_CHUNKS)) != 0) {
${$self->{BUFF_PT}} .= $buff;
$self->{LEN} += $num;
}
}
#------------------------------------------------------------------------------
# set binary mode
# Inputs: 0) reference to RandomAccess object
sub BinMode($)
{
my $self = shift;
binmode($self->{FILE_PT}) if $self->{FILE_PT};
}
#------------------------------------------------------------------------------
# close the file and free the buffer
# Inputs: 0) reference to RandomAccess object
sub Close($)
{
my $self = shift;
if ($self->{DEBUG}) {
local $_;
if ($self->Seek(0,2)) {
$self->{DEBUG}->{$self->Tell()} = 0; # set EOF marker
my $last;
my $tot = 0;
my $bad = 0;
foreach (sort { $a <=> $b } keys %{$self->{DEBUG}}) {
my $pos = $_;
my $len = $self->{DEBUG}->{$_};
if (defined $last and $last < $pos) {
my $bytes = $pos - $last;
$tot += $bytes;
$self->Seek($last);
my $buff;
$self->Read($buff, $bytes);
my $warn = '';
if ($buff =~ /[^\0]/) {
$bad += ($pos - $last);
$warn = ' - NON-ZERO!';
}
printf "0x%.8x - 0x%.8x (%d bytes)$warn\n", $last, $pos, $bytes;
}
my $cur = $pos + $len;
$last = $cur unless defined $last and $last > $cur;
}
print "$tot bytes missed";
$bad and print ", $bad non-zero!";
print "\n";
} else {
warn "File::RandomAccess DEBUG not working (file already closed?)\n";
}
delete $self->{DEBUG};
}
# close the file
if ($self->{FILE_PT}) {
close($self->{FILE_PT});
delete $self->{FILE_PT};
}
# reset the buffer
my $emptyBuff = '';
$self->{BUFF_PT} = \$emptyBuff;
$self->{LEN} = 0;
$self->{POS} = 0;
}
#------------------------------------------------------------------------------
1; # end

View File

@@ -0,0 +1,231 @@
#------------------------------------------------------------------------------
# File: RandomAccess.pod -- Documentation for File::RandomAccess
#
# Description: Buffer to support random access reading of sequential file
#
# Legal: Copyright (c) 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#------------------------------------------------------------------------------
=head1 NAME
File::RandomAccess - Random access reads of sequential file or scalar
=head1 SYNOPSIS
use File::RandomAccess;
$raf = new File::RandomAccess(\*FILE, $disableSeekTest);
$raf = new File::RandomAccess(\$data);
$err = $raf->Seek($pos);
$num = $raf->Read($buff, $bytes);
=head1 DESCRIPTION
Allows random access to sequential file by buffering the file if necessary.
Also allows access to data in memory to be accessed as if it were a file.
=head1 METHODS
=over 4
=item B<new>
Creates a new RandomAccess object given a file reference or
reference to data in memory.
# Read from open file or pipe
$raf = new File::RandomAccess(\*FILE);
# Read from data in memory
$raf = new File::RandomAccess(\$data);
=over 4
=item Inputs:
0) Reference to RandomAccess object or RandomAccess class name.
1) File reference or scalar reference.
2) Flag set if file is already random access (disables automatic SeekTest).
=item Returns:
Reference to RandomAccess object.
=back
=item B<SeekTest>
Performs test seek() on file to determine if buffering is necessary. If
the seek() fails, then the file is buffered to allow random access.
B<SeekTest>() is automatically called from B<new> unless specified.
$result = $raf->SeekTest();
=over 4
=item Inputs:
0) Reference to RandomAccess object.
=item Returns:
1 if seek test passed (ie. no buffering required).
=item Notes:
Must be called before any other i/o.
=back
=item B<Tell>
Get current position in file
$pos = $raf->Tell();
=over 4
=item Inputs:
0) Reference to RandomAccess object.
=item Returns:
Current position in file
=back
=item B<Seek>
Seek to specified position in file. When buffered, this doesn't quite
behave like seek() since it returns success even if you seek outside the
limits of the file.
$success = $raf->Seek($pos, 0);
=over 4
=item Inputs:
0) Reference to RandomAccess object.
1) Position.
2) Whence (0=from start, 1=from cur pos, 2=from end).
=item Returns:
1 on success, 0 otherwise
=back
=item B<Read>
Read data from the file.
$num = $raf->Read($buff, 1024);
=over 4
=item Inputs:
0) Reference to RandomAccess object.
1) Buffer.
2) Number of bytes to read.
=item Returns:
Number of bytes actually read.
=back
=item B<ReadLine>
Read a line from file (end of line is $/).
=over 4
=item Inputs:
0) Reference to RandomAccess object.
1) Buffer.
=item Returns:
Number of bytes read.
=back
=item B<Slurp>
Read whole file into buffer, without changing read pointer.
=over 4
=item Inputs:
0) Reference to RandomAccess object.
=item Returns:
Nothing.
=back
=item B<BinMode>
Set binary mode for file.
=over 4
=item Inputs:
0) Reference to RandomAccess object.
=item Returns:
Nothing.
=back
=item B<Close>
Close the file and free the buffer.
=over 4
=item Inputs:
0) Reference to RandomAccess object.
=item Returns:
Nothing.
=back
=back
=head1 AUTHOR
Copyright 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
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(3pm)|Image::ExifTool>
=cut
# end

8210
bin/lib/Image/ExifTool.pm Normal file

File diff suppressed because it is too large Load Diff

2624
bin/lib/Image/ExifTool.pod Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,501 @@
#------------------------------------------------------------------------------
# File: AES.pm
#
# Description: AES encryption with cipher-block chaining
#
# Revisions: 2010/10/14 - P. Harvey Created
#
# References: 1) http://www.hoozi.com/Articles/AESEncryption.htm
# 2) http://www.csrc.nist.gov/publications/fips/fips197/fips-197.pdf
# 3) http://www.faqs.org/rfcs/rfc3602.html
#------------------------------------------------------------------------------
package Image::ExifTool::AES;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
require Exporter;
$VERSION = '1.01';
@ISA = qw(Exporter);
@EXPORT_OK = qw(Crypt);
my $seeded; # flag set if we already seeded random number generator
my $nr; # number of rounds in AES cipher
my @cbc; # cipher-block chaining bytes
# arrays (all unsigned character) to hold intermediate results during encryption
my @state = ([],[],[],[]); # the 2-dimensional state array
my @RoundKey; # round keys
my @sbox = (
0x63, 0x7c, 0x77, 0x7b, 0xf2, 0x6b, 0x6f, 0xc5, 0x30, 0x01, 0x67, 0x2b, 0xfe, 0xd7, 0xab, 0x76,
0xca, 0x82, 0xc9, 0x7d, 0xfa, 0x59, 0x47, 0xf0, 0xad, 0xd4, 0xa2, 0xaf, 0x9c, 0xa4, 0x72, 0xc0,
0xb7, 0xfd, 0x93, 0x26, 0x36, 0x3f, 0xf7, 0xcc, 0x34, 0xa5, 0xe5, 0xf1, 0x71, 0xd8, 0x31, 0x15,
0x04, 0xc7, 0x23, 0xc3, 0x18, 0x96, 0x05, 0x9a, 0x07, 0x12, 0x80, 0xe2, 0xeb, 0x27, 0xb2, 0x75,
0x09, 0x83, 0x2c, 0x1a, 0x1b, 0x6e, 0x5a, 0xa0, 0x52, 0x3b, 0xd6, 0xb3, 0x29, 0xe3, 0x2f, 0x84,
0x53, 0xd1, 0x00, 0xed, 0x20, 0xfc, 0xb1, 0x5b, 0x6a, 0xcb, 0xbe, 0x39, 0x4a, 0x4c, 0x58, 0xcf,
0xd0, 0xef, 0xaa, 0xfb, 0x43, 0x4d, 0x33, 0x85, 0x45, 0xf9, 0x02, 0x7f, 0x50, 0x3c, 0x9f, 0xa8,
0x51, 0xa3, 0x40, 0x8f, 0x92, 0x9d, 0x38, 0xf5, 0xbc, 0xb6, 0xda, 0x21, 0x10, 0xff, 0xf3, 0xd2,
0xcd, 0x0c, 0x13, 0xec, 0x5f, 0x97, 0x44, 0x17, 0xc4, 0xa7, 0x7e, 0x3d, 0x64, 0x5d, 0x19, 0x73,
0x60, 0x81, 0x4f, 0xdc, 0x22, 0x2a, 0x90, 0x88, 0x46, 0xee, 0xb8, 0x14, 0xde, 0x5e, 0x0b, 0xdb,
0xe0, 0x32, 0x3a, 0x0a, 0x49, 0x06, 0x24, 0x5c, 0xc2, 0xd3, 0xac, 0x62, 0x91, 0x95, 0xe4, 0x79,
0xe7, 0xc8, 0x37, 0x6d, 0x8d, 0xd5, 0x4e, 0xa9, 0x6c, 0x56, 0xf4, 0xea, 0x65, 0x7a, 0xae, 0x08,
0xba, 0x78, 0x25, 0x2e, 0x1c, 0xa6, 0xb4, 0xc6, 0xe8, 0xdd, 0x74, 0x1f, 0x4b, 0xbd, 0x8b, 0x8a,
0x70, 0x3e, 0xb5, 0x66, 0x48, 0x03, 0xf6, 0x0e, 0x61, 0x35, 0x57, 0xb9, 0x86, 0xc1, 0x1d, 0x9e,
0xe1, 0xf8, 0x98, 0x11, 0x69, 0xd9, 0x8e, 0x94, 0x9b, 0x1e, 0x87, 0xe9, 0xce, 0x55, 0x28, 0xdf,
0x8c, 0xa1, 0x89, 0x0d, 0xbf, 0xe6, 0x42, 0x68, 0x41, 0x99, 0x2d, 0x0f, 0xb0, 0x54, 0xbb, 0x16,
);
# reverse sbox
my @rsbox = (
0x52, 0x09, 0x6a, 0xd5, 0x30, 0x36, 0xa5, 0x38, 0xbf, 0x40, 0xa3, 0x9e, 0x81, 0xf3, 0xd7, 0xfb,
0x7c, 0xe3, 0x39, 0x82, 0x9b, 0x2f, 0xff, 0x87, 0x34, 0x8e, 0x43, 0x44, 0xc4, 0xde, 0xe9, 0xcb,
0x54, 0x7b, 0x94, 0x32, 0xa6, 0xc2, 0x23, 0x3d, 0xee, 0x4c, 0x95, 0x0b, 0x42, 0xfa, 0xc3, 0x4e,
0x08, 0x2e, 0xa1, 0x66, 0x28, 0xd9, 0x24, 0xb2, 0x76, 0x5b, 0xa2, 0x49, 0x6d, 0x8b, 0xd1, 0x25,
0x72, 0xf8, 0xf6, 0x64, 0x86, 0x68, 0x98, 0x16, 0xd4, 0xa4, 0x5c, 0xcc, 0x5d, 0x65, 0xb6, 0x92,
0x6c, 0x70, 0x48, 0x50, 0xfd, 0xed, 0xb9, 0xda, 0x5e, 0x15, 0x46, 0x57, 0xa7, 0x8d, 0x9d, 0x84,
0x90, 0xd8, 0xab, 0x00, 0x8c, 0xbc, 0xd3, 0x0a, 0xf7, 0xe4, 0x58, 0x05, 0xb8, 0xb3, 0x45, 0x06,
0xd0, 0x2c, 0x1e, 0x8f, 0xca, 0x3f, 0x0f, 0x02, 0xc1, 0xaf, 0xbd, 0x03, 0x01, 0x13, 0x8a, 0x6b,
0x3a, 0x91, 0x11, 0x41, 0x4f, 0x67, 0xdc, 0xea, 0x97, 0xf2, 0xcf, 0xce, 0xf0, 0xb4, 0xe6, 0x73,
0x96, 0xac, 0x74, 0x22, 0xe7, 0xad, 0x35, 0x85, 0xe2, 0xf9, 0x37, 0xe8, 0x1c, 0x75, 0xdf, 0x6e,
0x47, 0xf1, 0x1a, 0x71, 0x1d, 0x29, 0xc5, 0x89, 0x6f, 0xb7, 0x62, 0x0e, 0xaa, 0x18, 0xbe, 0x1b,
0xfc, 0x56, 0x3e, 0x4b, 0xc6, 0xd2, 0x79, 0x20, 0x9a, 0xdb, 0xc0, 0xfe, 0x78, 0xcd, 0x5a, 0xf4,
0x1f, 0xdd, 0xa8, 0x33, 0x88, 0x07, 0xc7, 0x31, 0xb1, 0x12, 0x10, 0x59, 0x27, 0x80, 0xec, 0x5f,
0x60, 0x51, 0x7f, 0xa9, 0x19, 0xb5, 0x4a, 0x0d, 0x2d, 0xe5, 0x7a, 0x9f, 0x93, 0xc9, 0x9c, 0xef,
0xa0, 0xe0, 0x3b, 0x4d, 0xae, 0x2a, 0xf5, 0xb0, 0xc8, 0xeb, 0xbb, 0x3c, 0x83, 0x53, 0x99, 0x61,
0x17, 0x2b, 0x04, 0x7e, 0xba, 0x77, 0xd6, 0x26, 0xe1, 0x69, 0x14, 0x63, 0x55, 0x21, 0x0c, 0x7d,
);
# the round constant word array, $rcon[i], contains the values given by
# x to the power (i-1) being powers of x (x is denoted as {02}) in the field GF(2^8)
# Note that i starts at 1, not 0).
my @rcon = (
0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a,
0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39,
0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a,
0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8,
0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef,
0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc,
0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b,
0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3,
0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94,
0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20,
0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35,
0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f,
0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04,
0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63,
0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd,
0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb,
);
#------------------------------------------------------------------------------
# This function produces 4*($nr+1) round keys.
# The round keys are used in each round to encrypt the states.
# Inputs: 0) key string (must be 16, 24 or 32 bytes long)
sub KeyExpansion($)
{
my $key = shift;
my @key = unpack 'C*', $key; # convert the key into a byte array
my $nk = int(length($key) / 4); # number of 32-bit words in the key
$nr = $nk + 6; # number of rounds
# temporary variables (all unsigned characters)
my ($i,@temp);
# The first round key is the key itself.
for ($i=0; $i<$nk; ++$i) {
@RoundKey[$i*4..$i*4+3] = @key[$i*4..$i*4+3];
}
# All other round keys are found from the previous round keys.
while ($i < (4 * ($nr+1))) {
@temp[0..3] = @RoundKey[($i-1)*4..($i-1)*4+3];
if ($i % $nk == 0) {
# rotate the 4 bytes in a word to the left once
# [a0,a1,a2,a3] becomes [a1,a2,a3,a0]
@temp[0..3] = @temp[1,2,3,0];
# take a four-byte input word and apply the S-box
# to each of the four bytes to produce an output word.
@temp[0..3] = @sbox[@temp[0..3]];
$temp[0] = $temp[0] ^ $rcon[$i/$nk];
} elsif ($nk > 6 && $i % $nk == 4) {
@temp[0..3] = @sbox[@temp[0..3]];
}
$RoundKey[$i*4+0] = $RoundKey[($i-$nk)*4+0] ^ $temp[0];
$RoundKey[$i*4+1] = $RoundKey[($i-$nk)*4+1] ^ $temp[1];
$RoundKey[$i*4+2] = $RoundKey[($i-$nk)*4+2] ^ $temp[2];
$RoundKey[$i*4+3] = $RoundKey[($i-$nk)*4+3] ^ $temp[3];
++$i;
}
}
#------------------------------------------------------------------------------
# This function adds the round key to state.
# The round key is added to the state by an XOR function.
sub AddRoundKey($)
{
my $round = shift;
my ($i,$j);
for ($i=0; $i<4; ++$i) {
my $k = $round*16 + $i*4;
for ($j=0; $j<4; ++$j) {
$state[$j][$i] ^= $RoundKey[$k + $j];
}
}
}
#------------------------------------------------------------------------------
# Substitute the values in the state matrix with values in an S-box
sub SubBytes()
{
my $i;
for ($i=0; $i<4; ++$i) {
@{$state[$i]}[0..3] = @sbox[@{$state[$i]}[0..3]];
}
}
sub InvSubBytes()
{
my $i;
for ($i=0; $i<4; ++$i) {
@{$state[$i]}[0..3] = @rsbox[@{$state[$i]}[0..3]];
}
}
#------------------------------------------------------------------------------
# Shift the rows in the state to the left.
# Each row is shifted with different offset.
# Offset = Row number. So the first row is not shifted.
sub ShiftRows()
{
# rotate first row 1 columns to left
@{$state[1]}[0,1,2,3] = @{$state[1]}[1,2,3,0];
# rotate second row 2 columns to left
@{$state[2]}[0,1,2,3] = @{$state[2]}[2,3,0,1];
# rotate third row 3 columns to left
@{$state[3]}[0,1,2,3] = @{$state[3]}[3,0,1,2];
}
sub InvShiftRows()
{
# rotate first row 1 columns to right
@{$state[1]}[0,1,2,3] = @{$state[1]}[3,0,1,2];
# rotate second row 2 columns to right
@{$state[2]}[0,1,2,3] = @{$state[2]}[2,3,0,1];
# rotate third row 3 columns to right
@{$state[3]}[0,1,2,3] = @{$state[3]}[1,2,3,0];
}
#------------------------------------------------------------------------------
# Find the product of {02} and the argument to xtime modulo 0x1b
# Note: returns an integer which may need to be trimmed to 8 bits
sub xtime($)
{
return ($_[0]<<1) ^ ((($_[0]>>7) & 1) * 0x1b);
}
#------------------------------------------------------------------------------
# Multiply numbers in the field GF(2^8)
sub Mult($$)
{
my ($x, $y) = @_;
return (($y & 1) * $x) ^
(($y>>1 & 1) * xtime($x)) ^
(($y>>2 & 1) * xtime(xtime($x))) ^
(($y>>3 & 1) * xtime(xtime(xtime($x)))) ^
(($y>>4 & 1) * xtime(xtime(xtime(xtime($x)))));
}
#------------------------------------------------------------------------------
# Mix the columns of the state matrix
sub MixColumns()
{
my ($i,$t0,$t1,$t2);
for ($i=0; $i<4; ++$i) {
$t0 = $state[0][$i];
$t2 = $state[0][$i] ^ $state[1][$i] ^ $state[2][$i] ^ $state[3][$i];
$t1 = $state[0][$i] ^ $state[1][$i] ; $t1 = xtime($t1) & 0xff; $state[0][$i] ^= $t1 ^ $t2 ;
$t1 = $state[1][$i] ^ $state[2][$i] ; $t1 = xtime($t1) & 0xff; $state[1][$i] ^= $t1 ^ $t2 ;
$t1 = $state[2][$i] ^ $state[3][$i] ; $t1 = xtime($t1) & 0xff; $state[2][$i] ^= $t1 ^ $t2 ;
$t1 = $state[3][$i] ^ $t0 ; $t1 = xtime($t1) & 0xff; $state[3][$i] ^= $t1 ^ $t2 ;
}
}
sub InvMixColumns()
{
my $i;
for ($i=0; $i<4; ++$i) {
my $a = $state[0][$i];
my $b = $state[1][$i];
my $c = $state[2][$i];
my $d = $state[3][$i];
$state[0][$i] = (Mult($a,0x0e) ^ Mult($b,0x0b) ^ Mult($c,0x0d) ^ Mult($d,0x09)) & 0xff;
$state[1][$i] = (Mult($a,0x09) ^ Mult($b,0x0e) ^ Mult($c,0x0b) ^ Mult($d,0x0d)) & 0xff;
$state[2][$i] = (Mult($a,0x0d) ^ Mult($b,0x09) ^ Mult($c,0x0e) ^ Mult($d,0x0b)) & 0xff;
$state[3][$i] = (Mult($a,0x0b) ^ Mult($b,0x0d) ^ Mult($c,0x09) ^ Mult($d,0x0e)) & 0xff;
}
}
#------------------------------------------------------------------------------
# Encrypt (Cipher) or decrypt (InvCipher) a block of data with CBC
# Inputs: 0) string to cipher (must be 16 bytes long)
# Returns: cipher'd string
sub Cipher($)
{
my @in = unpack 'C*', $_[0]; # unpack input plaintext
my ($i, $j, $round);
# copy the input PlainText to state array and apply the CBC
for ($i=0; $i<4; ++$i) {
for ($j=0; $j<4; ++$j) {
my $k = $i*4 + $j;
$state[$j][$i] = $in[$k] ^ $cbc[$k];
}
}
# add the First round key to the state before starting the rounds
AddRoundKey(0);
# there will be $nr rounds; the first $nr-1 rounds are identical
for ($round=1; ; ++$round) {
SubBytes();
ShiftRows();
if ($round < $nr) {
MixColumns();
AddRoundKey($round);
} else {
# MixColumns() is not used in the last round
AddRoundKey($nr);
last;
}
}
# the encryption process is over
# copy the state array to output array (and save for CBC)
for ($i=0; $i<4; ++$i) {
for ($j=0; $j<4; ++$j) {
$cbc[$i*4+$j] = $state[$j][$i];
}
}
return pack 'C*', @cbc; # return packed ciphertext
}
sub InvCipher($)
{
my @in = unpack 'C*', $_[0]; # unpack input ciphertext
my (@out, $i, $j, $round);
# copy the input CipherText to state array
for ($i=0; $i<4; ++$i) {
for ($j=0; $j<4; ++$j) {
$state[$j][$i] = $in[$i*4 + $j];
}
}
# add the First round key to the state before starting the rounds
AddRoundKey($nr);
# there will be $nr rounds; the first $nr-1 rounds are identical
for ($round=$nr-1; ; --$round) {
InvShiftRows();
InvSubBytes();
AddRoundKey($round);
# InvMixColumns() is not used in the last round
last if $round <= 0;
InvMixColumns();
}
# copy the state array to output array and reverse the CBC
for ($i=0; $i<4; ++$i) {
for ($j=0; $j<4; ++$j) {
my $k = $i*4 + $j;
$out[$k] = $state[$j][$i] ^ $cbc[$k];
}
}
@cbc = @in; # update CBC for next block
return pack 'C*', @out; # return packed plaintext
}
#------------------------------------------------------------------------------
# Encrypt/Decrypt using AES-CBC algorithm (with fixed 16-byte blocks)
# Inputs: 0) data reference (with leading 16-byte initialization vector when decrypting)
# 1) encryption key (16, 24 or 32 bytes for AES-128, AES-192 or AES-256)
# 2) encrypt flag (false for decryption, true with length 16 bytes to
# encrypt using this as the CBC IV, or true with other length to
# encrypt with a randomly-generated IV)
# 3) flag to disable padding
# Returns: error string, or undef on success
# Notes: encrypts/decrypts data in place (encrypted data returned with leading IV)
sub Crypt($$;$$)
{
my ($dataPt, $key, $encrypt, $noPad) = @_;
# validate key length
my $keyLen = length $key;
unless ($keyLen == 16 or $keyLen == 24 or $keyLen == 32) {
return "Invalid AES key length ($keyLen)";
}
my $partLen = length($$dataPt) % 16;
my ($pos, $i);
if ($encrypt) {
if (length($encrypt) == 16) {
@cbc = unpack 'C*', $encrypt;
} else {
# generate a random 16-byte CBC initialization vector
unless ($seeded) {
srand(time() & ($$ + ($$<<15)));
$seeded = 1;
}
for ($i=0; $i<16; ++$i) {
$cbc[$i] = int(rand(256));
}
$encrypt = pack 'C*', @cbc;
}
$$dataPt = $encrypt . $$dataPt; # add IV to the start of the data
# add required padding so we can recover the
# original string length after decryption
# (padding bytes have value set to padding length)
my $padLen = 16 - $partLen;
$$dataPt .= (chr($padLen)) x $padLen unless $padLen == 16 and $noPad;
$pos = 16; # start encrypting at byte 16 (after the IV)
} elsif ($partLen) {
return 'Invalid AES ciphertext length';
} elsif (length $$dataPt >= 32) {
# take the CBC initialization vector from the start of the data
@cbc = unpack 'C16', $$dataPt;
$$dataPt = substr($$dataPt, 16);
$pos = 0; # start decrypting from byte 0 (now that IV is removed)
} else {
$$dataPt = ''; # empty text
return undef;
}
# the KeyExpansion routine must be called before encryption
KeyExpansion($key);
# loop through the data and convert in blocks
my $dataLen = length $$dataPt;
my $last = $dataLen - 16;
my $func = $encrypt ? \&Cipher : \&InvCipher;
while ($pos <= $last) {
# cipher this block
substr($$dataPt, $pos, 16) = &$func(substr($$dataPt, $pos, 16));
$pos += 16;
}
unless ($encrypt or $noPad) {
# remove padding if necessary (padding byte value gives length of padding)
my $padLen = ord(substr($$dataPt, -1, 1));
return 'AES decryption error (invalid pad byte)' if $padLen > 16;
$$dataPt = substr($$dataPt, 0, $dataLen - $padLen);
}
return undef;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::AES - AES encryption with cipher-block chaining
=head1 SYNOPSIS
use Image::ExifTool::AES qw(Crypt);
$err = Crypt(\$plaintext, $key, 1); # encryption
$err = Crypt(\$ciphertext, $key); # decryption
=head1 DESCRIPTION
This module contains an implementation of the AES encryption/decryption
algorithms with cipher-block chaining (CBC) and RFC 2898 PKCS #5 padding.
This is the AESV2 and AESV3 encryption mode used in PDF documents.
=head1 EXPORTS
Exports nothing by default, but L</Crypt> may be exported.
=head1 METHODS
=head2 Crypt
Implement AES encryption/decryption with cipher-block chaining.
=over 4
=item Inputs:
0) Scalar reference for data to encrypt/decrypt.
1) Encryption key string (must have length 16, 24 or 32).
2) [optional] Encrypt flag (false to decrypt).
3) [optional] Flag to avoid removing padding after decrypting, or to avoid
adding 16 bytes of padding before encrypting when data length is already a
multiple of 16 bytes.
=item Returns:
On success, the return value is undefined and the data is encrypted or
decrypted as specified. Otherwise returns an error string and the data is
left in an indeterminate state.
=item Notes:
The length of the encryption key dictates the AES mode, with lengths of 16,
24 and 32 bytes resulting in AES-128, AES-192 and AES-256.
When encrypting, the input data may be any length and will be padded to an
even 16-byte block size using the specified padding technique. If the
encrypt flag has length 16, it is used as the initialization vector for
the cipher-block chaining, otherwise a random IV is generated. Upon
successful return the data will be encrypted, with the first 16 bytes of
the data being the CBC IV.
When decrypting, the input data begins with the 16-byte CBC initialization
vector.
=back
=head1 BUGS
This code is blindingly slow. But in truth, slowing down processing is the
main purpose of encryption, so this really can't be considered a bug.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.hoozi.com/Articles/AESEncryption.htm>
=item L<http://www.csrc.nist.gov/publications/fips/fips197/fips-197.pdf>
=item L<http://www.faqs.org/rfcs/rfc3602.html>
=back
=head1 SEE ALSO
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,281 @@
#------------------------------------------------------------------------------
# File: AFCP.pm
#
# Description: Read/write AFCP trailer
#
# Revisions: 12/26/2005 - P. Harvey Created
#
# References: 1) http://web.archive.org/web/20080828211305/http://www.tocarte.com/media/axs_afcp_spec.pdf
#------------------------------------------------------------------------------
package Image::ExifTool::AFCP;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.08';
sub ProcessAFCP($$);
%Image::ExifTool::AFCP::Main = (
PROCESS_PROC => \&ProcessAFCP,
NOTES => q{
AFCP stands for AXS File Concatenation Protocol, and is a poorly designed
protocol for appending information to the end of files. This can be used as
an auxiliary technique to store IPTC information in images, but is
incompatible with some file formats.
ExifTool will read and write (but not create) AFCP IPTC information in JPEG
and TIFF images.
See
L<http://web.archive.org/web/20080828211305/http://www.tocarte.com/media/axs_afcp_spec.pdf>
for the AFCP specification.
},
IPTC => { SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main' } },
TEXT => 'Text',
Nail => {
Name => 'ThumbnailImage',
Groups => { 2 => 'Preview' },
# (the specification allows for a variable amount of padding before
# the image after a 10-byte header, so look for the JPEG SOI marker,
# otherwise assume a fixed 8 bytes of padding)
RawConv => q{
pos($val) = 10;
my $start = ($val =~ /\xff\xd8\xff/g) ? pos($val) - 3 : 18;
my $img = substr($val, $start);
return $self->ValidateImage(\$img, $tag);
},
},
PrVw => {
Name => 'PreviewImage',
Groups => { 2 => 'Preview' },
RawConv => q{
pos($val) = 10;
my $start = ($val =~ /\xff\xd8\xff/g) ? pos($val) - 3 : 18;
my $img = substr($val, $start);
return $self->ValidateImage(\$img, $tag);
},
},
);
#------------------------------------------------------------------------------
# Read/write AFCP information in a file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# (Set 'ScanForAFCP' member in dirInfo to scan from current position for AFCP)
# Returns: 1 on success, 0 if this file didn't contain AFCP information
# -1 on write error or if the offsets were incorrect on reading
# - updates DataPos to point to actual AFCP start if ScanForAFCP is set
# - updates DirLen to trailer length
# - returns Fixup reference in dirInfo hash when writing
sub ProcessAFCP($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $curPos = $raf->Tell();
my $offset = $$dirInfo{Offset} || 0; # offset from end of file
my $rtnVal = 0;
NoAFCP: for (;;) {
my ($buff, $fix, $dirBuff, $valBuff, $fixup, $vers);
# look for AXS trailer
last unless $raf->Seek(-12-$offset, 2) and
$raf->Read($buff, 12) == 12 and
$buff =~ /^(AXS(!|\*))/;
my $endPos = $raf->Tell();
my $hdr = $1;
SetByteOrder($2 eq '!' ? 'MM' : 'II');
my $startPos = Get32u(\$buff, 4);
if ($raf->Seek($startPos, 0) and $raf->Read($buff, 12) == 12 and $buff =~ /^$hdr/) {
$fix = 0;
} else {
$rtnVal = -1;
# look for start of AXS trailer if 'ScanForAFCP'
last unless $$dirInfo{ScanForAFCP} and $raf->Seek($curPos, 0);
my $actualPos = $curPos;
# first look for header right at current position
for (;;) {
last if $raf->Read($buff, 12) == 12 and $buff =~ /^$hdr/;
last NoAFCP if $actualPos != $curPos;
# scan for AXS header (could be after preview image)
for (;;) {
my $buf2;
$raf->Read($buf2, 65536) or last NoAFCP;
$buff .= $buf2;
if ($buff =~ /$hdr/g) {
$actualPos += pos($buff) - length($hdr);
last; # ok, now go back and re-read header
}
$buf2 = substr($buf2, -3); # only need last 3 bytes for next test
$actualPos += length($buff) - length($buf2);
$buff = $buf2;
}
last unless $raf->Seek($actualPos, 0); # seek to start of AFCP
}
# calculate shift for fixing AFCP offsets
$fix = $actualPos - $startPos;
}
# set variables returned in dirInfo hash
$$dirInfo{DataPos} = $startPos + $fix; # actual start position
$$dirInfo{DirLen} = $endPos - ($startPos + $fix);
$rtnVal = 1;
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
my $outfile = $$dirInfo{OutFile};
if ($outfile) {
# allow all AFCP information to be deleted
if ($$et{DEL_GROUP}{AFCP}) {
$verbose and print $out " Deleting AFCP\n";
++$$et{CHANGED};
last;
}
$dirBuff = $valBuff = '';
require Image::ExifTool::Fixup;
$fixup = $$dirInfo{Fixup};
$fixup or $fixup = $$dirInfo{Fixup} = new Image::ExifTool::Fixup;
$vers = substr($buff, 4, 2); # get version number
} else {
$et->DumpTrailer($dirInfo) if $verbose or $$et{HTML_DUMP};
}
# read AFCP directory data
my $numEntries = Get16u(\$buff, 6);
my $dir;
unless ($raf->Read($dir, 12 * $numEntries) == 12 * $numEntries) {
$et->Error('Error reading AFCP directory', 1);
last;
}
if ($verbose > 2 and not $outfile) {
my $dat = $buff . $dir;
print $out " AFCP Directory:\n";
$et->VerboseDump(\$dat, Addr => $$dirInfo{DataPos}, Width => 12);
}
$fix and $et->Warn("Adjusted AFCP offsets by $fix", 1);
#
# process AFCP directory
#
my $tagTablePtr = GetTagTable('Image::ExifTool::AFCP::Main');
my ($index, $entry);
for ($index=0; $index<$numEntries; ++$index) {
my $entry = 12 * $index;
my $tag = substr($dir, $entry, 4);
my $size = Get32u(\$dir, $entry + 4);
my $offset = Get32u(\$dir, $entry + 8);
if ($size < 0x80000000 and
$raf->Seek($offset+$fix, 0) and
$raf->Read($buff, $size) == $size)
{
if ($outfile) {
# rewrite this information
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
if ($tagInfo and $$tagInfo{SubDirectory}) {
my %subdirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => $size,
DataPos => $offset + $fix,
Parent => 'AFCP',
);
my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
my $newDir = $et->WriteDirectory(\%subdirInfo, $subTable);
if (defined $newDir) {
$size = length $newDir;
$buff = $newDir;
}
}
$fixup->AddFixup(length($dirBuff) + 8);
$dirBuff .= $tag . Set32u($size) . Set32u(length $valBuff);
$valBuff .= $buff;
} else {
# extract information
$et->HandleTag($tagTablePtr, $tag, $buff,
DataPt => \$buff,
Size => $size,
Index => $index,
DataPos => $offset + $fix,
);
}
} else {
$et->Warn("Bad AFCP directory");
$rtnVal = -1 if $outfile;
last;
}
}
if ($outfile and length($dirBuff)) {
my $outPos = Tell($outfile); # get current outfile position
# apply fixup to directory pointers
my $valPos = $outPos + 12; # start of value data
$fixup->{Shift} += $valPos + length($dirBuff);
$fixup->ApplyFixup(\$dirBuff);
# write the AFCP header, directory, value data and EOF record (with zero checksums)
Write($outfile, $hdr, $vers, Set16u(length($dirBuff)/12), Set32u(0),
$dirBuff, $valBuff, $hdr, Set32u($outPos), Set32u(0)) or $rtnVal = -1;
# complete fixup so the calling routine can apply further shifts
$fixup->AddFixup(length($dirBuff) + length($valBuff) + 4);
$fixup->{Start} += $valPos;
$fixup->{Shift} -= $valPos;
}
last;
}
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::AFCP - Read/write AFCP trailer
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to extract
information from the AFCP trailer. Although the AFCP specification is
compatible with various file formats, ExifTool currently only processes AFCP
in JPEG images.
=head1 NOTES
AFCP is a specification which allows meta information (including IPTC) to be
appended to the end of a file.
It is a poorly designed protocol because (like TIFF) it uses absolute
offsets to specify data locations. This is a huge blunder because it makes
the AFCP information dependent on the file length, so it is easily
invalidated by image editing software which doesn't recognize the AFCP
trailer to fix up these offsets when the file length changes. ExifTool will
attempt to fix these invalid offsets if possible.
Scanning for AFCP information may be time consuming, especially when reading
from a sequential device, since the information is at the end of the file.
In these instances, the ExifTool FastScan option may be used to disable
scanning for AFCP information.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.tocarte.com/media/axs_afcp_spec.pdf>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/AFCP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,289 @@
#------------------------------------------------------------------------------
# File: AIFF.pm
#
# Description: Read AIFF meta information
#
# Revisions: 01/06/2006 - P. Harvey Created
# 09/22/2008 - PH Added DjVu support
#
# References: 1) http://developer.apple.com/documentation/QuickTime/INMAC/SOUND/imsoundmgr.30.htm#pgfId=3190
# 2) http://astronomy.swin.edu.au/~pbourke/dataformats/aiff/
# 3) http://www.mactech.com/articles/mactech/Vol.06/06.01/SANENormalized/
#------------------------------------------------------------------------------
package Image::ExifTool::AIFF;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::ID3;
$VERSION = '1.08';
# information for time/date-based tags (time zero is Jan 1, 1904)
my %timeInfo = (
Groups => { 2 => 'Time' },
ValueConv => 'ConvertUnixTime($val - ((66 * 365 + 17) * 24 * 3600))',
PrintConv => '$self->ConvertDateTime($val)',
);
# AIFF info
%Image::ExifTool::AIFF::Main = (
GROUPS => { 2 => 'Audio' },
NOTES => q{
Tags extracted from Audio Interchange File Format (AIFF) files. See
L<http://www-mmsp.ece.mcgill.ca/Documents/AudioFormats/AIFF/AIFF.html> for
the AIFF specification.
},
# FORM => 'Format',
FVER => {
Name => 'FormatVersion',
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::FormatVers' },
},
COMM => {
Name => 'Common',
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::Common' },
},
COMT => {
Name => 'Comment',
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::Comment' },
},
NAME => {
Name => 'Name',
ValueConv => '$self->Decode($val, "MacRoman")',
},
AUTH => {
Name => 'Author',
Groups => { 2 => 'Author' },
ValueConv => '$self->Decode($val, "MacRoman")',
},
'(c) ' => {
Name => 'Copyright',
Groups => { 2 => 'Author' },
ValueConv => '$self->Decode($val, "MacRoman")',
},
ANNO => {
Name => 'Annotation',
ValueConv => '$self->Decode($val, "MacRoman")',
},
'ID3 ' => {
Name => 'ID3',
SubDirectory => {
TagTable => 'Image::ExifTool::ID3::Main',
ProcessProc => \&Image::ExifTool::ID3::ProcessID3,
},
},
# SSND => 'SoundData',
# MARK => 'Marker',
# INST => 'Instrument',
# MIDI => 'MidiData',
# AESD => 'AudioRecording',
# APPL => 'ApplicationSpecific',
);
%Image::ExifTool::AIFF::Common = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Audio' },
FORMAT => 'int16u',
0 => 'NumChannels',
1 => { Name => 'NumSampleFrames', Format => 'int32u' },
3 => 'SampleSize',
4 => { Name => 'SampleRate', Format => 'extended' }, #3
9 => {
Name => 'CompressionType',
Format => 'string[4]',
PrintConv => {
NONE => 'None',
ACE2 => 'ACE 2-to-1',
ACE8 => 'ACE 8-to-3',
MAC3 => 'MAC 3-to-1',
MAC6 => 'MAC 6-to-1',
sowt => 'Little-endian, no compression',
},
},
11 => { #PH
Name => 'CompressorName',
Format => 'pstring',
ValueConv => '$self->Decode($val, "MacRoman")',
},
);
%Image::ExifTool::AIFF::FormatVers = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
FORMAT => 'int32u',
0 => { Name => 'FormatVersionTime', %timeInfo },
);
%Image::ExifTool::AIFF::Comment = (
PROCESS_PROC => \&Image::ExifTool::AIFF::ProcessComment,
GROUPS => { 2 => 'Audio' },
0 => { Name => 'CommentTime', %timeInfo },
1 => 'MarkerID',
2 => {
Name => 'Comment',
ValueConv => '$self->Decode($val, "MacRoman")',
},
);
%Image::ExifTool::AIFF::Composite = (
Duration => {
Require => {
0 => 'AIFF:SampleRate',
1 => 'AIFF:NumSampleFrames',
},
RawConv => '($val[0] and $val[1]) ? $val[1] / $val[0] : undef',
PrintConv => 'ConvertDuration($val)',
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::AIFF');
#------------------------------------------------------------------------------
# Process AIFF Comment chunk
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
# Returns: 1 on success
sub ProcessComment($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
my $verbose = $et->Options('Verbose');
return 0 unless $dirLen > 2;
my $numComments = unpack('n',$$dataPt);
my $pos = 2;
my $i;
$verbose and $et->VerboseDir('Comment', $numComments);
for ($i=0; $i<$numComments; ++$i) {
last if $pos + 8 > $dirLen;
my ($time, $markerID, $size) = unpack("x${pos}Nnn", $$dataPt);
$et->HandleTag($tagTablePtr, 0, $time);
$et->HandleTag($tagTablePtr, 1, $markerID) if $markerID;
$pos += 8;
last if $pos + $size > $dirLen;
my $val = substr($$dataPt, $pos, $size);
$et->HandleTag($tagTablePtr, 2, $val);
++$size if $size & 0x01; # account for padding byte if necessary
$pos += $size;
}
}
#------------------------------------------------------------------------------
# Extract information from a AIFF file
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid AIFF file
sub ProcessAIFF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $err, $tagTablePtr, $page, $type);
# verify this is a valid AIFF file
return 0 unless $raf->Read($buff, 12) == 12;
my $fast3 = $$et{OPTIONS}{FastScan} && $$et{OPTIONS}{FastScan} == 3;
my $pos = 12;
# check for DjVu image
if ($buff =~ /^AT&TFORM/) {
# http://www.djvu.org/
# http://djvu.sourceforge.net/specs/djvu3changes.txt
my $buf2;
return 0 unless $raf->Read($buf2, 4) == 4 and $buf2 =~ /^(DJVU|DJVM)/;
$pos += 4;
$buff = substr($buff, 4) . $buf2;
$et->SetFileType('DJVU');
return 1 if $fast3;
$tagTablePtr = GetTagTable('Image::ExifTool::DjVu::Main');
# modifiy FileType to indicate a multi-page document
$$et{VALUE}{FileType} .= " (multi-page)" if $buf2 eq 'DJVM';
$type = 'DjVu';
} else {
return 0 unless $buff =~ /^FORM....(AIF(F|C))/s;
$et->SetFileType($1);
return 1 if $fast3;
$tagTablePtr = GetTagTable('Image::ExifTool::AIFF::Main');
$type = 'AIFF';
}
SetByteOrder('MM');
my $verbose = $et->Options('Verbose');
#
# Read through the IFF chunks
#
for (;;) {
$raf->Read($buff, 8) == 8 or last;
$pos += 8;
my ($tag, $len) = unpack('a4N', $buff);
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
$et->VPrint(0, "AIFF '${tag}' chunk ($len bytes of data):\n");
# AIFF chunks are padded to an even number of bytes
my $len2 = $len + ($len & 0x01);
if ($tagInfo) {
if ($$tagInfo{TypeOnly}) {
$len = $len2 = 4;
$page = ($page || 0) + 1;
$et->VPrint(0, $$et{INDENT} . "Page $page:\n");
}
$raf->Read($buff, $len2) >= $len or $err=1, last;
unless ($$tagInfo{SubDirectory} or $$tagInfo{Binary}) {
$buff =~ s/\0+$//; # remove trailing nulls
}
$et->HandleTag($tagTablePtr, $tag, $buff,
DataPt => \$buff,
DataPos => $pos,
Start => 0,
Size => $len,
);
} elsif ($verbose > 2 and $len2 < 1024000) {
$raf->Read($buff, $len2) == $len2 or $err = 1, last;
$et->VerboseDump(\$buff);
} else {
$raf->Seek($len2, 1) or $err=1, last;
}
$pos += $len2;
}
$err and $et->Warn("Error reading $type file (corrupted?)");
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::AIFF - Read AIFF meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to extract
information from AIFF (Audio Interchange File Format) audio files.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://developer.apple.com/documentation/QuickTime/INMAC/SOUND/imsoundmgr.30.htm#pgfId=3190>
=item L<http://astronomy.swin.edu.au/~pbourke/dataformats/aiff/>
=item L<http://www.mactech.com/articles/mactech/Vol.06/06.01/SANENormalized/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/AIFF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,287 @@
#------------------------------------------------------------------------------
# File: APE.pm
#
# Description: Read Monkey's Audio meta information
#
# Revisions: 11/13/2006 - P. Harvey Created
#
# References: 1) http://www.monkeysaudio.com/
# 2) http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html
#------------------------------------------------------------------------------
package Image::ExifTool::APE;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.05';
# APE metadata blocks
%Image::ExifTool::APE::Main = (
GROUPS => { 2 => 'Audio' },
NOTES => q{
Tags found in Monkey's Audio (APE) information. Only a few common tags are
listed below, but ExifTool will extract any tag found. ExifTool supports
APEv1 and APEv2 tags, as well as ID3 information in APE files, and will also
read APE metadata from MP3 and MPC files.
},
Album => { },
Artist => { },
Genre => { },
Title => { },
Track => { },
Year => { },
DURATION => {
Name => 'Duration',
ValueConv => '$val += 4294967296 if $val < 0 and $val >= -2147483648; $val * 1e-7',
PrintConv => 'ConvertDuration($val)',
},
'Tool Version' => { Name => 'ToolVersion' },
'Tool Name' => { Name => 'ToolName' },
);
# APE MAC header version 3.97 or earlier
%Image::ExifTool::APE::OldHeader = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 1 => 'MAC', 2 => 'Audio' },
FORMAT => 'int16u',
NOTES => 'APE MAC audio header for version 3.97 or earlier.',
0 => {
Name => 'APEVersion',
ValueConv => '$val / 1000',
},
1 => 'CompressionLevel',
# 2 => 'FormatFlags',
3 => 'Channels',
4 => { Name => 'SampleRate', Format => 'int32u' },
# 6 => { Name => 'HeaderBytes', Format => 'int32u' }, # WAV header bytes
# 8 => { Name => 'TerminatingBytes', Format => 'int32u' },
10 => { Name => 'TotalFrames', Format => 'int32u' },
12 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
);
# APE MAC header version 3.98 or later
%Image::ExifTool::APE::NewHeader = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 1 => 'MAC', 2 => 'Audio' },
FORMAT => 'int16u',
NOTES => 'APE MAC audio header for version 3.98 or later.',
0 => 'CompressionLevel',
# 1 => 'FormatFlags',
2 => { Name => 'BlocksPerFrame', Format => 'int32u' },
4 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
6 => { Name => 'TotalFrames', Format => 'int32u' },
8 => 'BitsPerSample',
9 => 'Channels',
10 => { Name => 'SampleRate', Format => 'int32u' },
);
# APE Composite tags
%Image::ExifTool::APE::Composite = (
GROUPS => { 2 => 'Audio' },
Duration => {
Require => {
0 => 'APE:SampleRate',
1 => 'APE:TotalFrames',
2 => 'APE:BlocksPerFrame',
3 => 'APE:FinalFrameBlocks',
},
RawConv => '($val[0] && $val[1]) ? (($val[1] - 1) * $val[2] + $val[3]) / $val[0]: undef',
PrintConv => 'ConvertDuration($val)',
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::APE');
#------------------------------------------------------------------------------
# Make tag info hash for specified tag
# Inputs: 0) tag name, 1) tag table ref
# - must only call if tag doesn't exist
sub MakeTag($$)
{
my ($tag, $tagTablePtr) = @_;
my $name = ucfirst(lc($tag));
# remove invalid characters in tag name and capitalize following letters
$name =~ s/[^\w-]+(.?)/\U$1/sg;
$name =~ s/([a-z0-9])_([a-z])/$1\U$2/g;
my %tagInfo = ( Name => $name );
$tagInfo{Groups} = { 2 => 'Preview' } if $tag =~ /^Cover Art/ and $tag !~ /Desc$/;
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
}
#------------------------------------------------------------------------------
# Extract information from an APE file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# - Just looks for APE trailer if FileType is already set
# Returns: 1 on success, 0 if this wasn't a valid APE file
sub ProcessAPE($$)
{
my ($et, $dirInfo) = @_;
# must first check for leading/trailing ID3 information
unless ($$et{DoneID3}) {
require Image::ExifTool::ID3;
Image::ExifTool::ID3::ProcessID3($et, $dirInfo) and return 1;
}
my $raf = $$dirInfo{RAF};
my $verbose = $et->Options('Verbose');
my ($buff, $i, $header, $tagTablePtr, $dataPos, $oldIndent);
$$et{DoneAPE} = 1;
# check APE signature and process audio information
# unless this is some other type of file
unless ($$et{VALUE}{FileType}) {
$raf->Read($buff, 32) == 32 or return 0;
$buff =~ /^(MAC |APETAGEX)/ or return 0;
$et->SetFileType();
SetByteOrder('II');
if ($buff =~ /^APETAGEX/) {
# we already read the APE header
$header = 1;
} else {
# process the MAC header
my $vers = Get16u(\$buff, 4);
my $table;
if ($vers <= 3970) {
$buff = substr($buff, 4);
$table = GetTagTable('Image::ExifTool::APE::OldHeader');
} else {
my $dlen = Get32u(\$buff, 8);
my $hlen = Get32u(\$buff, 12);
unless ($dlen & 0x80000000 or $hlen & 0x80000000) {
if ($raf->Seek($dlen, 0) and $raf->Read($buff, $hlen) == $hlen) {
$table = GetTagTable('Image::ExifTool::APE::NewHeader');
}
}
}
$et->ProcessDirectory( { DataPt => \$buff }, $table) if $table;
}
}
# look for APE trailer unless we already found an APE header
unless ($header) {
# look for the APE trailer footer...
my $footPos = -32;
# (...but before the ID3v1 trailer if it exists)
$footPos -= 128 if $$et{DoneID3} == 2;
$raf->Seek($footPos, 2) or return 1;
$raf->Read($buff, 32) == 32 or return 1;
$buff =~ /^APETAGEX/ or return 1;
SetByteOrder('II');
}
#
# Read the APE data (we have just read the APE header or footer into $buff)
#
my ($version, $size, $count, $flags) = unpack('x8V4', $buff);
$version /= 1000;
$size -= 32; # get size of data only
if (($size & 0x80000000) == 0 and
($header or $raf->Seek(-$size-32, 1)) and
$raf->Read($buff, $size) == $size)
{
if ($verbose) {
$oldIndent = $$et{INDENT};
$$et{INDENT} .= '| ';
$et->VerboseDir("APEv$version", $count, $size);
$et->VerboseDump(\$buff, DataPos => $raf->Tell() - $size);
}
$tagTablePtr = GetTagTable('Image::ExifTool::APE::Main');
$dataPos = $raf->Tell() - $size;
} else {
$count = -1;
}
#
# Process the APE tags
#
my $pos = 0;
for ($i=0; $i<$count; ++$i) {
# read next APE tag
last if $pos + 8 > $size;
my $len = Get32u(\$buff, $pos);
my $flags = Get32u(\$buff, $pos + 4);
pos($buff) = $pos + 8;
last unless $buff =~ /\G(.*?)\0/sg;
my $tag = $1;
# avoid conflicts with our special table entries
$tag .= '.' if $Image::ExifTool::specialTags{$tag};
$pos = pos($buff);
last if $pos + $len > $size;
my $val = substr($buff, $pos, $len);
MakeTag($tag, $tagTablePtr) unless $$tagTablePtr{$tag};
# handle binary-value tags
if (($flags & 0x06) == 0x02) {
my $buf2 = $val;
$val = \$buf2;
# extract cover art description separately (hackitty hack)
if ($tag =~ /^Cover Art/) {
$buf2 =~ s/^([\x20-\x7f]*)\0//;
if ($1) {
my $t = "$tag Desc";
my $v = $1;
MakeTag($t, $tagTablePtr) unless $$tagTablePtr{$t};
$et->HandleTag($tagTablePtr, $t, $v);
}
}
}
$et->HandleTag($tagTablePtr, $tag, $val,
Index => $i,
DataPt => \$buff,
DataPos => $dataPos,
Start => $pos,
Size => $len,
);
$pos += $len;
}
$i == $count or $et->Warn('Bad APE trailer');
$$et{INDENT} = $oldIndent if defined $oldIndent;
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::APE - Read Monkey's Audio meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to extract meta
information from Monkey's Audio (APE) audio files.
=head1 BUGS
Currently doesn't parse MAC header unless it is at the start of the file.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.monkeysaudio.com/>
=item L<http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/APE Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,322 @@
#------------------------------------------------------------------------------
# File: APP12.pm
#
# Description: Read APP12 meta information
#
# Revisions: 10/18/2005 - P. Harvey Created
#
# References: 1) Heinrich Giesen private communication
#------------------------------------------------------------------------------
package Image::ExifTool::APP12;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.13';
sub ProcessAPP12($$$);
sub ProcessDucky($$$);
sub WriteDucky($$$);
# APP12 tags (ref PH)
%Image::ExifTool::APP12::PictureInfo = (
PROCESS_PROC => \&ProcessAPP12,
GROUPS => { 0 => 'APP12', 1 => 'PictureInfo', 2 => 'Image' },
PRIORITY => 0,
NOTES => q{
The JPEG APP12 "Picture Info" segment was used by some older cameras, and
contains ASCII-based meta information. Below are some tags which have been
observed Agfa and Polaroid images, however ExifTool will extract information
from any tags found in this segment.
},
FNumber => {
ValueConv => '$val=~s/^[A-Za-z ]*//;$val', # Agfa leads with an 'F'
PrintConv => 'sprintf("%.1f",$val)',
},
Aperture => {
PrintConv => 'sprintf("%.1f",$val)',
},
TimeDate => {
Name => 'DateTimeOriginal',
Description => 'Date/Time Original',
Groups => { 2 => 'Time' },
ValueConv => '$val=~/^\d+$/ ? ConvertUnixTime($val) : $val',
PrintConv => '$self->ConvertDateTime($val)',
},
Shutter => {
Name => 'ExposureTime',
ValueConv => '$val * 1e-6',
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
},
shtr => {
Name => 'ExposureTime',
ValueConv => '$val * 1e-6',
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
},
'Serial#' => {
Name => 'SerialNumber',
Groups => { 2 => 'Camera' },
},
Flash => { PrintConv => { 0 => 'Off', 1 => 'On' } },
Macro => { PrintConv => { 0 => 'Off', 1 => 'On' } },
StrobeTime => { },
Ytarget => { Name => 'YTarget' },
ylevel => { Name => 'YLevel' },
FocusPos => { },
FocusMode => { },
Quality => { },
ExpBias => 'ExposureCompensation',
FWare => 'FirmwareVersion',
StrobeTime => { },
Resolution => { },
Protect => { },
ConTake => { },
ImageSize => { PrintConv => '$val=~tr/-/x/;$val' },
ColorMode => { },
Zoom => { },
ZoomPos => { },
LightS => { },
Type => {
Name => 'CameraType',
Groups => { 2 => 'Camera' },
DataMember => 'CameraType',
RawConv => '$self->{CameraType} = $val',
},
Version => { Groups => { 2 => 'Camera' } },
ID => { Groups => { 2 => 'Camera' } },
);
# APP12 segment written in Photoshop "Save For Web" images
# (from tests with Photoshop 7 files - PH/1)
%Image::ExifTool::APP12::Ducky = (
PROCESS_PROC => \&ProcessDucky,
WRITE_PROC => \&WriteDucky,
GROUPS => { 0 => 'Ducky', 1 => 'Ducky', 2 => 'Image' },
WRITABLE => 'string',
NOTES => q{
Photoshop uses the JPEG APP12 "Ducky" segment to store some information in
"Save for Web" images.
},
1 => { #PH
Name => 'Quality',
Priority => 0,
Avoid => 1,
Writable => 'int32u',
ValueConv => 'unpack("N",$val)', # 4-byte integer
ValueConvInv => 'pack("N",$val)',
PrintConv => '"$val%"',
PrintConvInv => '$val=~/(\d+)/ ? $1 : undef',
},
2 => { #1
Name => 'Comment',
Priority => 0,
Avoid => 1,
# (ignore 4-byte character count at start of value)
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
},
3 => { #PH
Name => 'Copyright',
Priority => 0,
Avoid => 1,
Groups => { 2 => 'Author' },
# (ignore 4-byte character count at start of value)
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
},
);
#------------------------------------------------------------------------------
# Write APP12 Ducky segment
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: New directory data or undefined on error
sub WriteDucky($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
$et or return 1; # allow dummy access to autoload this package
my $dataPt = $$dirInfo{DataPt};
my $pos = $$dirInfo{DirStart};
my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
my @addTags = sort { $a <=> $b } keys(%$newTags);
my ($dirEnd, %doneTags);
if ($dataPt) {
$dirEnd = $pos + $$dirInfo{DirLen};
} else {
my $tmp = '';
$dataPt = \$tmp;
$pos = $dirEnd = 0;
}
my $newData = '';
SetByteOrder('MM');
# process all data blocks in Ducky segment
for (;;) {
my ($tag, $len, $val);
if ($pos + 4 <= $dirEnd) {
$tag = Get16u($dataPt, $pos);
$len = Get16u($dataPt, $pos + 2);
$pos += 4;
if ($pos + $len > $dirEnd) {
$et->Warn('Invalid Ducky block length');
return undef;
}
$val = substr($$dataPt, $pos, $len);
$pos += $len;
} else {
last unless @addTags;
$tag = pop @addTags;
next if $doneTags{$tag};
}
$doneTags{$tag} = 1;
my $tagInfo = $$newTags{$tag};
if ($tagInfo) {
my $nvHash = $et->GetNewValueHash($tagInfo);
my $isNew;
if (defined $val) {
if ($et->IsOverwriting($nvHash, $val)) {
$et->VerboseValue("- Ducky:$$tagInfo{Name}", $val);
$isNew = 1;
}
} else {
next unless $$nvHash{IsCreating};
$isNew = 1;
}
if ($isNew) {
$val = $et->GetNewValue($nvHash);
++$$et{CHANGED};
next unless defined $val; # next if tag is being deleted
$et->VerboseValue("+ Ducky:$$tagInfo{Name}", $val);
}
}
$newData .= pack('nn', $tag, length $val) . $val;
}
$newData .= "\0\0" if length $newData;
return $newData;
}
#------------------------------------------------------------------------------
# Process APP12 Ducky segment (ref PH)
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
# Returns: 1 on success, 0 if this wasn't a recognized Ducky segment
# Notes: This segment has the following format:
# 1) 5 bytes: "Ducky"
# 2) multiple data blocks (all integers are big endian):
# a) 2 bytes: block type (0=end, 1=Quality, 2=Comment, 3=Copyright)
# b) 2 bytes: block length (N)
# c) N bytes: block data
sub ProcessDucky($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $pos = $$dirInfo{DirStart};
my $dirEnd = $pos + $$dirInfo{DirLen};
SetByteOrder('MM');
# process all data blocks in Ducky segment
for (;;) {
last if $pos + 4 > $dirEnd;
my $tag = Get16u($dataPt, $pos);
my $len = Get16u($dataPt, $pos + 2);
$pos += 4;
if ($pos + $len > $dirEnd) {
$et->Warn('Invalid Ducky block length');
last;
}
my $val = substr($$dataPt, $pos, $len);
$et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
DataPos => $$dirInfo{DataPos},
Start => $pos,
Size => $len,
);
$pos += $len;
}
return 1;
}
#------------------------------------------------------------------------------
# Process APP12 Picture Info segment (ref PH)
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
# Returns: 1 on success, 0 if this wasn't a recognized APP12
sub ProcessAPP12($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirStart = $$dirInfo{DirStart} || 0;
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
if ($dirLen != $dirStart + length($$dataPt)) {
my $buff = substr($$dataPt, $dirStart, $dirLen);
$dataPt = \$buff;
} else {
pos($$dataPt) = $$dirInfo{DirStart};
}
my $verbose = $et->Options('Verbose');
my $success = 0;
my $section = '';
pos($$dataPt) = 0;
# this regular expression is a bit complex, but basically we are looking for
# section headers (eg. "[Camera Info]") and tag/value pairs (eg. "tag=value",
# where "value" may contain white space), separated by spaces or CR/LF.
# (APP12 uses CR/LF, but Olympus TextualInfo is similar and uses spaces)
while ($$dataPt =~ /(\[.*?\]|[\w#-]+=[\x20-\x7e]+?(?=\s*([\n\r\0]|[\w#-]+=|\[|$)))/g) {
my $token = $1;
# was this a section name?
if ($token =~ /^\[(.*)\]/) {
$et->VerboseDir($1) if $verbose;
$section = ($token =~ /\[(\S+) ?Info\]/i) ? $1 : '';
$success = 1;
next;
}
$et->VerboseDir($$dirInfo{DirName}) if $verbose and not $success;
$success = 1;
my ($tag, $val) = ($token =~ /(\S+)=(.+)/);
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
$verbose and $et->VerboseInfo($tag, $tagInfo, Value => $val);
unless ($tagInfo) {
# add new tag to table
$tagInfo = { Name => ucfirst $tag };
# put in Camera group if information in "Camera" section
$$tagInfo{Groups} = { 2 => 'Camera' } if $section =~ /camera/i;
AddTagToTable($tagTablePtr, $tag, $tagInfo);
}
$et->FoundTag($tagInfo, $val);
}
return $success;
}
1; #end
__END__
=head1 NAME
Image::ExifTool::APP12 - Read APP12 meta information
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
APP12 meta information.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 ACKNOWLEDGEMENTS
Thanks to Heinrich Giesen for his help decoding APP12 "Ducky" information.
=head1 SEE ALSO
L<Image::ExifTool::TagNames/APP12 Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,898 @@
#------------------------------------------------------------------------------
# File: ASF.pm
#
# Description: Read ASF/WMA/WMV meta information
#
# Revisions: 12/23/2005 - P. Harvey Created
#
# References: 1) http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx
# 2) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf (Oct 2008)
#------------------------------------------------------------------------------
package Image::ExifTool::ASF;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::Exif;
use Image::ExifTool::RIFF;
$VERSION = '1.25';
sub ProcessASF($$;$);
sub ProcessContentDescription($$$);
sub ProcessExtendedContentDescription($$$);
sub ProcessMetadata($$$);
sub ProcessPicture($$$);
sub ProcessCodecList($$$);
# GUID definitions
my %errorCorrection = (
'20FB5700-5B55-11CF-A8FD-00805F5C442B' => 'No Error Correction',
'BFC3CD50-618F-11CF-8BB2-00AA00B4E220' => 'Audio Spread',
);
my %streamType = (
'F8699E40-5B4D-11CF-A8FD-00805F5C442B' => 'Audio',
'BC19EFC0-5B4D-11CF-A8FD-00805F5C442B' => 'Video',
'59DACFC0-59E6-11D0-A3AC-00A0C90348F6' => 'Command',
'B61BE100-5B4E-11CF-A8FD-00805F5C442B' => 'JFIF',
'35907DE0-E415-11CF-A917-00805F5C442B' => 'Degradable JPEG',
'91BD222C-F21C-497A-8B6D-5AA86BFC0185' => 'File Transfer',
'3AFB65E2-47EF-40F2-AC2C-70A90D71D343' => 'Binary',
);
my %mutex = (
'D6E22A00-35DA-11D1-9034-00A0C90349BE' => 'MutexLanguage',
'D6E22A01-35DA-11D1-9034-00A0C90349BE' => 'MutexBitrate',
'D6E22A02-35DA-11D1-9034-00A0C90349BE' => 'MutexUnknown',
);
my %bandwidthSharing = (
'AF6060AA-5197-11D2-B6AF-00C04FD908E9' => 'SharingExclusive',
'AF6060AB-5197-11D2-B6AF-00C04FD908E9' => 'SharingPartial',
);
my %typeSpecific = (
'776257D4-C627-41CB-8F81-7AC7FF1C40CC' => 'WebStreamMediaSubtype',
'DA1E6B13-8359-4050-B398-388E965BF00C' => 'WebStreamFormat',
);
my %advancedContentEncryption = (
'7A079BB6-DAA4-4e12-A5CA-91D38DC11A8D' => 'DRMNetworkDevices',
);
# ASF top level objects
%Image::ExifTool::ASF::Main = (
PROCESS_PROC => \&ProcessASF,
NOTES => q{
The ASF format is used by Windows WMA and WMV files, and DIVX videos. Tag
ID's aren't listed because they are huge 128-bit GUID's that would ruin the
formatting of this table.
},
'75B22630-668E-11CF-A6D9-00AA0062CE6C' => {
Name => 'Header',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::Header', Size => 6 },
},
'75B22636-668E-11CF-A6D9-00AA0062CE6C' => 'Data',
'33000890-E5B1-11CF-89F4-00A0C90349CB' => 'SimpleIndex',
'D6E229D3-35DA-11D1-9034-00A0C90349BE' => 'Index',
'FEB103F8-12AD-4C64-840F-2A1D2F7AD48C' => 'MediaIndex',
'3CB73FD0-0C4A-4803-953D-EDF7B6228F0C' => 'TimecodeIndex',
'BE7ACFCB-97A9-42E8-9C71-999491E3AFAC' => { #2
Name => 'XMP',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
},
);
# ASF header objects
%Image::ExifTool::ASF::Header = (
PROCESS_PROC => \&ProcessASF,
'8CABDCA1-A947-11CF-8EE4-00C00C205365' => {
Name => 'FileProperties',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::FileProperties' },
},
'B7DC0791-A9B7-11CF-8EE6-00C00C205365' => {
Name => 'StreamProperties',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::StreamProperties' },
},
'5FBF03B5-A92E-11CF-8EE3-00C00C205365' => {
Name => 'HeaderExtension',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::HeaderExtension', Size => 22 },
},
'86D15240-311D-11D0-A3A4-00A0C90348F6' => {
Name => 'CodecList',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::CodecList' },
},
'1EFB1A30-0B62-11D0-A39B-00A0C90348F6' => 'ScriptCommand',
'F487CD01-A951-11CF-8EE6-00C00C205365' => 'Marker',
'D6E229DC-35DA-11D1-9034-00A0C90349BE' => 'BitrateMutualExclusion',
'75B22635-668E-11CF-A6D9-00AA0062CE6C' => 'ErrorCorrection',
'75B22633-668E-11CF-A6D9-00AA0062CE6C' => {
Name => 'ContentDescription',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentDescr' },
},
'2211B3FA-BD23-11D2-B4B7-00A0C955FC6E' => {
Name => 'ContentBranding',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentBranding' },
},
'D2D0A440-E307-11D2-97F0-00A0C95EA850' => {
Name => 'ExtendedContentDescr',
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ExtendedDescr' },
},
'7BF875CE-468D-11D1-8D82-006097C9A2B2' => 'StreamBitrateProps',
'2211B3FB-BD23-11D2-B4B7-00A0C955FC6E' => 'ContentEncryption',
'298AE614-2622-4C17-B935-DAE07EE9289C' => 'ExtendedContentEncryption',
'2211B3FC-BD23-11D2-B4B7-00A0C955FC6E' => 'DigitalSignature',
'1806D474-CADF-4509-A4BA-9AABCB96AAE8' => 'Padding',
);
%Image::ExifTool::ASF::ContentDescr = (
PROCESS_PROC => \&ProcessContentDescription,
GROUPS => { 2 => 'Video' },
0 => 'Title',
1 => { Name => 'Author', Groups => { 2 => 'Author' } },
2 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
3 => 'Description',
4 => 'Rating',
);
%Image::ExifTool::ASF::ContentBranding = (
PROCESS_PROC => \&ProcessContentBranding,
GROUPS => { 2 => 'Author' },
0 => {
Name => 'BannerImageType',
PrintConv => {
0 => 'None',
1 => 'Bitmap',
2 => 'JPEG',
3 => 'GIF',
},
},
1 => { Name => 'BannerImage', Groups => { 2 => 'Preview' }, Binary => 1 },
2 => 'BannerImageURL',
3 => 'CopyrightURL',
);
# Note: Many of these tags are similar to those in Image::ExifTool::Microsoft::Xtra
# and Image::ExifTool::WTV::Metadata
# (tags in this table may have a leading "WM/" removed)
%Image::ExifTool::ASF::ExtendedDescr = (
PROCESS_PROC => \&ProcessExtendedContentDescription,
GROUPS => { 2 => 'Video' },
ASFLeakyBucketPairs => { Binary => 1 },
AspectRatioX => {},
AspectRatioY => {},
Author => { Groups => { 2 => 'Author' } },
AverageLevel => {},
BannerImageData => {},
BannerImageType => {},
BannerImageURL => {},
Bitrate => { PrintConv => 'ConvertBitrate($val)' },
Broadcast => {},
BufferAverage => {},
Can_Skip_Backward => {},
Can_Skip_Forward => {},
Copyright => { Groups => { 2 => 'Author' } },
CopyrightURL => { Groups => { 2 => 'Author' } },
CurrentBitrate => { PrintConv => 'ConvertBitrate($val)' },
Description => {},
DRM_ContentID => {},
DRM_DRMHeader_ContentDistributor => {},
DRM_DRMHeader_ContentID => {},
DRM_DRMHeader_IndividualizedVersion => {},
DRM_DRMHeader_KeyID => {},
DRM_DRMHeader_LicenseAcqURL => {},
DRM_DRMHeader_SubscriptionContentID => {},
DRM_DRMHeader => {},
DRM_IndividualizedVersion => {},
DRM_KeyID => {},
DRM_LASignatureCert => {},
DRM_LASignatureLicSrvCert => {},
DRM_LASignaturePrivKey => {},
DRM_LASignatureRootCert => {},
DRM_LicenseAcqURL => {},
DRM_V1LicenseAcqURL => {},
Duration => { PrintConv => 'ConvertDuration($val)' },
FileSize => {},
HasArbitraryDataStream => {},
HasAttachedImages => {},
HasAudio => {},
HasFileTransferStream => {},
HasImage => {},
HasScript => {},
HasVideo => {},
Is_Protected => {},
Is_Trusted => {},
IsVBR => {},
NSC_Address => {},
NSC_Description => {},
NSC_Email => {},
NSC_Name => {},
NSC_Phone => {},
NumberOfFrames => {},
OptimalBitrate => { PrintConv => 'ConvertBitrate($val)' },
PeakValue => {},
Rating => {},
Seekable => {},
Signature_Name => {},
Stridable => {},
Title => {},
VBRPeak => {},
# "WM/" tags...
AlbumArtist => {},
AlbumCoverURL => {},
AlbumTitle => {},
ASFPacketCount => {},
ASFSecurityObjectsSize => {},
AudioFileURL => {},
AudioSourceURL => {},
AuthorURL => { Groups => { 2 => 'Author' } },
BeatsPerMinute => {},
Category => {},
Codec => {},
Composer => {},
Conductor => {},
ContainerFormat => {},
ContentDistributor => {},
ContentGroupDescription => {},
Director => {},
DRM => {},
DVDID => {},
EncodedBy => {},
EncodingSettings => {},
EncodingTime => { Groups => { 2 => 'Time' }, PrintConv => '$self->ConvertDateTime($val)' },
Genre => {},
GenreID => {},
InitialKey => {},
ISRC => {},
Language => {},
Lyrics => {},
Lyrics_Synchronised => {},
MCDI => {},
MediaClassPrimaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
MediaClassSecondaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
MediaCredits => {},
MediaIsDelay => {},
MediaIsFinale => {},
MediaIsLive => {},
MediaIsPremiere => {},
MediaIsRepeat => {},
MediaIsSAP => {},
MediaIsStereo => {},
MediaIsSubtitled => {},
MediaIsTape => {},
MediaNetworkAffiliation => {},
MediaOriginalBroadcastDateTime => {
Groups => { 2 => 'Time' },
ValueConv => '$val=~tr/-T/: /; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
MediaOriginalChannel => {},
MediaStationCallSign => {},
MediaStationName => {},
ModifiedBy => {},
Mood => {},
OriginalAlbumTitle => {},
OriginalArtist => {},
OriginalFilename => 'OriginalFileName',
OriginalLyricist => {},
OriginalReleaseTime => {
Groups => { 2 => 'Time' },
ValueConv => '$val=~tr/-T/: /; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
OriginalReleaseYear => { Groups => { 2 => 'Time' } },
ParentalRating => {},
ParentalRatingReason => {},
PartOfSet => {},
PeakBitrate => { PrintConv => 'ConvertBitrate($val)' },
Period => {},
Picture => {
SubDirectory => {
TagTable => 'Image::ExifTool::ASF::Picture',
},
},
PlaylistDelay => {},
Producer => {},
PromotionURL => {},
ProtectionType => {},
Provider => {},
ProviderCopyright => {},
ProviderRating => {},
ProviderStyle => {},
Publisher => {},
RadioStationName => {},
RadioStationOwner => {},
SharedUserRating => {},
StreamTypeInfo => {},
SubscriptionContentID => {},
SubTitle => 'Subtitle',
SubTitleDescription => 'SubtitleDescription',
Text => {},
ToolName => {},
ToolVersion => {},
Track => {},
TrackNumber => {},
UniqueFileIdentifier => {},
UserWebURL => {},
VideoClosedCaptioning => {},
VideoFrameRate => {},
VideoHeight => {},
VideoWidth => {},
WMADRCAverageReference => {},
WMADRCAverageTarget => {},
WMADRCPeakReference => {},
WMADRCPeakTarget => {},
WMCollectionGroupID => {},
WMCollectionID => {},
WMContentID => {},
Writer => { Groups => { 2 => 'Author' } },
Year => { Groups => { 2 => 'Time' } },
);
%Image::ExifTool::ASF::Picture = (
PROCESS_PROC => \&ProcessPicture,
GROUPS => { 2 => 'Image' },
0 => {
Name => 'PictureType',
PrintConv => { # (Note: Duplicated in ID3, ASF and FLAC modules!)
0 => 'Other',
1 => '32x32 PNG Icon',
2 => 'Other Icon',
3 => 'Front Cover',
4 => 'Back Cover',
5 => 'Leaflet',
6 => 'Media',
7 => 'Lead Artist',
8 => 'Artist',
9 => 'Conductor',
10 => 'Band',
11 => 'Composer',
12 => 'Lyricist',
13 => 'Recording Studio or Location',
14 => 'Recording Session',
15 => 'Performance',
16 => 'Capture from Movie or Video',
17 => 'Bright(ly) Colored Fish',
18 => 'Illustration',
19 => 'Band Logo',
20 => 'Publisher Logo',
},
},
1 => 'PictureMIMEType',
2 => 'PictureDescription',
3 => {
Name => 'Picture',
Groups => { 2 => 'Preview' },
Binary => 1,
},
);
%Image::ExifTool::ASF::FileProperties = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Video' },
0 => {
Name => 'FileID',
Format => 'binary[16]',
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
},
16 => { Name => 'FileLength', Format => 'int64u' },
24 => {
Name => 'CreationDate',
Format => 'int64u',
Groups => { 2 => 'Time' },
# time is in 100 ns intervals since 0:00 UTC Jan 1, 1601
ValueConv => q{ # (89 leap years between 1601 and 1970)
my $t = $val / 1e7 - (((1970-1601)*365+89)*24*3600);
return Image::ExifTool::ConvertUnixTime($t) . 'Z';
},
PrintConv => '$self->ConvertDateTime($val)',
},
32 => { Name => 'DataPackets', Format => 'int64u' },
40 => {
Name => 'Duration',
Format => 'int64u',
Notes => 'called PlayDuration by the ASF spec',
Priority => 0,
ValueConv => '$val / 1e7',
PrintConv => 'ConvertDuration($val)',
},
48 => {
Name => 'SendDuration',
Format => 'int64u',
ValueConv => '$val / 1e7',
PrintConv => 'ConvertDuration($val)',
},
56 => { Name => 'Preroll', Format => 'int64u' },
64 => { Name => 'Flags', Format => 'int32u' },
68 => { Name => 'MinPacketSize',Format => 'int32u' },
72 => { Name => 'MaxPacketSize',Format => 'int32u' },
76 => { Name => 'MaxBitrate', Format => 'int32u', PrintConv => 'ConvertBitrate($val)' },
);
%Image::ExifTool::ASF::StreamProperties = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Video' },
NOTES => 'Tags with index 54 and greater are conditional based on the StreamType.',
0 => {
Name => 'StreamType',
Format => 'binary[16]',
RawConv => sub { # set ASF_STREAM_TYPE for use in conditional tags
my ($val, $et) = @_;
$$et{ASF_STREAM_TYPE} = $streamType{GetGUID($val)} || '';
return $val;
},
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
PrintConv => \%streamType,
},
16 => {
Name => 'ErrorCorrectionType',
Format => 'binary[16]',
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
PrintConv => \%errorCorrection,
},
32 => {
Name => 'TimeOffset',
Format => 'int64u',
ValueConv => '$val / 1e7',
PrintConv => '"$val s"',
},
48 => {
Name => 'StreamNumber',
Format => 'int16u',
PrintConv => '($val & 0x7f) . ($val & 0x8000 ? " (encrypted)" : "")',
},
54 => [
{
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
Name => 'AudioCodecID',
Format => 'int16u',
PrintHex => 1,
SeparateTable => 'RIFF AudioEncoding',
PrintConv => \%Image::ExifTool::RIFF::audioEncoding,
},
{
Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
Name => 'ImageWidth',
Format => 'int32u',
},
],
56 => {
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
Name => 'AudioChannels',
Format => 'int16u',
},
58 => [
{
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
Name => 'AudioSampleRate',
Format => 'int32u',
},
{
Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
Name => 'ImageHeight',
Format => 'int32u',
},
],
);
%Image::ExifTool::ASF::HeaderExtension = (
PROCESS_PROC => \&ProcessASF,
'14E6A5CB-C672-4332-8399-A96952065B5A' => 'ExtendedStreamProps',
'A08649CF-4775-4670-8A16-6E35357566CD' => 'AdvancedMutualExcl',
'D1465A40-5A79-4338-B71B-E36B8FD6C249' => 'GroupMutualExclusion',
'D4FED15B-88D3-454F-81F0-ED5C45999E24' => 'StreamPrioritization',
'A69609E6-517B-11D2-B6AF-00C04FD908E9' => 'BandwidthSharing',
'7C4346A9-EFE0-4BFC-B229-393EDE415C85' => 'LanguageList',
'C5F8CBEA-5BAF-4877-8467-AA8C44FA4CCA' => {
Name => 'Metadata',
SubDirectory => {
# have seen some tags same as ExtendedDescr, so use this table - PH
TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
ProcessProc => \&ProcessMetadata,
},
},
'44231C94-9498-49D1-A141-1D134E457054' => {
Name => 'MetadataLibrary',
SubDirectory => {
# have seen some tags same as ExtendedDescr, so use this table - PH
TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
ProcessProc => \&ProcessMetadata,
},
},
'D6E229DF-35DA-11D1-9034-00A0C90349BE' => 'IndexParameters',
'6B203BAD-3F11-48E4-ACA8-D7613DE2CFA7' => 'TimecodeIndexParms',
'75B22630-668E-11CF-A6D9-00AA0062CE6C' => 'Compatibility',
'43058533-6981-49E6-9B74-AD12CB86D58C' => 'AdvancedContentEncryption',
'ABD3D211-A9BA-11cf-8EE6-00C00C205365' => 'Reserved1',
);
%Image::ExifTool::ASF::CodecList = (
PROCESS_PROC => \&ProcessCodecList,
VideoCodecName => {},
VideoCodecDescription => {},
AudioCodecName => {},
AudioCodecDescription => {},
OtherCodecName => {},
OtherCodecDescription => {},
);
#------------------------------------------------------------------------------
# Generate GUID from 16 bytes of binary data
# Inputs: 0) data
# Returns: GUID
sub GetGUID($)
{
# must do some byte swapping
my $val = shift;
return $val unless length($val) == 16;
my $buff = unpack('H*',pack('NnnNN',unpack('VvvNN',$val)));
$buff =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/;
return uc($buff);
}
#------------------------------------------------------------------------------
# Process ASF content description
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessContentDescription($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
return 0 if $dirLen < 10;
my @len = unpack('v5', $$dataPt);
my $pos = 10;
my $tag;
foreach $tag (0..4) {
my $len = shift @len;
next unless $len;
return 0 if $pos + $len > $dirLen;
my $val = $et->Decode(substr($$dataPt,$pos,$len),'UCS2','II');
$et->HandleTag($tagTablePtr, $tag, $val);
$pos += $len;
}
return 1;
}
#------------------------------------------------------------------------------
# Process ASF content branding
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessContentBranding($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
return 0 if $dirLen < 40;
# decode banner image type
$et->HandleTag($tagTablePtr, 0, unpack('V', $$dataPt));
# decode banner image, banner URL and copyright URL
my $pos = 4;
my $tag;
foreach $tag (1..3) {
return 0 if $pos + 4 > $dirLen;
my $size = unpack("x${pos}V", $$dataPt);
$pos += 4;
next unless $size;
return 0 if $pos + $size > $dirLen;
my $val = substr($$dataPt, $pos, $size);
$et->HandleTag($tagTablePtr, $tag, $val);
$pos += $size;
}
return 1;
}
#------------------------------------------------------------------------------
# Read ASF value
# Inputs: 0) ExifTool object ref, 1) data reference, 2) value offset,
# 3) format number, 4) size
# Returns: converted value
sub ReadASF($$$$$)
{
my ($et, $dataPt, $pos, $format, $size) = @_;
my @vals;
if ($format == 0) { # unicode string
$vals[0] = $et->Decode(substr($$dataPt,$pos,$size),'UCS2','II');
} elsif ($format == 2) { # 4-byte boolean
@vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
foreach (@vals) {
$_ = $_ ? 'True' : 'False';
}
} elsif ($format == 3) { # int32u
@vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
} elsif ($format == 4) { # int64u
@vals = ReadValue($dataPt, $pos, 'int64u', undef, $size);
} elsif ($format == 5) { # int16u
@vals = ReadValue($dataPt, $pos, 'int16u', undef, $size);
} else { # any other format (including 1, byte array): return raw data
$vals[0] = substr($$dataPt,$pos,$size);
}
return join ' ', @vals;
}
#------------------------------------------------------------------------------
# Process extended content description
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessExtendedContentDescription($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
return 0 if $dirLen < 2;
my $count = Get16u($dataPt, 0);
$et->VerboseDir($dirInfo, $count);
my $pos = 2;
my $i;
for ($i=0; $i<$count; ++$i) {
return 0 if $pos + 6 > $dirLen;
my $nameLen = unpack("x${pos}v", $$dataPt);
$pos += 2;
return 0 if $pos + $nameLen + 4 > $dirLen;
my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
$tag =~ s/^WM\///; # remove leading "WM/"
$pos += $nameLen;
my ($dType, $dLen) = unpack("x${pos}v2", $$dataPt);
$pos += 4;
return 0 if $pos + $dLen > $dirLen;
my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
$et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
Start => $pos,
Size => $dLen,
);
$pos += $dLen;
}
return 1;
}
#------------------------------------------------------------------------------
# Process ASF metadata library (similar to ProcessExtendedContentDescription above)
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessMetadata($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
return 0 if $dirLen < 2;
my $count = Get16u($dataPt, 0);
$et->VerboseDir($dirInfo, $count);
my $pos = 2;
my $i;
for ($i=0; $i<$count; ++$i) {
return 0 if $pos + 12 > $dirLen;
my ($index, $stream, $nameLen, $dType, $dLen) = unpack("x${pos}v4V", $$dataPt);
$pos += 12;
return 0 if $pos + $nameLen + $dLen > $dirLen;
my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
$tag =~ s/^WM\///; # remove leading "WM/"
$pos += $nameLen;
my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
$et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
Start => $pos,
Size => $dLen,
);
$pos += $dLen;
}
return 1;
}
#------------------------------------------------------------------------------
# Process WM/Picture preview
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessPicture($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirStart = $$dirInfo{DirStart};
my $dirLen = $$dirInfo{DirLen};
return 0 unless $dirLen > 9;
# extract picture type and length
my ($type, $picLen) = unpack("x${dirStart}CV", $$dataPt);
$et->VerboseDir('Picture');
$et->HandleTag($tagTablePtr, 0, $type);
# extract mime type and description strings (null-terminated unicode strings)
my $n = $dirLen - 5 - $picLen;
return 0 if $n & 0x01 or $n < 4;
my $str = substr($$dataPt, $dirStart+5, $n);
if ($str =~ /^((?:..)*?)\0\0((?:..)*?)\0\0/s) {
my ($mime, $desc) = ($1, $2);
$et->HandleTag($tagTablePtr, 1, $et->Decode($mime,'UCS2','II'));
$et->HandleTag($tagTablePtr, 2, $et->Decode($desc,'UCS2','II')) if length $desc;
}
$et->HandleTag($tagTablePtr, 3, substr($$dataPt, $dirStart+5+$n, $picLen));
return 1;
}
#------------------------------------------------------------------------------
# Process codec list
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
# Returns: 1 on success
sub ProcessCodecList($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
return 0 if $dirLen < 20;
my $count = Get32u($dataPt, 16);
$et->VerboseDir($dirInfo, $count);
my $pos = 20;
my $i;
my %codecType = ( 1 => 'Video', 2 => 'Audio' );
for ($i=0; $i<$count; ++$i) {
return 0 if $pos + 8 > $dirLen;
my $type = ($codecType{Get16u($dataPt, $pos)} || 'Other') . 'Codec';
# stupid Windows programmers: these lengths are in characters (others are in bytes)
my $nameLen = Get16u($dataPt, $pos + 2) * 2;
$pos += 4;
return 0 if $pos + $nameLen + 2 > $dirLen;
my $name = $et->Decode(substr($$dataPt,$pos,$nameLen),'UCS2','II');
$et->HandleTag($tagTablePtr, "${type}Name", $name);
my $descLen = Get16u($dataPt, $pos + $nameLen) * 2;
$pos += $nameLen + 2;
return 0 if $pos + $descLen + 2 > $dirLen;
my $desc = $et->Decode(substr($$dataPt,$pos,$descLen),'UCS2','II');
$et->HandleTag($tagTablePtr, "${type}Description", $desc);
my $infoLen = Get16u($dataPt, $pos + $descLen);
$pos += $descLen + 2 + $infoLen;
}
return 1;
}
#------------------------------------------------------------------------------
# Extract information from a ASF file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
# Returns: 1 on success, 0 if this wasn't a valid ASF file
sub ProcessASF($$;$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $raf = $$dirInfo{RAF};
my $verbose = $et->Options('Verbose');
my $rtnVal = 0;
my $pos = 0;
my ($buff, $err, @parentTable, @childEnd);
for (;;) {
last unless $raf->Read($buff, 24) == 24;
$pos += 24;
my $tag = GetGUID(substr($buff,0,16));
unless ($tagTablePtr) {
# verify this is a valid ASF file
last unless $tag eq '75B22630-668E-11CF-A6D9-00AA0062CE6C';
my $fileType = $$et{FILE_EXT};
$fileType = 'ASF' unless $fileType and $fileType =~ /^(ASF|WMV|WMA|DIVX)$/;
$et->SetFileType($fileType);
SetByteOrder('II');
$tagTablePtr = GetTagTable('Image::ExifTool::ASF::Main');
$rtnVal = 1;
}
my $size = Image::ExifTool::Get64u(\$buff, 16) - 24;
if ($size < 0) {
$err = 'Invalid ASF object size';
last;
}
if ($size > 0x7fffffff) {
if ($size > 0x7fffffff * 4294967296) {
$err = 'Invalid ASF object size';
} elsif ($et->Options('LargeFileSupport')) {
if ($raf->Seek($size, 1)) {
$et->VPrint(0, " Skipped large ASF object ($size bytes)\n");
$pos += $size;
next;
}
$err = 'Error seeking past large ASF object';
} else {
$err = 'Large ASF objects not supported (LargeFileSupport not set)';
}
last;
}
# go back to parent tag table if done with previous children
if (@childEnd and $pos >= $childEnd[-1]) {
pop @childEnd;
$tagTablePtr = pop @parentTable;
$$et{INDENT} = substr($$et{INDENT},0,-2);
}
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
$verbose and $et->VerboseInfo($tag, $tagInfo);
if ($tagInfo) {
my $subdir = $$tagInfo{SubDirectory};
if ($subdir) {
my $subTable = GetTagTable($$subdir{TagTable});
if ($$subTable{PROCESS_PROC} eq \&ProcessASF) {
if (defined $$subdir{Size}) {
my $s = $$subdir{Size};
if ($verbose > 2) {
$raf->Read($buff, $s) == $s or $err = 'Truncated file', last;
$et->VerboseDump(\$buff);
} elsif (not $raf->Seek($s, 1)) {
$err = 'Seek error';
last;
}
# continue processing linearly using subTable
push @parentTable, $tagTablePtr;
push @childEnd, $pos + $size;
$tagTablePtr = $subTable;
$pos += $$subdir{Size};
if ($verbose) {
$$et{INDENT} .= '| ';
$et->VerboseDir($$tagInfo{Name});
}
next;
}
} elsif ($raf->Read($buff, $size) == $size) {
my %subdirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => $size,
DirName => $$tagInfo{Name},
);
$et->VerboseDump(\$buff) if $verbose > 2;
unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
$et->Warn("Error processing $$tagInfo{Name} directory");
}
$pos += $size;
next;
} else {
$err = 'Unexpected end of file';
last;
}
}
}
if ($verbose > 2) {
$raf->Read($buff, $size) == $size or $err = 'Truncated file', last;
$et->VerboseDump(\$buff);
} elsif (not $raf->Seek($size, 1)) { # skip the block
$err = 'Seek error';
last;
}
$pos += $size;
}
$err and $et->Warn($err);
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::ASF - Read ASF/WMA/WMV meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to extract
information from Microsoft Advanced Systems Format (ASF) files, including
Windows Media Audio (WMA) and Windows Media Video (WMV) files.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/ASF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,161 @@
#------------------------------------------------------------------------------
# File: Apple.pm
#
# Description: Apple EXIF maker notes tags
#
# Revisions: 2013-09-13 - P. Harvey Created
#
# References: 1) http://www.photoinvestigator.co/blog/the-mystery-of-maker-apple-metadata/
#------------------------------------------------------------------------------
package Image::ExifTool::Apple;
use strict;
use vars qw($VERSION);
use Image::ExifTool::Exif;
use Image::ExifTool::PLIST;
$VERSION = '1.04';
# Apple iPhone metadata (ref PH)
%Image::ExifTool::Apple::Main = (
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
WRITABLE => 1,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
NOTES => 'Tags extracted from the maker notes of iPhone images.',
# 0x0001 - int32s: seen 0,1,2,3,4,9
# 0x0002 - binary plist with a single data object of size 512 bytes (iPhone5s)
0x0003 => {
Name => 'RunTime', # (includes time plugged in, but not when suspended, ref 1)
SubDirectory => { TagTable => 'Image::ExifTool::Apple::RunTime' },
},
# 0x0004 - int32s: normally 1, but 0 for low-light images
# 0x0005 - int32s: seen values 113-247, and 100 for blank images
# 0x0006 - int32s: seen values 27-258, and 20 for blank images
# 0x0007 - int32s: seen 1
0x0008 => { #1
Name => 'AccelerationVector',
Groups => { 2 => 'Camera' },
Writable => 'rational64s',
Count => 3,
# Note: the directions are contrary to the Apple documentation (which have the
# signs of all axes reversed -- apparently the Apple geeks aren't very good
# with basic physics, and don't understand the concept of acceleration. See
# http://nscookbook.com/2013/03/ios-programming-recipe-19-using-core-motion-to-access-gyro-and-accelerometer/
# for one of the few correct descriptions of this). Note that this leads to
# a left-handed coordinate system for acceleration.
Notes => q{
XYZ coordinates of the acceleration vector in units of g. As viewed from
the front of the phone, positive X is toward the left side, positive Y is
toward the bottom, and positive Z points into the face of the phone
},
},
# 0x0009 - int32s: seen 19,275,531,4371
0x000a => {
Name => 'HDRImageType',
Writable => 'int32s',
PrintConv => {
# 2 => ? (iPad mini 2)
3 => 'HDR Image',
4 => 'Original Image',
},
},
0x000b => {
Name => 'BurstUUID',
Writable => 'string',
Notes => 'unique ID for all images in a burst',
},
# 0x000c - rational64s[2]: eg) "0.1640625 0.19921875"
# 0x000d - int32s: 0,1,6,20,24,32,40
# 0x000e - int32s: 0,1,4,12 (Orienation? 0=landscape? 4=portrait? ref 1)
# 0x000f - int32s: 2,3
# 0x0010 - int32s: 1
0x0011 => {
Name => 'ContentIdentifier', #forum8750
Writable => 'string',
},
# 0x0014 - int32s: 1,2,3,4,5 (iPhone 6s, iOS 6.1)
0x0015 => {
Name => 'ImageUniqueID',
Writable => 'string',
},
# 0x0016 - string[29]: "AXZ6pMTOh2L+acSh4Kg630XCScoO\0"
# 0x0017 - int32s: 0,8192
# 0x0019 - int32s: 0,2,128
# 0x001a - string[6]: "q825s\0"
# 0x001f - int32s: 0
);
# PLIST-format CMTime structure (ref PH)
# (CMTime ref https://developer.apple.com/library/ios/documentation/CoreMedia/Reference/CMTime/Reference/reference.html)
%Image::ExifTool::Apple::RunTime = (
PROCESS_PROC => \&Image::ExifTool::PLIST::ProcessBinaryPLIST,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
NOTES => q{
This PLIST-format information contains the elements of a CMTime structure
representing the amount of time the phone has been running since the last
boot, not including standby time.
},
timescale => { Name => 'RunTimeScale' }, # (seen 1000000000 --> ns)
epoch => { Name => 'RunTimeEpoch' }, # (seen 0)
value => { Name => 'RunTimeValue' }, # (should divide by RunTimeScale to get seconds)
flags => {
Name => 'RunTimeFlags',
PrintConv => { BITMASK => {
0 => 'Valid',
1 => 'Has been rounded',
2 => 'Positive infinity',
3 => 'Negative infinity',
4 => 'Indefinite',
}},
},
);
# Apple composite tags
%Image::ExifTool::Apple::Composite = (
GROUPS => { 2 => 'Camera' },
RunTimeSincePowerUp => {
Require => {
0 => 'Apple:RunTimeValue',
1 => 'Apple:RunTimeScale',
},
ValueConv => '$val[1] ? $val[0] / $val[1] : undef',
PrintConv => 'ConvertDuration($val)',
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::Apple');
1; # end
__END__
=head1 NAME
Image::ExifTool::Apple - Apple EXIF maker notes tags
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
Apple maker notes in EXIF information.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/Apple Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,317 @@
#------------------------------------------------------------------------------
# File: Audible.pm
#
# Description: Read metadata from Audible audio books
#
# Revisions: 2015/04/05 - P. Harvey Created
#
# References: 1) https://github.com/jteeuwen/audible
# 2) https://code.google.com/p/pyaudibletags/
# 3) http://wiki.multimedia.cx/index.php?title=Audible_Audio
#------------------------------------------------------------------------------
package Image::ExifTool::Audible;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.02';
sub ProcessAudible_meta($$$);
sub ProcessAudible_cvrx($$$);
%Image::ExifTool::Audible::Main = (
GROUPS => { 2 => 'Audio' },
NOTES => q{
ExifTool will extract any information found in the metadata dictionary of
Audible .AA files, even if not listed in the table below.
},
# tags found in the metadata dictionary (chunk 2)
pubdate => { Name => 'PublishDate', Groups => { 2 => 'Time' } },
pub_date_start => { Name => 'PublishDateStart', Groups => { 2 => 'Time' } },
author => { Name => 'Author', Groups => { 2 => 'Author' } },
copyright => { Name => 'Copyright', Groups => { 2 => 'Author' } },
# also seen (ref PH):
# product_id, parent_id, title, provider, narrator, price, description,
# long_description, short_title, is_aggregation, title_id, codec, HeaderSeed,
# EncryptedBlocks, HeaderKey, license_list, CPUType, license_count, <12 hex digits>,
# parent_short_title, parent_title, aggregation_id, short_description, user_alias
# information extracted from other chunks
_chapter_count => { Name => 'ChapterCount' }, # from chunk 6
_cover_art => { # from chunk 11
Name => 'CoverArt',
Groups => { 2 => 'Preview' },
Binary => 1,
},
);
# 'tags' atoms observed in Audible .m4b audio books (ref PH)
%Image::ExifTool::Audible::tags = (
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
NOTES => 'Information found in "tags" atom of Audible M4B audio books.',
meta => {
Name => 'Audible_meta',
SubDirectory => { TagTable => 'Image::ExifTool::Audible::meta' },
},
cvrx => {
Name => 'Audible_cvrx',
SubDirectory => { TagTable => 'Image::ExifTool::Audible::cvrx' },
},
tseg => {
Name => 'Audible_tseg',
SubDirectory => { TagTable => 'Image::ExifTool::Audible::tseg' },
},
);
# 'meta' information observed in Audible .m4b audio books (ref PH)
%Image::ExifTool::Audible::meta = (
PROCESS_PROC => \&ProcessAudible_meta,
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
NOTES => 'Information found in Audible M4B "meta" atom.',
Album => 'Album',
ALBUMARTIST => { Name => 'AlbumArtist', Groups => { 2 => 'Author' } },
Artist => { Name => 'Artist', Groups => { 2 => 'Author' } },
Comment => 'Comment',
Genre => 'Genre',
itunesmediatype => { Name => 'iTunesMediaType', Description => 'iTunes Media Type' },
SUBTITLE => 'Subtitle',
Title => 'Title',
TOOL => 'CreatorTool',
Year => { Name => 'Year', Groups => { 2 => 'Time' } },
track => 'ChapterName', # (found in 'meta' of 'tseg' atom)
);
# 'cvrx' information observed in Audible .m4b audio books (ref PH)
%Image::ExifTool::Audible::cvrx = (
PROCESS_PROC => \&ProcessAudible_cvrx,
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
NOTES => 'Audible cover art information in M4B audio books.',
VARS => { NO_ID => 1 },
CoverArtType => 'CoverArtType',
CoverArt => {
Name => 'CoverArt',
Groups => { 2 => 'Preview' },
Binary => 1,
},
);
# 'tseg' information observed in Audible .m4b audio books (ref PH)
%Image::ExifTool::Audible::tseg = (
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
tshd => {
Name => 'ChapterNumber',
Format => 'int32u',
ValueConv => '$val + 1', # start counting from 1
},
meta => {
Name => 'Audible_meta2',
SubDirectory => { TagTable => 'Image::ExifTool::Audible::meta' },
},
);
#------------------------------------------------------------------------------
# Process Audible 'meta' tags from M4B files (ref PH)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessAudible_meta($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirLen = length $$dataPt;
return 0 if $dirLen < 4;
my $num = Get32u($dataPt, 0);
$et->VerboseDir('Audible_meta', $num);
my $pos = 4;
my $index;
for ($index=0; $index<$num; ++$index) {
last if $pos + 3 > $dirLen;
my $unk = Get8u($dataPt, $pos); # ? (0x80 or 0x00)
last unless $unk eq 0x80 or $unk eq 0x00;
my $len = Get16u($dataPt, $pos + 1); # tag length
$pos += 3;
last if $pos + $len + 6 > $dirLen or not $len;
my $tag = substr($$dataPt, $pos, $len); # tag ID
my $ver = Get16u($dataPt, $pos + $len); # version?
last unless $ver eq 0x0001;
my $size = Get32u($dataPt, $pos + $len + 2);# data size
$pos += $len + 6;
last if $pos + $size > $dirLen;
my $val = $et->Decode(substr($$dataPt, $pos, $size), 'UTF8');
unless ($$tagTablePtr{$tag}) {
my $name = Image::ExifTool::MakeTagName(($tag =~ /[a-z]/) ? $tag : lc($tag));
AddTagToTable($tagTablePtr, $tag, { Name => $name });
}
$et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $pos,
Size => $size,
Index => $index,
);
$pos += $size;
}
return 1;
}
#------------------------------------------------------------------------------
# Process Audible 'cvrx' cover art atom from M4B files (ref PH)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessAudible_cvrx($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirLen = length $$dataPt;
return 0 if 0x0a > $dirLen;
my $len = Get16u($dataPt, 0x08);
return 0 if 0x0a + $len + 6 > $dirLen;
my $size = Get32u($dataPt, 0x0a + $len + 2);
return 0 if 0x0a + $len + 6 + $size > $dirLen;
$et->VerboseDir('Audible_cvrx', undef, $dirLen);
$et->HandleTag($tagTablePtr, 'CoverArtType', undef,
DataPt => $dataPt,
DataPos => $dataPos,
Start => 0x0a,
Size => $len,
);
$et->HandleTag($tagTablePtr, 'CoverArt', undef,
DataPt => $dataPt,
DataPos => $dataPos,
Start => 0x0a + $len + 6,
Size => $size,
);
return 1;
}
#------------------------------------------------------------------------------
# Read information from an Audible .AA file
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid AA file
sub ProcessAA($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $toc, $entry, $i);
# check magic number
return 0 unless $raf->Read($buff, 16) == 16 and $buff=~/^.{4}\x57\x90\x75\x36/s;
# check file size
if (defined $$et{VALUE}{FileSize}) {
# first 4 bytes of the file should be the filesize
unpack('N', $buff) == $$et{VALUE}{FileSize} or return 0;
}
$et->SetFileType();
SetByteOrder('MM');
my $bytes = 12 * Get32u(\$buff, 8); # table of contents size in bytes
$bytes > 0xc00 and $et->Warn('Invalid TOC'), return 1;
# read the table of contents
$raf->Read($toc, $bytes) == $bytes or $et->Warn('Truncated TOC'), return 1;
my $tagTablePtr = GetTagTable('Image::ExifTool::Audible::Main');
# parse table of contents (in $toc)
for ($entry=0; $entry<$bytes; $entry+=12) {
my $type = Get32u(\$toc, $entry);
next unless $type == 2 or $type == 6 or $type == 11;
my $offset = Get32u(\$toc, $entry + 4);
my $length = Get32u(\$toc, $entry + 8) or next;
$raf->Seek($offset, 0) or $et->Warn("Chunk $type seek error"), last;
if ($type == 6) { # offset table
next if $length < 4 or $raf->Read($buff, 4) != 4; # only read the chapter count
$et->HandleTag($tagTablePtr, '_chapter_count', Get32u(\$buff, 0));
next;
}
# read the chunk
$length > 100000000 and $et->Warn("Chunk $type too big"), next;
$raf->Read($buff, $length) == $length or $et->Warn("Chunk $type read error"), last;
if ($type == 11) { # cover art
next if $length < 8;
my $len = Get32u(\$buff, 0);
my $off = Get32u(\$buff, 4);
next if $off < $offset + 8 or $off - $offset + $len > $length;
$et->HandleTag($tagTablePtr, '_cover_art', substr($buff, $off-$offset, $len));
next;
}
# parse metadata dictionary (in $buff)
$length < 4 and $et->Warn('Bad dictionary'), next;
my $num = Get32u(\$buff, 0);
$num > 0x200 and $et->Warn('Bad dictionary count'), next;
my $pos = 4; # dictionary starts immediately after count
require Image::ExifTool::HTML; # (for UnescapeHTML)
$et->VerboseDir('Audible Metadata', $num);
for ($i=0; $i<$num; ++$i) {
my $tagPos = $pos + 9; # position of tag string
$tagPos > $length and $et->Warn('Truncated dictionary'), last;
# (1 unknown byte ignored at start of each dictionary entry)
my $tagLen = Get32u(\$buff, $pos + 1); # tag string length
my $valLen = Get32u(\$buff, $pos + 5); # value string length
my $valPos = $tagPos + $tagLen; # position of value string
my $nxtPos = $valPos + $valLen; # position of next entry
$nxtPos > $length and $et->Warn('Bad dictionary entry'), last;
my $tag = substr($buff, $tagPos, $tagLen);
my $val = substr($buff, $valPos, $valLen);
unless ($$tagTablePtr{$tag}) {
my $name = Image::ExifTool::MakeTagName($tag);
$name =~ s/_(.)/\U$1/g; # change from underscore-separated to mixed case
AddTagToTable($tagTablePtr, $tag, { Name => $name });
}
# unescape HTML character references and convert from UTF-8
$val = $et->Decode(Image::ExifTool::HTML::UnescapeHTML($val), 'UTF8');
$et->HandleTag($tagTablePtr, $tag, $val,
DataPos => $offset,
DataPt => \$buff,
Start => $valPos,
Size => $valLen,
Index => $i,
);
$pos = $nxtPos; # step to next dictionary entry
}
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Audible - Read meta information from Audible audio books
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read meta
information from Audible audio books.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<https://github.com/jteeuwen/audible>
=item L<https://code.google.com/p/pyaudibletags/>
=item L<http://wiki.multimedia.cx/index.php?title=Audible_Audio>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/Audible Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,361 @@
#------------------------------------------------------------------------------
# File: BMP.pm
#
# Description: Read BMP meta information
#
# Revisions: 07/16/2005 - P. Harvey Created
#
# References: 1) http://www.fortunecity.com/skyscraper/windows/364/bmpffrmt.html
# 2) http://www.fourcc.org/rgb.php
# 3) https://msdn.microsoft.com/en-us/library/dd183381(v=vs.85).aspx
#------------------------------------------------------------------------------
package Image::ExifTool::BMP;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.09';
# conversions for fixed-point 2.30 format values
my %fixed2_30 = (
ValueConv => q{
my @a = split ' ', $val;
$_ /= 0x40000000 foreach @a;
"@a";
},
PrintConv => q{
my @a = split ' ', $val;
$_ = sprintf('%.6f', $_) foreach @a;
"@a";
},
);
# BMP chunks
%Image::ExifTool::BMP::Main = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => q{
There really isn't much meta information in a BMP file as such, just a bit
of image related information.
},
0 => {
Name => 'BMPVersion',
Format => 'int32u',
Notes => q{
this is actually the size of the BMP header, but used to determine the BMP
version
},
RawConv => '$$self{BMPVersion} = $val',
PrintConv => {
40 => 'Windows V3',
68 => 'AVI BMP structure?', #PH (seen in AVI movies from some Casio and Nikon cameras)
108 => 'Windows V4',
124 => 'Windows V5',
},
},
4 => {
Name => 'ImageWidth',
Format => 'int32u',
},
8 => {
Name => 'ImageHeight',
Format => 'int32s', # (negative when stored in top-to-bottom order)
ValueConv => 'abs($val)',
},
12 => {
Name => 'Planes',
Format => 'int16u',
# values: 0,1,4,8,16,24,32
},
14 => {
Name => 'BitDepth',
Format => 'int16u',
},
16 => {
Name => 'Compression',
Format => 'int32u',
RawConv => '$$self{BMPCompression} = $val',
# (formatted as string[4] for some values in AVI images)
ValueConv => '$val > 256 ? unpack("A4",pack("V",$val)) : $val',
PrintConv => {
0 => 'None',
1 => '8-Bit RLE',
2 => '4-Bit RLE',
3 => 'Bitfields',
4 => 'JPEG', #2
5 => 'PNG', #2
# pass through ASCII video compression codec ID's
OTHER => sub {
my $val = shift;
# convert non-ascii characters
$val =~ s/([\0-\x1f\x7f-\xff])/sprintf('\\x%.2x',ord $1)/eg;
return $val;
},
},
},
20 => {
Name => 'ImageLength',
Format => 'int32u',
RawConv => '$$self{BMPImageLength} = $val',
},
24 => {
Name => 'PixelsPerMeterX',
Format => 'int32u',
},
28 => {
Name => 'PixelsPerMeterY',
Format => 'int32u',
},
32 => {
Name => 'NumColors',
Format => 'int32u',
PrintConv => '$val ? $val : "Use BitDepth"',
},
36 => {
Name => 'NumImportantColors',
Format => 'int32u',
Hook => '$varSize += $size if $$self{BMPVersion} == 68', # (the rest is invalid for AVI BMP's)
PrintConv => '$val ? $val : "All"',
},
40 => {
Name => 'RedMask',
Format => 'int32u',
PrintConv => 'sprintf("0x%.8x",$val)',
},
44 => {
Name => 'GreenMask',
Format => 'int32u',
PrintConv => 'sprintf("0x%.8x",$val)',
},
48 => {
Name => 'BlueMask',
Format => 'int32u',
PrintConv => 'sprintf("0x%.8x",$val)',
},
52 => {
Name => 'AlphaMask',
Format => 'int32u',
PrintConv => 'sprintf("0x%.8x",$val)',
},
56 => {
Name => 'ColorSpace',
Format => 'undef[4]',
RawConv => '$$self{BMPColorSpace} = $val =~ /\0/ ? Get32u(\$val, 0) : pack("N",unpack("V",$val))',
PrintConv => {
0 => 'Calibrated RGB',
1 => 'Device RGB',
2 => 'Device CMYK',
LINK => 'Linked Color Profile',
MBED => 'Embedded Color Profile',
sRGB => 'sRGB',
'Win ' => 'Windows Color Space',
},
},
60 => {
Name => 'RedEndpoint',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'int32u[3]',
%fixed2_30,
},
72 => {
Name => 'GreenEndpoint',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'int32u[3]',
%fixed2_30,
},
84 => {
Name => 'BlueEndpoint',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'int32u[3]',
%fixed2_30,
},
96 => {
Name => 'GammaRed',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'fixed32u',
},
100 => {
Name => 'GammaGreen',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'fixed32u',
},
104 => {
Name => 'GammaBlue',
Condition => '$$self{BMPColorSpace} eq "0"',
Format => 'fixed32u',
},
108 => {
Name => 'RenderingIntent',
Format => 'int32u',
PrintConv => {
1 => 'Graphic (LCS_GM_BUSINESS)',
2 => 'Proof (LCS_GM_GRAPHICS)',
4 => 'Picture (LCS_GM_IMAGES)',
8 => 'Absolute Colorimetric (LCS_GM_ABS_COLORIMETRIC)',
},
},
112 => {
Name => 'ProfileDataOffset',
Condition => '$$self{BMPColorSpace} eq "LINK" or $$self{BMPColorSpace} eq "MBED"',
Format => 'int32u',
RawConv => '$$self{BMPProfileOffset} = $val',
},
116 => {
Name => 'ProfileSize',
Condition => '$$self{BMPColorSpace} eq "LINK" or $$self{BMPColorSpace} eq "MBED"',
Format => 'int32u',
RawConv => '$$self{BMPProfileSize} = $val',
},
# 120 - reserved
);
# OS/2 12-byte bitmap header (ref http://www.fileformat.info/format/bmp/egff.htm)
%Image::ExifTool::BMP::OS2 = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => 'Information extracted from OS/2-format BMP images.',
0 => {
Name => 'BMPVersion',
Format => 'int32u',
Notes => 'again, the header size is used to determine the BMP version',
PrintConv => {
12 => 'OS/2 V1',
64 => 'OS/2 V2',
},
},
4 => { Name => 'ImageWidth', Format => 'int16u' },
6 => { Name => 'ImageHeight', Format => 'int16u' },
8 => { Name => 'Planes', Format => 'int16u' },
10 => { Name => 'BitDepth', Format => 'int16u' },
);
%Image::ExifTool::BMP::Extra = (
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => 'Extra information extracted from some BMP images.',
VARS => { NO_ID => 1 },
LinkedProfileName => { },
ICC_Profile => { SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' } },
EmbeddedJPG => {
Groups => { 2 => 'Preview' },
Binary => 1,
},
EmbeddedPNG => {
Groups => { 2 => 'Preview' },
Binary => 1,
},
);
#------------------------------------------------------------------------------
# Extract EXIF information from a BMP image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid BMP file
sub ProcessBMP($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $tagTablePtr);
# verify this is a valid BMP file
return 0 unless $raf->Read($buff, 18) == 18;
return 0 unless $buff =~ /^BM/;
SetByteOrder('II');
my $len = Get32u(\$buff, 14);
# len = v1:12, v4:108, v5:124
return 0 unless $len == 12 or $len == 16 or ($len >= 40 and $len < 1000000);
return 0 unless $raf->Seek(-4, 1) and $raf->Read($buff, $len) == $len;
$et->SetFileType(); # set the FileType tag
#
# process the BMP header
#
my %dirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => length($buff),
);
if ($len == 12 or $len == 16 or $len == 64) { # old OS/2 format BMP
$tagTablePtr = GetTagTable('Image::ExifTool::BMP::OS2');
} else {
$tagTablePtr = GetTagTable('Image::ExifTool::BMP::Main');
}
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
#
# extract any embedded images
#
my $extraTable = GetTagTable('Image::ExifTool::BMP::Extra');
if ($$et{BMPCompression} and $$et{BMPImageLength} and
($$et{BMPCompression} == 4 or $$et{BMPCompression} == 5))
{
my $tag = $$et{BMPCompression} == 4 ? 'EmbeddedJPG' : 'EmbeddedPNG';
my $val = $et->ExtractBinary($raf->Tell(), $$et{BMPImageLength}, $tag);
if ($val) {
$et->HandleTag($extraTable, $tag, $val);
}
}
#
# process profile data if it exists (v5 header only)
#
if ($len == 124 and $$et{BMPProfileOffset}) {
my $pos = $$et{BMPProfileOffset} + 14; # (note the 14-byte shift!)
my $size = $$et{BMPProfileSize};
if ($raf->Seek($pos, 0) and $raf->Read($buff, $size) == $size) {
my $tag;
if ($$et{BMPColorSpace} eq 'LINK') {
$buff =~ s/\0+$//; # remove null terminator(s)
$buff = $et->Decode($buff, 'Latin'); # convert from Latin
$tag = 'LinkedProfileName';
} else {
$tag = 'ICC_Profile';
}
$et->HandleTag($extraTable, $tag => $buff, Size => $size, DataPos => $pos);
} else {
$et->Warn('Error loading profile data', 1);
}
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::BMP - Read BMP meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read BMP
(Windows Bitmap) images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.fortunecity.com/skyscraper/windows/364/bmpffrmt.html>
=item L<http://www.fourcc.org/rgb.php>
=item L<https://msdn.microsoft.com/en-us/library/dd183381(v=vs.85).aspx>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/BMP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,251 @@
#------------------------------------------------------------------------------
# File: BPG.pm
#
# Description: Read BPG meta information
#
# Revisions: 2016-07-05 - P. Harvey Created
#
# References: 1) http://bellard.org/bpg/
#------------------------------------------------------------------------------
package Image::ExifTool::BPG;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.00';
# BPG information
%Image::ExifTool::BPG::Main = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => q{
The information listed below is extracted from BPG (Better Portable
Graphics) images. See L<http://bellard.org/bpg/> for the specification.
},
4 => {
Name => 'PixelFormat',
Format => 'int16u',
Mask => 0xe000,
PrintConv => {
0x0000 => 'Grayscale',
0x2000 => '4:2:0 (chroma at 0.5, 0.5)',
0x4000 => '4:2:2 (chroma at 0.5, 0)',
0x6000 => '4:4:4',
0x8000 => '4:2:0 (chroma at 0, 0.5)',
0xa000 => '4:2:2 (chroma at 0, 0)',
},
},
4.1 => {
Name => 'Alpha',
Format => 'int16u',
Mask => 0x1004,
PrintConv => {
0x0000 => 'No Alpha Plane',
0x1000 => 'Alpha Exists (color not premultiplied)',
0x1004 => 'Alpha Exists (color premultiplied)',
0x0004 => 'Alpha Exists (W color component)',
},
},
4.2 => {
Name => 'BitDepth',
Format => 'int16u',
Mask => 0x0f00,
ValueConv => '($val >> 8) + 8',
},
4.3 => {
Name => 'ColorSpace',
Format => 'int16u',
Mask => 0x00f0,
PrintConv => {
0x0000 => 'YCbCr (BT 601)',
0x0010 => 'RGB',
0x0020 => 'YCgCo',
0x0030 => 'YCbCr (BT 709)',
0x0040 => 'YCbCr (BT 2020)',
0x0050 => 'BT 2020 Constant Luminance',
},
},
4.4 => {
Name => 'Flags',
Format => 'int16u',
Mask => 0x000b,
PrintConv => { BITMASK => {
0 => 'Animation',
1 => 'Limited Range',
3 => 'Extension Present',
}},
},
6 => { Name => 'ImageWidth', Format => 'var_ue7' },
7 => { Name => 'ImageHeight', Format => 'var_ue7' },
# length of image data or 0 to EOF
# (must be decoded so we know where the extension data starts)
8 => { Name => 'ImageLength', Format => 'var_ue7' },
);
%Image::ExifTool::BPG::Extensions = (
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
VARS => { ALPHA_FIRST => 1 },
1 => {
Name => 'EXIF',
SubDirectory => {
TagTable => 'Image::ExifTool::Exif::Main',
ProcessProc => \&Image::ExifTool::ProcessTIFF,
},
},
2 => {
Name => 'ICC_Profile',
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
},
3 => {
Name => 'XMP',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
},
4 => {
Name => 'ThumbnailBPG',
Binary => 1,
},
5 => {
Name => 'AnimationControl',
Binary => 1,
Unknown => 1,
},
);
#------------------------------------------------------------------------------
# Get ue7 integer from binary data (max 32 bits)
# Inputs: 0) data ref, 1) location in data (undef for 0)
# Returns: 0) ue7 as integer or undef on error, 1) length of ue7 in bytes
sub Get_ue7($;$)
{
my $dataPt = shift;
my $pos = shift || 0;
my $size = length $$dataPt;
my $val = 0;
my $i;
for ($i=0; ; ) {
return() if $pos+$i >= $size or $i >= 5;
my $byte = Get8u($dataPt, $pos + $i);
$val = ($val << 7) | ($byte & 0x7f);
unless ($byte & 0x80) {
return() if $i == 4 and $byte & 0x70; # error if bits 32-34 are set
last; # this was the last byte
}
return() if $i == 0 and $byte == 0x80; # error if first byte is 0x80
++$i; # step to the next byte
}
return($val, $i+1);
}
#------------------------------------------------------------------------------
# Extract EXIF information from a BPG image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid BPG file
sub ProcessBPG($$)
{
local $_;
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $size, $n, $len, $pos);
# verify this is a valid BPG file
return 0 unless $raf->Read($buff, 21) == 21; # (21 bytes is maximum header length)
return 0 unless $buff =~ /^BPG\xfb/;
$et->SetFileType(); # set the FileType tag
SetByteOrder('MM');
my %dirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => length($buff),
VarFormatData => [ ],
);
$et->ProcessDirectory(\%dirInfo, GetTagTable('Image::ExifTool::BPG::Main'));
return 1 unless $$et{VALUE}{Flags} & 0x0008; # all done unless extension flag is set
# add varSize from last entry in VarFormatData to determine
# the current read position in the file
my $dataPos = 9 + $dirInfo{VarFormatData}[-1][1];
# read extension length
unless ($raf->Seek($dataPos, 0) and $raf->Read($buff, 5) == 5) {
$et->Warn('Missing BPG extension data');
return 1;
}
($size, $n) = Get_ue7(\$buff);
defined $size or $et->Warn('Corrupted BPG extension length'), return 1;
$dataPos += $n;
$size > 10000000 and $et->Warn('BPG extension is too large'), return 1;
unless ($raf->Seek($dataPos, 0) and $raf->Read($buff, $size) == $size) {
$et->Warn('Truncated BPG extension');
return 1;
}
my $tagTablePtr = GetTagTable('Image::ExifTool::BPG::Extensions');
# loop through the individual extensions
for ($pos=0; $pos<$size; $pos+=$len) {
my $type = Get8u(\$buff, $pos);
# get length of this extension
($len, $n) = Get_ue7(\$buff, ++$pos);
defined $len or $et->Warn('Corrupted BPG extension'), last;
$pos += $n; # point to start of data for this extension
$pos + $len > $size and $et->Warn('Invalid BPG extension size'), last;
$$tagTablePtr{$type} or $et->Warn("Unrecognized BPG extension $type ($len bytes)", 1), next;
# libbpg (in my opinion) incorrectly copies the padding byte after the
# "EXIF\0" APP1 header to the start of the BPG EXIF extension, so issue a
# minor warning and ignore the padding if we find it before the TIFF header
if ($type == 1 and $len > 3 and substr($buff,$pos,3)=~/^.(II|MM)/s) {
$et->Warn("Ignored extra byte at start of EXIF extension", 1);
++$pos;
--$len;
}
$et->HandleTag($tagTablePtr, $type, undef,
DataPt => \$buff,
DataPos => $dataPos,
Start => $pos,
Size => $len,
Parent => 'BPG',
);
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::BPG - Read BPG meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read BPG
(Better Portable Graphics) images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://bellard.org/bpg/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/BPG Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,472 @@
#------------------------------------------------------------------------------
# File: BZZ.pm
#
# Description: Utility to decode BZZ compressed data
#
# Revisions: 09/22/2008 - P. Harvey Created
#
# References: 1) http://djvu.sourceforge.net/
# 2) http://www.djvu.org/
#
# Notes: This code based on ZPCodec and BSByteStream of DjVuLibre 3.5.21
# (see NOTES documentation below for license/copyright details)
#------------------------------------------------------------------------------
package Image::ExifTool::BZZ;
use strict;
use integer; # IMPORTANT!! use integer arithmetic throughout
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = '1.00';
@ISA = qw(Exporter);
@EXPORT_OK = qw(Decode);
# constants
sub FREQMAX { 4 }
sub CTXIDS { 3 }
sub MAXBLOCK { 4096 }
# This table has been designed for the ZPCoder
# by running the following command in file 'zptable.sn':
# (fast-crude (steady-mat 0.0035 0.0002) 260)))
my @default_ztable_p = (
0x8000, 0x8000, 0x8000, 0x6bbd, 0x6bbd, 0x5d45, 0x5d45, 0x51b9, 0x51b9, 0x4813,
0x4813, 0x3fd5, 0x3fd5, 0x38b1, 0x38b1, 0x3275, 0x3275, 0x2cfd, 0x2cfd, 0x2825,
0x2825, 0x23ab, 0x23ab, 0x1f87, 0x1f87, 0x1bbb, 0x1bbb, 0x1845, 0x1845, 0x1523,
0x1523, 0x1253, 0x1253, 0x0fcf, 0x0fcf, 0x0d95, 0x0d95, 0x0b9d, 0x0b9d, 0x09e3,
0x09e3, 0x0861, 0x0861, 0x0711, 0x0711, 0x05f1, 0x05f1, 0x04f9, 0x04f9, 0x0425,
0x0425, 0x0371, 0x0371, 0x02d9, 0x02d9, 0x0259, 0x0259, 0x01ed, 0x01ed, 0x0193,
0x0193, 0x0149, 0x0149, 0x010b, 0x010b, 0x00d5, 0x00d5, 0x00a5, 0x00a5, 0x007b,
0x007b, 0x0057, 0x0057, 0x003b, 0x003b, 0x0023, 0x0023, 0x0013, 0x0013, 0x0007,
0x0007, 0x0001, 0x0001, 0x5695, 0x24ee, 0x8000, 0x0d30, 0x481a, 0x0481, 0x3579,
0x017a, 0x24ef, 0x007b, 0x1978, 0x0028, 0x10ca, 0x000d, 0x0b5d, 0x0034, 0x078a,
0x00a0, 0x050f, 0x0117, 0x0358, 0x01ea, 0x0234, 0x0144, 0x0173, 0x0234, 0x00f5,
0x0353, 0x00a1, 0x05c5, 0x011a, 0x03cf, 0x01aa, 0x0285, 0x0286, 0x01ab, 0x03d3,
0x011a, 0x05c5, 0x00ba, 0x08ad, 0x007a, 0x0ccc, 0x01eb, 0x1302, 0x02e6, 0x1b81,
0x045e, 0x24ef, 0x0690, 0x2865, 0x09de, 0x3987, 0x0dc8, 0x2c99, 0x10ca, 0x3b5f,
0x0b5d, 0x5695, 0x078a, 0x8000, 0x050f, 0x24ee, 0x0358, 0x0d30, 0x0234, 0x0481,
0x0173, 0x017a, 0x00f5, 0x007b, 0x00a1, 0x0028, 0x011a, 0x000d, 0x01aa, 0x0034,
0x0286, 0x00a0, 0x03d3, 0x0117, 0x05c5, 0x01ea, 0x08ad, 0x0144, 0x0ccc, 0x0234,
0x1302, 0x0353, 0x1b81, 0x05c5, 0x24ef, 0x03cf, 0x2b74, 0x0285, 0x201d, 0x01ab,
0x1715, 0x011a, 0x0fb7, 0x00ba, 0x0a67, 0x01eb, 0x06e7, 0x02e6, 0x0496, 0x045e,
0x030d, 0x0690, 0x0206, 0x09de, 0x0155, 0x0dc8, 0x00e1, 0x2b74, 0x0094, 0x201d,
0x0188, 0x1715, 0x0252, 0x0fb7, 0x0383, 0x0a67, 0x0547, 0x06e7, 0x07e2, 0x0496,
0x0bc0, 0x030d, 0x1178, 0x0206, 0x19da, 0x0155, 0x24ef, 0x00e1, 0x320e, 0x0094,
0x432a, 0x0188, 0x447d, 0x0252, 0x5ece, 0x0383, 0x8000, 0x0547, 0x481a, 0x07e2,
0x3579, 0x0bc0, 0x24ef, 0x1178, 0x1978, 0x19da, 0x2865, 0x24ef, 0x3987, 0x320e,
0x2c99, 0x432a, 0x3b5f, 0x447d, 0x5695, 0x5ece, 0x8000, 0x8000, 0x5695, 0x481a,
0x481a, 0, 0, 0, 0, 0
);
my @default_ztable_m = (
0x0000, 0x0000, 0x0000, 0x10a5, 0x10a5, 0x1f28, 0x1f28, 0x2bd3, 0x2bd3, 0x36e3,
0x36e3, 0x408c, 0x408c, 0x48fd, 0x48fd, 0x505d, 0x505d, 0x56d0, 0x56d0, 0x5c71,
0x5c71, 0x615b, 0x615b, 0x65a5, 0x65a5, 0x6962, 0x6962, 0x6ca2, 0x6ca2, 0x6f74,
0x6f74, 0x71e6, 0x71e6, 0x7404, 0x7404, 0x75d6, 0x75d6, 0x7768, 0x7768, 0x78c2,
0x78c2, 0x79ea, 0x79ea, 0x7ae7, 0x7ae7, 0x7bbe, 0x7bbe, 0x7c75, 0x7c75, 0x7d0f,
0x7d0f, 0x7d91, 0x7d91, 0x7dfe, 0x7dfe, 0x7e5a, 0x7e5a, 0x7ea6, 0x7ea6, 0x7ee6,
0x7ee6, 0x7f1a, 0x7f1a, 0x7f45, 0x7f45, 0x7f6b, 0x7f6b, 0x7f8d, 0x7f8d, 0x7faa,
0x7faa, 0x7fc3, 0x7fc3, 0x7fd7, 0x7fd7, 0x7fe7, 0x7fe7, 0x7ff2, 0x7ff2, 0x7ffa,
0x7ffa, 0x7fff, 0x7fff, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
);
my @default_ztable_up = (
84, 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, 81, 82, 9, 86, 5, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
82, 99, 76, 101, 70, 103, 66, 105, 106, 107, 66, 109, 60, 111, 56, 69,
114, 65, 116, 61, 118, 57, 120, 53, 122, 49, 124, 43, 72, 39, 60, 33,
56, 29, 52, 23, 48, 23, 42, 137, 38, 21, 140, 15, 142, 9, 144, 141,
146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 70, 157, 66, 81, 62, 75,
58, 69, 54, 65, 50, 167, 44, 65, 40, 59, 34, 55, 30, 175, 24, 177,
178, 179, 180, 181, 182, 183, 184, 69, 186, 59, 188, 55, 190, 51, 192, 47,
194, 41, 196, 37, 198, 199, 72, 201, 62, 203, 58, 205, 54, 207, 50, 209,
46, 211, 40, 213, 36, 215, 30, 217, 26, 219, 20, 71, 14, 61, 14, 57,
8, 53, 228, 49, 230, 45, 232, 39, 234, 35, 138, 29, 24, 25, 240, 19,
22, 13, 16, 13, 10, 7, 244, 249, 10, 89, 230, 0, 0, 0, 0, 0
);
my @default_ztable_dn = (
145, 4, 3, 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, 85, 226, 6, 176, 143, 138, 141, 112, 135, 104, 133, 100, 129,
98, 127, 72, 125, 102, 123, 60, 121, 110, 119, 108, 117, 54, 115, 48, 113,
134, 59, 132, 55, 130, 51, 128, 47, 126, 41, 62, 37, 66, 31, 54, 25,
50, 131, 46, 17, 40, 15, 136, 7, 32, 139, 172, 9, 170, 85, 168, 248,
166, 247, 164, 197, 162, 95, 160, 173, 158, 165, 156, 161, 60, 159, 56, 71,
52, 163, 48, 59, 42, 171, 38, 169, 32, 53, 26, 47, 174, 193, 18, 191,
222, 189, 218, 187, 216, 185, 214, 61, 212, 53, 210, 49, 208, 45, 206, 39,
204, 195, 202, 31, 200, 243, 64, 239, 56, 237, 52, 235, 48, 233, 44, 231,
38, 229, 34, 227, 28, 225, 22, 223, 16, 221, 220, 63, 8, 55, 224, 51,
2, 47, 87, 43, 246, 37, 244, 33, 238, 27, 236, 21, 16, 15, 8, 241,
242, 7, 10, 245, 2, 1, 83, 250, 2, 143, 246, 0, 0, 0, 0, 0
);
#------------------------------------------------------------------------------
# New - create new BZZ object
# Inputs: 0) reference to BZZ object or BZZ class name
# Returns: blessed BZZ object ref
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::BZZ';
return bless {}, $class;
}
#------------------------------------------------------------------------------
# Initialize BZZ object
# Inputs: 0) BZZ object ref, 1) data ref, 2) true for DjVu compatibility
sub Init($$)
{
my ($self, $dataPt, $djvucompat) = @_;
# Create machine independent ffz table
my $ffzt = $$self{ffzt} = [ ];
my ($i, $j);
for ($i=0; $i<256; $i++) {
$$ffzt[$i] = 0;
for ($j=$i; $j&0x80; $j<<=1) {
$$ffzt[$i] += 1;
}
}
# Initialize table
$$self{p} = [ @default_ztable_p ];
$$self{'m'} = [ @default_ztable_m ];
$$self{up} = [ @default_ztable_up ];
$$self{dn} = [ @default_ztable_dn ];
# Patch table (and lose DjVu compatibility)
unless ($djvucompat) {
my ($p, $m, $dn) = ($$self{p}, $$self{'m'}, $$self{dn});
for ($j=0; $j<256; $j++) {
my $a = (0x10000 - $$p[$j]) & 0xffff;
while ($a >= 0x8000) { $a = ($a<<1) & 0xffff }
if ($$m[$j]>0 && $a+$$p[$j]>=0x8000 && $a>=$$m[$j]) {
$$dn[$j] = $default_ztable_dn[$default_ztable_dn[$j]];
}
}
}
$$self{ctx} = [ (0) x 300 ];
$$self{DataPt} = $dataPt;
$$self{Pos} = 0;
$$self{DataLen} = length $$dataPt;
$$self{a} = 0;
$$self{buffer} = 0;
$$self{fence} = 0;
$$self{blocksize} = 0;
# Read first 16 bits of code
if (length($$dataPt) >= 2) {
$$self{code} = unpack('n', $$dataPt);
$$self{Pos} += 2;
} elsif (length($$dataPt) >= 1) {
$$self{code} = (unpack('C', $$dataPt) << 8) | 0xff;
$$self{Pos}++;
} else {
$$self{code} = 0xffff;
}
$$self{byte} = $$self{code} & 0xff;
# Preload buffer
$$self{delay} = 25;
$$self{scount} = 0;
# Compute initial fence
$$self{fence} = $$self{code} >= 0x8000 ? 0x7fff : $$self{code};
}
#------------------------------------------------------------------------------
# Decode data block
# Inputs: 0) optional BZZ object ref, 1) optional data ref
# Returns: decoded data or undefined on error
# Notes: If called without a data ref, an input BZZ object ref must be given and
# the BZZ object must have been initialized by a previous call to Init()
sub Decode($;$)
{
# Decode input stream
local $_;
my $self;
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool::BZZ')) {
$self = shift;
} else {
$self = new Image::ExifTool::BZZ;
}
my $dataPt = shift;
if ($dataPt) {
$self->Init($dataPt, 1);
} else {
$dataPt = $$self{DataPt} or return undef;
}
# Decode block size
my $n = 1;
my $m = (1 << 24);
while ($n < $m) {
my $b = $self->decode_sub(0x8000 + ($$self{a}>>1));
$n = ($n<<1) | $b;
}
$$self{size} = $n - $m;
return '' unless $$self{size};
return undef if $$self{size} > MAXBLOCK()*1024;
# Allocate
if ($$self{blocksize} < $$self{size}) {
$$self{blocksize} = $$self{size};
}
# Decode Estimation Speed
my $fshift = 0;
if ($self->decode_sub(0x8000 + ($$self{a}>>1))) {
$fshift += 1;
$fshift += 1 if $self->decode_sub(0x8000 + ($$self{a}>>1));
}
# Prepare Quasi MTF
my @mtf = (0..255);
my @freq = (0) x FREQMAX();
my $fadd = 4;
# Decode
my $mtfno = 3;
my $markerpos = -1;
my $cx = $$self{ctx};
my ($i, @dat);
byte: for ($i=0; $i<$$self{size}; $i++) {
# dummy loop avoids use of "goto" statement
dummy: for (;;) {
my $ctxid = CTXIDS() - 1;
$ctxid = $mtfno if $ctxid > $mtfno;
my $cp = 0;
my ($imtf, $bits);
for ($imtf=0; $imtf<2; ++$imtf) {
if ($self->decoder($$cx[$cp+$ctxid])) {
$mtfno = $imtf;
$dat[$i] = $mtf[$mtfno];
# (a "goto" here could give a segfault due to a Perl bug)
last dummy; # do rotation
}
$cp += CTXIDS();
}
for ($bits=1; $bits<8; ++$bits, $imtf<<=1) {
if ($self->decoder($$cx[$cp])) {
my $n = 1;
my $m = (1 << $bits);
while ($n < $m) {
my $b = $self->decoder($$cx[$cp+$n]);
$n = ($n<<1) | $b;
}
$mtfno = $imtf + $n - $m;
$dat[$i] = $mtf[$mtfno];
last dummy; # do rotation
}
$cp += $imtf;
}
$mtfno=256;
$dat[$i] = 0;
$markerpos=$i;
next byte; # no rotation necessary
}
# Rotate mtf according to empirical frequencies (new!)
# Adjust frequencies for overflow
$fadd = $fadd + ($fadd >> $fshift);
if ($fadd > 0x10000000) {
$fadd >>= 24;
$_ >>= 24 foreach @freq;
}
# Relocate new char according to new freq
my $fc = $fadd;
$fc += $freq[$mtfno] if $mtfno < FREQMAX();
my $k;
for ($k=$mtfno; $k>=FREQMAX(); $k--) {
$mtf[$k] = $mtf[$k-1];
}
for (; $k>0 && $fc>=$freq[$k-1]; $k--) {
$mtf[$k] = $mtf[$k-1];
$freq[$k] = $freq[$k-1];
}
$mtf[$k] = $dat[$i];
$freq[$k] = $fc;
# when "goto" was used, Perl 5.8.6 could segfault here
# unless "next" was explicitly stated
}
#
# Reconstruct the string
#
return undef if $markerpos<1 || $markerpos>=$$self{size};
# Allocate pointers
# Prepare count buffer
my @count = (0) x 256;
my @posn;
# Fill count buffer
no integer;
for ($i=0; $i<$markerpos; $i++) {
my $c = $dat[$i];
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
}
$posn[$i++] = 0; # (initialize marker entry just to be safe)
for ( ; $i<$$self{size}; $i++) {
my $c = $dat[$i];
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
}
use integer;
# Compute sorted char positions
my $last = 1;
for ($i=0; $i<256; $i++) {
my $tmp = $count[$i];
$count[$i] = $last;
$last += $tmp;
}
# Undo the sort transform
$i = 0;
$last = $$self{size}-1;
while ($last > 0) {
my $n = $posn[$i];
no integer;
my $c = $n >> 24;
use integer;
$dat[--$last] = $c;
$i = $count[$c] + ($n & 0xffffff);
}
# Final check and return decoded data
return undef if $i != $markerpos;
pop @dat; # (last byte isn't real)
return pack 'C*', @dat;
}
#------------------------------------------------------------------------------
# Inputs: 0) BZZ object ref, 1) ctx
# Returns: decoded bit
sub decoder($$)
{
my ($self, $ctx) = @_;
my $z = $$self{a} + $self->{p}[$ctx];
if ($z <= $$self{fence}) {
$$self{a} = $z;
return ($ctx & 1);
}
# must pass $_[1] so subroutine can modify value (darned C++ pass-by-reference!)
return $self->decode_sub($z, $_[1]);
}
#------------------------------------------------------------------------------
# Inputs: 0) BZZ object ref, 1) z, 2) ctx (or undef)
# Returns: decoded bit
sub decode_sub($$;$)
{
my ($self, $z, $ctx) = @_;
# ensure that we have at least 16 bits of encoded data available
if ($$self{scount} < 16) {
# preload byte by byte until we have at least 24 bits
while ($$self{scount} <= 24) {
if ($$self{Pos} < $$self{DataLen}) {
$$self{byte} = ord(substr(${$$self{DataPt}}, $$self{Pos}, 1));
++$$self{Pos};
} else {
$$self{byte} = 0xff;
if (--$$self{delay} < 1) {
# setting size to zero forces error return from Decode()
$$self{size} = 0;
return 0;
}
}
$$self{buffer} = ($$self{buffer}<<8) | $$self{byte};
$$self{scount} += 8;
}
}
# Save bit
my $a = $$self{a};
my ($bit, $code);
if (defined $ctx) {
$bit = ($ctx & 1);
# Avoid interval reversion
my $d = 0x6000 + (($z+$a)>>2);
$z = $d if $z > $d;
} else {
$bit = 0;
}
# Test MPS/LPS
if ($z > ($code = $$self{code})) {
$bit ^= 1;
# LPS branch
$z = 0x10000 - $z;
$a += $z;
$code += $z;
# LPS adaptation
$_[2] = $self->{dn}[$ctx] if defined $ctx;
# LPS renormalization
my $sft = $a>=0xff00 ? $self->{ffzt}[$a&0xff] + 8 : $self->{ffzt}[($a>>8)&0xff];
$$self{scount} -= $sft;
$$self{a} = ($a<<$sft) & 0xffff;
$code = (($code<<$sft) & 0xffff) | (($$self{buffer}>>$$self{scount}) & ((1<<$sft)-1));
} else {
# MPS adaptation
$_[2] = $self->{up}[$ctx] if defined $ctx and $a >= $self->{'m'}[$ctx];
# MPS renormalization
$$self{scount} -= 1;
$$self{a} = ($z<<1) & 0xffff;
$code = (($code<<1) & 0xffff) | (($$self{buffer}>>$$self{scount}) & 1);
}
# Adjust fence and save new code
$$self{fence} = $code >= 0x8000 ? 0x7fff : $code;
$$self{code} = $code;
return $bit;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::BZZ - Utility to decode BZZ compressed data
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to decode BZZ
compressed data in DjVu images.
=head1 NOTES
This code is based on ZPCodec and BSByteStream of DjVuLibre 3.5.21 (see
additional copyrights and the first reference below), which are covered
under the GNU GPL license.
This is implemented as Image::ExifTool::BZZ instead of Compress::BZZ because
I am hoping that someone else will write a proper Compress::BZZ module (with
compression ability).
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
Copyright 2002, Leon Bottou and Yann Le Cun
Copyright 2001, AT&T
Copyright 1999-2001, LizardTech Inc.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://djvu.sourceforge.net/>
=item L<http://www.djvu.org/>
=back
=head1 SEE ALSO
L<Image::ExifTool::DjVu(3pm)|Image::ExifTool::DjVu>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,282 @@
#------------------------------------------------------------------------------
# File: BigTIFF.pm
#
# Description: Read Big TIFF meta information
#
# Revisions: 07/03/2007 - P. Harvey Created
#
# References: 1) http://www.awaresystems.be/imaging/tiff/bigtiff.html
#------------------------------------------------------------------------------
package Image::ExifTool::BigTIFF;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::Exif;
$VERSION = '1.06';
my $maxOffset = 0x7fffffff; # currently supported maximum data offset/size
#------------------------------------------------------------------------------
# Process Big IFD directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
sub ProcessBigIFD($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $raf = $$dirInfo{RAF};
my $verbose = $$et{OPTIONS}{Verbose};
my $htmlDump = $$et{HTML_DUMP};
my $dirName = $$dirInfo{DirName};
my $dirStart = $$dirInfo{DirStart};
$verbose = -1 if $htmlDump; # mix htmlDump into verbose so we can test for both at once
# loop through IFD chain
for (;;) {
if ($dirStart > $maxOffset and not $et->Options('LargeFileSupport')) {
$et->Warn('Huge offsets not supported (LargeFileSupport not set)');
last;
}
unless ($raf->Seek($dirStart, 0)) {
$et->Warn("Bad $dirName offset");
return 0;
}
my ($dirBuff, $index);
unless ($raf->Read($dirBuff, 8) == 8) {
$et->Warn("Truncated $dirName count");
return 0;
}
my $numEntries = Image::ExifTool::Get64u(\$dirBuff, 0);
$verbose > 0 and $et->VerboseDir($dirName, $numEntries);
my $bsize = $numEntries * 20;
if ($bsize > $maxOffset) {
$et->Warn('Huge directory counts not yet supported');
last;
}
my $bufPos = $raf->Tell();
unless ($raf->Read($dirBuff, $bsize) == $bsize) {
$et->Warn("Truncated $dirName directory");
return 0;
}
my $nextIFD;
$raf->Read($nextIFD, 8) == 8 or undef $nextIFD; # try to read next IFD pointer
if ($htmlDump) {
$et->HDump($bufPos-8, 8, "$dirName entries", "Entry count: $numEntries");
if (defined $nextIFD) {
my $tip = sprintf("Offset: 0x%.8x", Image::ExifTool::Get64u(\$nextIFD, 0));
$et->HDump($bufPos + 20 * $numEntries, 8, "Next IFD", $tip, 0);
}
}
# loop through all entries in this BigTIFF IFD
for ($index=0; $index<$numEntries; ++$index) {
my $entry = 20 * $index;
my $tagID = Get16u(\$dirBuff, $entry);
my $format = Get16u(\$dirBuff, $entry+2);
my $count = Image::ExifTool::Get64u(\$dirBuff, $entry+4);
my $formatSize = $Image::ExifTool::Exif::formatSize[$format];
unless (defined $formatSize) {
$et->HDump($bufPos+$entry,20,"[invalid IFD entry]",
"Bad format value: $format", 1);
# warn unless the IFD was just padded with zeros
$et->Warn(sprintf("Unknown format ($format) for $dirName tag 0x%x",$tagID));
return 0; # assume corrupted IFD
}
my $formatStr = $Image::ExifTool::Exif::formatName[$format];
my $size = $count * $formatSize;
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
next unless defined $tagInfo or $verbose;
my $valuePtr = $entry + 12;
my ($valBuff, $valBase, $rational);
if ($size > 8) {
if ($size > $maxOffset) {
$et->Warn("Can't handle $dirName entry $index (huge size)");
next;
}
$valuePtr = Image::ExifTool::Get64u(\$dirBuff, $valuePtr);
if ($valuePtr > $maxOffset and not $et->Options('LargeFileSupport')) {
$et->Warn("Can't handle $dirName entry $index (LargeFileSupport not set)");
next;
}
unless ($raf->Seek($valuePtr, 0) and $raf->Read($valBuff, $size) == $size) {
$et->Warn("Error reading $dirName entry $index");
next;
}
$valBase = 0;
} else {
$valBuff = substr($dirBuff, $valuePtr, $size);
$valBase = $bufPos;
}
if (defined $tagInfo and not $tagInfo) {
# GetTagInfo() required the value for a Condition
$tagInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$valBuff);
}
my $val = ReadValue(\$valBuff, 0, $formatStr, $count, $size, \$rational);
if ($htmlDump) {
my $tval = $val;
# show numerator/denominator separately for rational numbers
$tval .= " ($rational)" if defined $rational;
my ($tagName, $colName);
if ($tagID == 0x927c and $dirName eq 'ExifIFD') {
$tagName = 'MakerNotes';
} elsif ($tagInfo) {
$tagName = $$tagInfo{Name};
} else {
$tagName = sprintf("Tag 0x%.4x",$tagID);
}
my $dname = sprintf("$dirName-%.2d", $index);
# build our tool tip
my $tip = sprintf("Tag ID: 0x%.4x\n", $tagID) .
"Format: $formatStr\[$count]\nSize: $size bytes\n";
if ($size > 8) {
$tip .= sprintf("Value offset: 0x%.8x\n", $valuePtr);
$colName = "<span class=H>$tagName</span>";
} else {
$colName = $tagName;
}
$tval = substr($tval,0,28) . '[...]' if length($tval) > 32;
if ($formatStr =~ /^(string|undef|binary)/) {
# translate non-printable characters
$tval =~ tr/\x00-\x1f\x7f-\xff/./;
} elsif ($tagInfo and Image::ExifTool::IsInt($tval)) {
if ($$tagInfo{IsOffset}) {
$tval = sprintf('0x%.4x', $tval);
} elsif ($$tagInfo{PrintHex}) {
$tval = sprintf('0x%x', $tval);
}
}
$tip .= "Value: $tval";
$et->HDump($entry+$bufPos, 20, "$dname $colName", $tip, 1);
if ($size > 8) {
# add value data block
my $flg = ($tagInfo and $$tagInfo{SubDirectory} and $$tagInfo{MakerNotes}) ? 4 : 0;
$et->HDump($valuePtr,$size,"$tagName value",'SAME', $flg);
}
}
if ($tagInfo and $$tagInfo{SubIFD}) {
# process all SubIFD's as BigTIFF
$verbose > 0 and $et->VerboseInfo($tagID, $tagInfo,
Table => $tagTablePtr,
Index => $index,
Value => $val,
DataPt => \$valBuff,
DataPos => $valBase + $valuePtr,
Start => 0,
Size => $size,
Format => $formatStr,
Count => $count,
);
my @offsets = split ' ', $val;
my $i;
for ($i=0; $i<scalar(@offsets); ++$i) {
my $subdirName = $$tagInfo{Name};
$subdirName .= $i if $i;
my %subdirInfo = (
RAF => $raf,
DataPos => 0,
DirStart => $offsets[$i],
DirName => $subdirName,
Parent => $dirInfo,
);
$et->ProcessDirectory(\%subdirInfo, $tagTablePtr, \&ProcessBigIFD);
}
} else {
my $tagKey = $et->HandleTag($tagTablePtr, $tagID, $val,
Index => $index,
DataPt => \$valBuff,
DataPos => $valBase + $valuePtr,
Start => 0,
Size => $size,
Format => $formatStr,
TagInfo => $tagInfo,
RAF => $raf,
);
$tagKey and $et->SetGroup($tagKey, $dirName);
}
}
last unless $dirName =~ /^(IFD|SubIFD)(\d*)$/;
$dirName = $1 . (($2 || 0) + 1);
defined $nextIFD or $et->Warn("Bad $dirName pointer"), return 0;
$dirStart = Image::ExifTool::Get64u(\$nextIFD, 0);
$dirStart or last;
}
return 1;
}
#------------------------------------------------------------------------------
# Extract meta information from a BigTIFF image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid BigTIFF image
sub ProcessBTF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $buff;
return 0 unless $raf->Read($buff, 16) == 16;
return 0 unless $buff =~ /^(MM\0\x2b\0\x08\0\0|II\x2b\0\x08\0\0\0)/;
if ($$dirInfo{OutFile}) {
$et->Error('ExifTool does not support writing of BigTIFF images');
return 1;
}
$et->SetFileType('BTF'); # set the FileType tag
SetByteOrder(substr($buff, 0, 2));
my $offset = Image::ExifTool::Get64u(\$buff, 8);
if ($$et{HTML_DUMP}) {
my $o = (GetByteOrder() eq 'II') ? 'Little' : 'Big';
$et->HDump(0, 8, "BigTIFF header", "Byte order: $o endian", 0);
$et->HDump(8, 8, "IFD0 pointer", sprintf("Offset: 0x%.8x",$offset), 0);
}
my %dirInfo = (
RAF => $raf,
DataPos => 0,
DirStart => $offset,
DirName => 'IFD0',
Parent => 'BigTIFF',
);
my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
$et->ProcessDirectory(\%dirInfo, $tagTablePtr, \&ProcessBigIFD);
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::BigTIFF - Read Big TIFF meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to read meta
information in BigTIFF images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.awaresystems.be/imaging/tiff/bigtiff.html>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/EXIF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,910 @@
#------------------------------------------------------------------------------
# File: CanonRaw.pm
#
# Description: Read Canon RAW (CRW) meta information
#
# Revisions: 11/25/2003 - P. Harvey Created
# 12/02/2003 - P. Harvey Completely reworked and figured out many
# more tags
#
# References: 1) http://www.cybercom.net/~dcoffin/dcraw/
# 2) http://www.wonderland.org/crw/
# 3) http://xyrion.org/ciff/CIFFspecV1R04.pdf
# 4) Dave Nicholson private communication (PowerShot S30)
#------------------------------------------------------------------------------
package Image::ExifTool::CanonRaw;
use strict;
use vars qw($VERSION $AUTOLOAD %crwTagFormat);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::Exif;
use Image::ExifTool::Canon;
$VERSION = '1.58';
sub WriteCRW($$);
sub ProcessCanonRaw($$$);
sub WriteCanonRaw($$$);
sub CheckCanonRaw($$$);
sub InitMakerNotes($);
sub SaveMakerNotes($);
sub BuildMakerNotes($$$$$$);
# formats for CRW tag types (($tag >> 8) & 0x38)
# Note: don't define format for undefined types
%crwTagFormat = (
0x00 => 'int8u',
0x08 => 'string',
0x10 => 'int16u',
0x18 => 'int32u',
# 0x20 => 'undef',
# 0x28 => 'undef',
# 0x30 => 'undef',
);
# Canon raw file tag table
# Note: Tag ID's have upper 2 bits set to zero, since these 2 bits
# just specify the location of the information
%Image::ExifTool::CanonRaw::Main = (
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
PROCESS_PROC => \&ProcessCanonRaw,
WRITE_PROC => \&WriteCanonRaw,
CHECK_PROC => \&CheckCanonRaw,
WRITABLE => 1,
0x0000 => { Name => 'NullRecord', Writable => 'undef' }, #3
0x0001 => { #3
Name => 'FreeBytes',
Format => 'undef',
Binary => 1,
},
0x0032 => { Name => 'CanonColorInfo1', Writable => 0 },
0x0805 => [
# this tag is found in more than one directory...
{
Condition => '$self->{DIR_NAME} eq "ImageDescription"',
Name => 'CanonFileDescription',
Writable => 'string[32]',
},
{
Name => 'UserComment',
Writable => 'string[256]',
},
],
0x080a => {
Name => 'CanonRawMakeModel',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::MakeModel' },
},
0x080b => { Name => 'CanonFirmwareVersion', Writable => 'string[32]' },
0x080c => { Name => 'ComponentVersion', Writable => 'string' }, #3
0x080d => { Name => 'ROMOperationMode', Writable => 'string[8]' }, #3
0x0810 => { Name => 'OwnerName', Writable => 'string[32]' },
0x0815 => { Name => 'CanonImageType', Writable => 'string[32]' },
0x0816 => { Name => 'OriginalFileName', Writable => 'string[32]' },
0x0817 => { Name => 'ThumbnailFileName', Writable => 'string[32]' },
0x100a => { #3
Name => 'TargetImageType',
Writable => 'int16u',
PrintConv => {
0 => 'Real-world Subject',
1 => 'Written Document',
},
},
0x1010 => { #3
Name => 'ShutterReleaseMethod',
Writable => 'int16u',
PrintConv => {
0 => 'Single Shot',
2 => 'Continuous Shooting',
},
},
0x1011 => { #3
Name => 'ShutterReleaseTiming',
Writable => 'int16u',
PrintConv => {
0 => 'Priority on shutter',
1 => 'Priority on focus',
},
},
0x1016 => { Name => 'ReleaseSetting', Writable => 'int16u' }, #3
0x101c => { Name => 'BaseISO', Writable => 'int16u' }, #3
0x1028=> { #PH
Name => 'CanonFlashInfo',
Writable => 'int16u',
Count => 4,
Unknown => 1,
},
0x1029 => {
Name => 'CanonFocalLength',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::FocalLength' },
},
0x102a => {
Name => 'CanonShotInfo',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::ShotInfo' },
},
0x102c => {
Name => 'CanonColorInfo2',
Writable => 0,
# for the S30, the following information has been decoded: (ref 4)
# offset 66: int32u - shutter half press time in ms
# offset 70: int32u - image capture time in ms
# offset 74: int16u - custom white balance flag (0=Off, 512=On)
},
0x102d => {
Name => 'CanonCameraSettings',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::CameraSettings' },
},
0x1030 => { #4
Name => 'WhiteSample',
Writable => 0,
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::CanonRaw::WhiteSample',
},
},
0x1031 => {
Name => 'SensorInfo',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::SensorInfo' },
},
# this tag has only be verified for the 10D in CRW files, but the D30 and D60
# also produce CRW images and have CustomFunction information in their JPEG's
0x1033 => [
{
Name => 'CustomFunctions10D',
Condition => '$self->{Model} =~ /EOS 10D/',
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::CanonCustom::Functions10D',
},
},
{
Name => 'CustomFunctionsD30',
Condition => '$self->{Model} =~ /EOS D30\b/',
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::CanonCustom::FunctionsD30',
},
},
{
Name => 'CustomFunctionsD60',
Condition => '$self->{Model} =~ /EOS D60\b/',
SubDirectory => {
# the stored size in the D60 apparently doesn't include the size word:
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size-2,$size)',
# (D60 custom functions are basically the same as D30)
TagTable => 'Image::ExifTool::CanonCustom::FunctionsD30',
},
},
{
Name => 'CustomFunctionsUnknown',
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::CanonCustom::FuncsUnknown',
},
},
],
0x1038 => {
Name => 'CanonAFInfo',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::AFInfo' },
},
0x1093 => {
Name => 'CanonFileInfo',
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::Canon::FileInfo',
},
},
0x10a9 => {
Name => 'ColorBalance',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::Canon::ColorBalance' },
},
0x10b5 => { #PH
Name => 'RawJpgInfo',
SubDirectory => {
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
TagTable => 'Image::ExifTool::CanonRaw::RawJpgInfo',
},
},
0x10ae => {
Name => 'ColorTemperature',
Writable => 'int16u',
},
0x10b4 => {
Name => 'ColorSpace',
Writable => 'int16u',
PrintConv => {
1 => 'sRGB',
2 => 'Adobe RGB',
0xffff => 'Uncalibrated',
},
},
0x1803 => { #3
Name => 'ImageFormat',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::ImageFormat' },
},
0x1804 => { Name => 'RecordID', Writable => 'int32u' }, #3
0x1806 => { #3
Name => 'SelfTimerTime',
Writable => 'int32u',
ValueConv => '$val / 1000',
ValueConvInv => '$val * 1000',
PrintConv => '"$val s"',
PrintConvInv => '$val=~s/\s*s.*//;$val',
},
0x1807 => {
Name => 'TargetDistanceSetting',
Format => 'float',
PrintConv => '"$val mm"',
PrintConvInv => '$val=~s/\s*mm$//;$val',
},
0x180b => [
{
# D30
Name => 'SerialNumber',
Condition => '$$self{Model} =~ /EOS D30\b/',
Writable => 'int32u',
PrintConv => 'sprintf("%x-%.5d",$val>>16,$val&0xffff)',
PrintConvInv => '$val=~/(.*)-(\d+)/ ? (hex($1)<<16)+$2 : undef',
},
{
# all EOS models (D30, 10D, 300D)
Name => 'SerialNumber',
Condition => '$$self{Model} =~ /EOS/',
Writable => 'int32u',
PrintConv => 'sprintf("%.10d",$val)',
PrintConvInv => '$val',
},
{
# this is not SerialNumber for PowerShot models (but what is it?) - PH
Name => 'UnknownNumber',
Unknown => 1,
},
],
0x180e => {
Name => 'TimeStamp',
Writable => 0,
SubDirectory => {
TagTable => 'Image::ExifTool::CanonRaw::TimeStamp',
},
},
0x1810 => {
Name => 'ImageInfo',
Writable => 0,
SubDirectory => {
TagTable => 'Image::ExifTool::CanonRaw::ImageInfo',
},
},
0x1813 => { #3
Name => 'FlashInfo',
Writable => 0,
SubDirectory => {
TagTable => 'Image::ExifTool::CanonRaw::FlashInfo',
},
},
0x1814 => { #3
Name => 'MeasuredEV',
Notes => q{
this is the Canon name for what could better be called MeasuredLV, and
should be close to the calculated LightValue for a proper exposure with most
models
},
Format => 'float',
ValueConv => '$val + 5',
ValueConvInv => '$val - 5',
},
0x1817 => {
Name => 'FileNumber',
Writable => 'int32u',
Groups => { 2 => 'Image' },
PrintConv => '$_=$val;s/(\d+)(\d{4})/$1-$2/;$_',
PrintConvInv => '$_=$val;s/-//;$_',
},
0x1818 => { #3
Name => 'ExposureInfo',
Groups => { 1 => 'CIFF' }, # (only so CIFF shows up in group lists)
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::ExposureInfo' },
},
0x1834 => { #PH
Name => 'CanonModelID',
Writable => 'int32u',
PrintHex => 1,
Notes => q{
this is the complete list of model ID numbers, but note that many of these
models do not produce CRW images
},
SeparateTable => 'Canon CanonModelID',
PrintConv => \%Image::ExifTool::Canon::canonModelID,
},
0x1835 => {
Name => 'DecoderTable',
Writable => 0,
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::DecoderTable' },
},
0x183b => { #PH
# display format for serial number
Name => 'SerialNumberFormat',
Writable => 'int32u',
PrintHex => 1,
PrintConv => {
0x90000000 => 'Format 1',
0xa0000000 => 'Format 2',
},
},
0x2005 => {
Name => 'RawData',
Writable => 0,
Binary => 1,
},
0x2007 => {
Name => 'JpgFromRaw',
Groups => { 2 => 'Preview' },
Writable => 'resize', # 'resize' allows this value to change size
Permanent => 0,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
0x2008 => {
Name => 'ThumbnailImage',
Groups => { 2 => 'Preview' },
Writable => 'resize', # 'resize' allows this value to change size
WriteCheck => '$self->CheckImage(\$val)',
Permanent => 0,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
# the following entries are subdirectories
# (any 0x28 and 0x30 tag types are handled automatically by the decoding logic)
0x2804 => {
Name => 'ImageDescription',
SubDirectory => { },
Writable => 0,
},
0x2807 => { #3
Name => 'CameraObject',
SubDirectory => { },
Writable => 0,
},
0x3002 => { #3
Name => 'ShootingRecord',
SubDirectory => { },
Writable => 0,
},
0x3003 => { #3
Name => 'MeasuredInfo',
SubDirectory => { },
Writable => 0,
},
0x3004 => { #3
Name => 'CameraSpecification',
SubDirectory => { },
Writable => 0,
},
0x300a => { #3
Name => 'ImageProps',
SubDirectory => { },
Writable => 0,
},
0x300b => {
Name => 'ExifInformation',
SubDirectory => { },
Writable => 0,
},
);
# Canon binary data blocks
%Image::ExifTool::CanonRaw::MakeModel = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
DATAMEMBER => [ 0, 6 ], # indices of data members to extract when writing
WRITABLE => 1,
FORMAT => 'string',
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
# (can't specify a first entry because this isn't
# a simple binary table with fixed offsets)
0 => {
Name => 'Make',
Format => 'string[6]', # "Canon\0"
DataMember => 'Make',
RawConv => '$self->{Make} = $val',
},
6 => {
Name => 'Model',
Format => 'string', # no size = to the end of the data
Description => 'Camera Model Name',
DataMember => 'Model',
RawConv => '$self->{Model} = $val',
},
);
%Image::ExifTool::CanonRaw::TimeStamp = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'int32u',
FIRST_ENTRY => 0,
GROUPS => { 0 => 'MakerNotes', 2 => 'Time' },
0 => {
Name => 'DateTimeOriginal',
Description => 'Date/Time Original',
Shift => 'Time',
ValueConv => 'ConvertUnixTime($val)',
ValueConvInv => 'GetUnixTime($val)',
PrintConv => '$self->ConvertDateTime($val)',
PrintConvInv => '$self->InverseDateTime($val)',
},
1 => { #3
Name => 'TimeZoneCode',
Format => 'int32s',
ValueConv => '$val / 3600',
ValueConvInv => '$val * 3600',
},
2 => { #3
Name => 'TimeZoneInfo',
Notes => 'set to 0x80000000 if TimeZoneCode is valid',
},
);
%Image::ExifTool::CanonRaw::ImageFormat = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'int32u',
FIRST_ENTRY => 0,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
0 => {
Name => 'FileFormat',
Flags => 'PrintHex',
PrintConv => {
0x00010000 => 'JPEG (lossy)',
0x00010002 => 'JPEG (non-quantization)',
0x00010003 => 'JPEG (lossy/non-quantization toggled)',
0x00020001 => 'CRW',
},
},
1 => {
Name => 'TargetCompressionRatio',
Format => 'float',
},
);
%Image::ExifTool::CanonRaw::RawJpgInfo = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'int16u',
FIRST_ENTRY => 1,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
# 0 => 'RawJpgInfoSize',
1 => { #PH
Name => 'RawJpgQuality',
PrintConv => {
1 => 'Economy',
2 => 'Normal',
3 => 'Fine',
5 => 'Superfine',
},
},
2 => { #PH
Name => 'RawJpgSize',
PrintConv => {
0 => 'Large',
1 => 'Medium',
2 => 'Small',
},
},
3 => 'RawJpgWidth', #PH
4 => 'RawJpgHeight', #PH
);
%Image::ExifTool::CanonRaw::FlashInfo = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'float',
FIRST_ENTRY => 0,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
0 => 'FlashGuideNumber',
1 => 'FlashThreshold',
);
%Image::ExifTool::CanonRaw::ExposureInfo = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'float',
FIRST_ENTRY => 0,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
0 => 'ExposureCompensation',
1 => {
Name => 'ShutterSpeedValue',
ValueConv => 'abs($val)<100 ? 1/(2**$val) : 0',
ValueConvInv => '$val>0 ? -log($val)/log(2) : -100',
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
},
2 => {
Name => 'ApertureValue',
ValueConv => '2 ** ($val / 2)',
ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
PrintConv => 'sprintf("%.1f",$val)',
PrintConvInv => '$val',
},
);
%Image::ExifTool::CanonRaw::ImageInfo = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
FORMAT => 'int32u',
FIRST_ENTRY => 0,
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
# Note: Don't make these writable (except rotation) because it confuses
# Canon decoding software if the are changed
0 => 'ImageWidth', #3
1 => 'ImageHeight', #3
2 => { #3
Name => 'PixelAspectRatio',
Format => 'float',
},
3 => {
Name => 'Rotation',
Format => 'int32s',
Writable => 'int32s',
},
4 => 'ComponentBitDepth', #3
5 => 'ColorBitDepth', #3
6 => 'ColorBW', #3
);
# ref 4
%Image::ExifTool::CanonRaw::DecoderTable = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
FORMAT => 'int32u',
FIRST_ENTRY => 0,
0 => 'DecoderTableNumber',
2 => 'CompressedDataOffset',
3 => 'CompressedDataLength',
);
# ref 1/4
%Image::ExifTool::CanonRaw::WhiteSample = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
FORMAT => 'int16u',
FIRST_ENTRY => 1,
1 => 'WhiteSampleWidth',
2 => 'WhiteSampleHeight',
3 => 'WhiteSampleLeftBorder',
4 => 'WhiteSampleTopBorder',
5 => 'WhiteSampleBits',
# this is followed by the encrypted white sample values (ref 1)
);
#------------------------------------------------------------------------------
# AutoLoad our writer routines when necessary
#
sub AUTOLOAD
{
return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
}
#------------------------------------------------------------------------------
# Process Raw file directory
# Inputs: 0) ExifTool object reference
# 1) directory information reference, 2) tag table reference
# Returns: 1 on success
sub ProcessCanonRaw($$$)
{
my ($et, $dirInfo, $rawTagTable) = @_;
my $blockStart = $$dirInfo{DirStart};
my $blockSize = $$dirInfo{DirLen};
my $raf = $$dirInfo{RAF} or return 0;
my $buff;
my $verbose = $et->Options('Verbose');
my $buildMakerNotes = $et->Options('MakerNotes');
# 4 bytes at end of block give directory position within block
$raf->Seek($blockStart+$blockSize-4, 0) or return 0;
$raf->Read($buff, 4) == 4 or return 0;
my $dirOffset = Get32u(\$buff,0) + $blockStart;
$raf->Seek($dirOffset, 0) or return 0;
$raf->Read($buff, 2) == 2 or return 0;
my $entries = Get16u(\$buff,0); # get number of entries in directory
# read the directory (10 bytes per entry)
$raf->Read($buff, 10 * $entries) == 10 * $entries or return 0;
$verbose and $et->VerboseDir('CIFF', $entries);
my $index;
for ($index=0; $index<$entries; ++$index) {
my $pt = 10 * $index;
my $tag = Get16u(\$buff, $pt);
my $size = Get32u(\$buff, $pt+2);
my $valuePtr = Get32u(\$buff, $pt+6);
my $ptr = $valuePtr + $blockStart; # all pointers relative to block start
if ($tag & 0x8000) {
$et->Warn('Bad CRW directory entry');
return 1;
}
my $tagID = $tag & 0x3fff; # get tag ID
my $tagType = ($tag >> 8) & 0x38; # get tag type
my $valueInDir = ($tag & 0x4000); # flag for value in directory
my $tagInfo = $et->GetTagInfo($rawTagTable, $tagID);
if (($tagType==0x28 or $tagType==0x30) and not $valueInDir) {
# this type of tag specifies a raw subdirectory
my $name;
$tagInfo and $name = $$tagInfo{Name};
$name or $name = sprintf("CanonRaw_0x%.4x", $tag);
my %subdirInfo = (
DirName => $name,
DataLen => 0,
DirStart => $ptr,
DirLen => $size,
Nesting => $$dirInfo{Nesting} + 1,
RAF => $raf,
Parent => $$dirInfo{DirName},
);
if ($verbose) {
my $fakeInfo = { Name => $name, SubDirectory => { } };
$et->VerboseInfo($tagID, $fakeInfo,
'Index' => $index,
'Size' => $size,
'Start' => $ptr,
);
}
$et->ProcessDirectory(\%subdirInfo, $rawTagTable);
next;
}
my ($valueDataPos, $count, $subdir);
my $format = $crwTagFormat{$tagType};
if ($tagInfo) {
$subdir = $$tagInfo{SubDirectory};
$format = $$tagInfo{Format} if $$tagInfo{Format};
$count = $$tagInfo{Count};
}
# get value data
my ($value, $delRawConv);
if ($valueInDir) { # is the value data in the directory?
# this type of tag stores the value in the 'size' and 'ptr' fields
$valueDataPos = $dirOffset + $pt + 4;
$size = 8;
$value = substr($buff, $pt+2, $size);
# set count to 1 by default for normal values in directory
$count = 1 if not defined $count and $format and
$format ne 'string' and not $subdir;
} else {
$valueDataPos = $ptr;
if ($size <= 512 or ($verbose > 2 and $size <= 65536)
or ($tagInfo and ($$tagInfo{SubDirectory}
or grep(/^$$tagInfo{Name}$/i, $et->GetRequestedTags()) )))
{
# read value if size is small or specifically requested
# or if this is a SubDirectory
unless ($raf->Seek($ptr, 0) and $raf->Read($value, $size) == $size) {
$et->Warn(sprintf("Error reading %d bytes from 0x%x",$size,$ptr));
next;
}
} else {
$value = "Binary data $size bytes";
if ($tagInfo) {
if ($et->Options('Binary') or $verbose) {
# read the value anyway
unless ($raf->Seek($ptr, 0) and $raf->Read($value, $size) == $size) {
$et->Warn(sprintf("Error reading %d bytes from 0x%x",$size,$ptr));
next;
}
}
# force this to be a binary (scalar reference)
$$tagInfo{RawConv} = '\$val';
$delRawConv = 1;
}
$size = length $value;
undef $format;
}
}
# set count from tagInfo count if necessary
if ($format and not $count) {
# set count according to format and size
my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
$count = int($size / $fsiz);
}
if ($verbose) {
my $val = $value;
$format and $val = ReadValue(\$val, 0, $format, $count, $size);
$et->VerboseInfo($tagID, $tagInfo,
Table => $rawTagTable,
Index => $index,
Value => $val,
DataPt => \$value,
DataPos => $valueDataPos,
Size => $size,
Format => $format,
Count => $count,
);
}
if ($buildMakerNotes) {
# build maker notes information if requested
BuildMakerNotes($et, $tagID, $tagInfo, \$value, $format, $count);
}
next unless defined $tagInfo;
if ($subdir) {
my $name = $$tagInfo{Name};
my $newTagTable;
if ($$subdir{TagTable}) {
$newTagTable = GetTagTable($$subdir{TagTable});
unless ($newTagTable) {
warn "Unknown tag table $$subdir{TagTable}\n";
next;
}
} else {
warn "Must specify TagTable for SubDirectory $name\n";
next;
}
my $subdirStart = 0;
#### eval Start ()
$subdirStart = eval $$subdir{Start} if $$subdir{Start};
my $dirData = \$value;
my %subdirInfo = (
Name => $name,
DataPt => $dirData,
DataLen => $size,
DataPos => $valueDataPos,
DirStart => $subdirStart,
DirLen => $size - $subdirStart,
Nesting => $$dirInfo{Nesting} + 1,
RAF => $raf,
DirName => $name,
Parent => $$dirInfo{DirName},
);
#### eval Validate ($dirData, $subdirStart, $size)
if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
$et->Warn("Invalid $name data");
} else {
$et->ProcessDirectory(\%subdirInfo, $newTagTable, $$subdir{ProcessProc});
}
} else {
# convert to specified format if necessary
$format and $value = ReadValue(\$value, 0, $format, $count, $size);
# save the information
$et->FoundTag($tagInfo, $value);
delete $$tagInfo{RawConv} if $delRawConv;
}
}
return 1;
}
#------------------------------------------------------------------------------
# get information from raw file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 if this was a valid Canon RAW file
sub ProcessCRW($$)
{
my ($et, $dirInfo) = @_;
my ($buff, $sig);
my $raf = $$dirInfo{RAF};
my $buildMakerNotes = $et->Options('MakerNotes');
$raf->Read($buff,2) == 2 or return 0;
SetByteOrder($buff) or return 0;
$raf->Read($buff,4) == 4 or return 0;
$raf->Read($sig,8) == 8 or return 0; # get file signature
$sig =~ /^HEAP(CCDR|JPGM)/ or return 0; # validate signature
my $hlen = Get32u(\$buff, 0);
$raf->Seek(0, 2) or return 0; # seek to end of file
my $filesize = $raf->Tell() or return 0;
# initialize maker note data if building maker notes
$buildMakerNotes and InitMakerNotes($et);
# set the FileType tag unless already done (eg. APP0 CIFF record in JPEG image)
$et->SetFileType();
# build directory information for main raw directory
my %dirInfo = (
DataLen => 0,
DirStart => $hlen,
DirLen => $filesize - $hlen,
Nesting => 0,
RAF => $raf,
Parent => 'CRW',
);
# process the raw directory
my $rawTagTable = GetTagTable('Image::ExifTool::CanonRaw::Main');
my $oldIndent = $$et{INDENT};
$$et{INDENT} .= '| ';
unless (ProcessCanonRaw($et, \%dirInfo, $rawTagTable)) {
$et->Warn('CRW file format error');
}
$$et{INDENT} = $oldIndent;
# finish building maker notes if necessary
$buildMakerNotes and SaveMakerNotes($et);
# process trailers if they exist in CRW file (not in CIFF information!)
if ($$et{FILE_TYPE} eq 'CRW') {
my $trailInfo = Image::ExifTool::IdentifyTrailer($raf);
$et->ProcessTrailers($trailInfo) if $trailInfo;
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::CanonRaw - Read Canon RAW (CRW) meta information
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
meta information from Canon CRW raw files. These files are written directly
by some Canon cameras, and contain meta information similar to that found in
the EXIF Canon maker notes.
=head1 NOTES
The CR2 format written by some Canon cameras is very different the CRW
format processed by this module. (CR2 is TIFF-based and uses standard EXIF
tags.)
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.cybercom.net/~dcoffin/dcraw/>
=item L<http://www.wonderland.org/crw/>
=item L<http://xyrion.org/ciff/>
=item L<http://owl.phy.queensu.ca/~phil/exiftool/canon_raw.html>
=back
=head1 ACKNOWLEDGEMENTS
Thanks to Dave Nicholson for decoding a number of new tags.
=head1 SEE ALSO
L<Image::ExifTool::TagNames/CanonRaw Tags>,
L<Image::ExifTool::Canon(3pm)|Image::ExifTool::Canon>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,235 @@
#------------------------------------------------------------------------------
# File: CaptureOne.pm
#
# Description: Read Capture One EIP and COS files
#
# Revisions: 2009/11/01 - P. Harvey Created
#
# Notes: The EIP format is a ZIP file containing an image (IIQ or TIFF)
# and some settings files (COS). COS files are XML based.
#------------------------------------------------------------------------------
package Image::ExifTool::CaptureOne;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::XMP;
use Image::ExifTool::ZIP;
$VERSION = '1.04';
# CaptureOne COS XML tags
# - tags are added dynamically when encountered
# - this table is not listed in tag name docs
%Image::ExifTool::CaptureOne::Main = (
GROUPS => { 0 => 'XML', 1 => 'XML', 2 => 'Image' },
PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
VARS => { NO_ID => 1 },
ColorCorrections => { ValueConv => '\$val' }, # (long list of floating point numbers)
);
#------------------------------------------------------------------------------
# We found an XMP property name/value
# Inputs: 0) attribute list ref, 1) attr hash ref,
# 2) property name ref, 3) property value ref
# Returns: true if value was changed
sub HandleCOSAttrs($$$$)
{
my ($attrList, $attrs, $prop, $valPt) = @_;
my $changed;
if (not length $$valPt and defined $$attrs{K} and defined $$attrs{V}) {
$$prop = $$attrs{K};
$$valPt = $$attrs{V};
# remove these attributes from the list
my @attrs = @$attrList;
@$attrList = ( );
my $a;
foreach $a (@attrs) {
if ($a eq 'K' or $a eq 'V') {
delete $$attrs{$a};
} else {
push @$attrList, $a;
}
}
$changed = 1;
}
return $changed;
}
#------------------------------------------------------------------------------
# We found a COS property name/value
# Inputs: 0) ExifTool object ref, 1) tag table ref
# 2) reference to array of XMP property names (last is current property)
# 3) property value, 4) attribute hash ref (not used here)
# Returns: 1 if valid tag was found
sub FoundCOS($$$$;$)
{
my ($et, $tagTablePtr, $props, $val, $attrs) = @_;
my $tag = $$props[-1];
unless ($$tagTablePtr{$tag}) {
$et->VPrint(0, " | [adding $tag]\n");
my $name = ucfirst $tag;
$name =~ tr/-_a-zA-Z0-9//dc;
return 0 unless length $tag;
my %tagInfo = ( Name => $tag );
# try formatting any tag with "Date" in the name as a date
# (shouldn't affect non-date tags)
if ($name =~ /Date(?![a-z])/) {
$tagInfo{Groups} = { 2 => 'Time' };
$tagInfo{ValueConv} = 'Image::ExifTool::XMP::ConvertXMPDate($val,1)';
$tagInfo{PrintConv} = '$self->ConvertDateTime($val)';
}
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
}
# convert from UTF8 to ExifTool Charset
$val = $et->Decode($val, "UTF8");
# un-escape XML character entities
$val = Image::ExifTool::XMP::UnescapeXML($val);
$et->HandleTag($tagTablePtr, $tag, $val);
return 0;
}
#------------------------------------------------------------------------------
# Extract information from a COS file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid XML file
sub ProcessCOS($$)
{
my ($et, $dirInfo) = @_;
# process using XMP module, but override handling of attributes and tags
$$dirInfo{XMPParseOpts} = {
AttrProc => \&HandleCOSAttrs,
FoundProc => \&FoundCOS,
};
my $tagTablePtr = GetTagTable('Image::ExifTool::CaptureOne::Main');
my $success = $et->ProcessDirectory($dirInfo, $tagTablePtr);
delete $$dirInfo{XMLParseArgs};
return $success;
}
#------------------------------------------------------------------------------
# Extract information from a CaptureOne EIP file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1
# Notes: Upon entry to this routine, the file type has already been verified
# and the dirInfo hash contains a ZIP element unique to this process proc:
# ZIP - reference to Archive::Zip object for this file
sub ProcessEIP($$)
{
my ($et, $dirInfo) = @_;
my $zip = $$dirInfo{ZIP};
my ($file, $buff, $status, $member, %parseFile);
$et->SetFileType('EIP');
# must catch all Archive::Zip warnings
local $SIG{'__WARN__'} = \&Image::ExifTool::ZIP::WarnProc;
# find all manifest files
my @members = $zip->membersMatching('^manifest\d*.xml$');
# and choose the one with the highest version number (any better ideas?)
while (@members) {
my $m = shift @members;
my $f = $m->fileName();
next if $file and $file gt $f;
$member = $m;
$file = $f;
}
# get file names from our chosen manifest file
if ($member) {
($buff, $status) = $zip->contents($member);
if (not $status) {
my $foundImage;
while ($buff =~ m{<(RawPath|SettingsPath)>(.*?)</\1>}sg) {
$file = $2;
next unless $file =~ /\.(cos|iiq|jpe?g|tiff?)$/i;
$parseFile{$file} = 1; # set flag to parse this file
$foundImage = 1 unless $file =~ /\.cos$/i;
}
# ignore manifest unless it contained a valid image
undef %parseFile unless $foundImage;
}
}
# extract meta information from embedded files
my $docNum = 0;
@members = $zip->members(); # get all members
foreach $member (@members) {
# get filename of this ZIP member
$file = $member->fileName();
next unless defined $file;
$et->VPrint(0, "File: $file\n");
# set the document number and extract ZIP tags
$$et{DOC_NUM} = ++$docNum;
Image::ExifTool::ZIP::HandleMember($et, $member);
if (%parseFile) {
next unless $parseFile{$file};
} else {
# reading the manifest didn't work, so look for image files in the
# root directory and .cos files in the CaptureOne directory
next unless $file =~ m{^([^/]+\.(iiq|jpe?g|tiff?)|CaptureOne/.*\.cos)$}i;
}
# extract the contents of the file
# Note: this could use a LOT of memory here for RAW images...
($buff, $status) = $zip->contents($member);
$status and $et->Warn("Error extracting $file"), next;
if ($file =~ /\.cos$/i) {
# process Capture One Settings files
my %dirInfo = (
DataPt => \$buff,
DirLen => length $buff,
DataLen => length $buff,
);
ProcessCOS($et, \%dirInfo);
} else {
# set HtmlDump error if necessary because it doesn't work with embedded files
if ($$et{HTML_DUMP}) {
$$et{HTML_DUMP}{Error} = "Sorry, can't dump images embedded in ZIP files";
}
# process IIQ, JPEG and TIFF images
$et->ExtractInfo(\$buff, { ReEntry => 1 });
}
undef $buff; # (free memory now)
}
delete $$et{DOC_NUM};
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::CaptureOne - Read Capture One EIP and COS files
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to extract meta
information from Capture One EIP (Enhanced Image Package) and COS (Capture
One Settings) files.
=head1 NOTES
The EIP format is a ZIP file containing an image (IIQ or TIFF) and some
settings files (COS).
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/ZIP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,431 @@
#------------------------------------------------------------------------------
# File: Charset.pm
#
# Description: ExifTool character encoding routines
#
# Revisions: 2009/08/28 - P. Harvey created
# 2010/01/20 - P. Harvey complete re-write
# 2010/07/16 - P. Harvey added UTF-16 support
#------------------------------------------------------------------------------
package Image::ExifTool::Charset;
use strict;
use vars qw($VERSION %csType);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.11';
my %charsetTable; # character set tables we've loaded
# lookup for converting Unicode to 1-byte character sets
my %unicode2byte = (
Latin => { # pre-load Latin (cp1252) for speed
0x20ac => 0x80, 0x0160 => 0x8a, 0x2013 => 0x96,
0x201a => 0x82, 0x2039 => 0x8b, 0x2014 => 0x97,
0x0192 => 0x83, 0x0152 => 0x8c, 0x02dc => 0x98,
0x201e => 0x84, 0x017d => 0x8e, 0x2122 => 0x99,
0x2026 => 0x85, 0x2018 => 0x91, 0x0161 => 0x9a,
0x2020 => 0x86, 0x2019 => 0x92, 0x203a => 0x9b,
0x2021 => 0x87, 0x201c => 0x93, 0x0153 => 0x9c,
0x02c6 => 0x88, 0x201d => 0x94, 0x017e => 0x9e,
0x2030 => 0x89, 0x2022 => 0x95, 0x0178 => 0x9f,
},
);
# bit flags for all supported character sets
# (this number must be correct because it dictates the decoding algorithm!)
# 0x001 = character set requires a translation module
# 0x002 = inverse conversion not yet supported by Recompose()
# 0x080 = some characters with codepoints in the range 0x00-0x7f are remapped
# 0x100 = 1-byte fixed-width characters
# 0x200 = 2-byte fixed-width characters
# 0x400 = 4-byte fixed-width characters
# 0x800 = 1- and 2-byte variable-width characters, or 1-byte
# fixed-width characters that map into multiple codepoints
# Note: In its public interface, ExifTool can currently only support type 0x101
# and lower character sets because strings are only converted if they
# contain characters above 0x7f and there is no provision for specifying
# the byte order for input/output values
%csType = (
UTF8 => 0x100,
ASCII => 0x100, # (treated like UTF8)
Arabic => 0x101,
Baltic => 0x101,
Cyrillic => 0x101,
Greek => 0x101,
Hebrew => 0x101,
Latin => 0x101,
Latin2 => 0x101,
DOSLatinUS => 0x101,
DOSLatin1 => 0x101,
MacCroatian => 0x101,
MacCyrillic => 0x101,
MacGreek => 0x101,
MacIceland => 0x101,
MacLatin2 => 0x101,
MacRoman => 0x101,
MacRomanian => 0x101,
MacTurkish => 0x101,
Thai => 0x101,
Turkish => 0x101,
Vietnam => 0x101,
MacArabic => 0x103, # (directional characters not supported)
PDFDoc => 0x181,
Unicode => 0x200, # (UCS2)
UCS2 => 0x200,
UTF16 => 0x200,
Symbol => 0x201,
JIS => 0x201,
UCS4 => 0x400,
MacChineseCN => 0x803,
MacChineseTW => 0x803,
MacHebrew => 0x803, # (directional characters not supported)
MacKorean => 0x803,
MacRSymbol => 0x803,
MacThai => 0x803,
MacJapanese => 0x883,
ShiftJIS => 0x883,
);
#------------------------------------------------------------------------------
# Load character set module
# Inputs: 0) Module name
# Returns: Reference to lookup hash, or undef on error
sub LoadCharset($)
{
my $charset = shift;
my $conv = $charsetTable{$charset};
unless ($conv) {
# load translation module
my $module = "Image::ExifTool::Charset::$charset";
no strict 'refs';
if (%$module or eval "require $module") {
$conv = $charsetTable{$charset} = \%$module;
}
}
return $conv;
}
#------------------------------------------------------------------------------
# Does an array contain valid UTF-16 characters?
# Inputs: 0) array reference to list of UCS-2 values
# Returns: 0=invalid UTF-16, 1=valid UTF-16 with no surrogates, 2=valid UTF-16 with surrogates
sub IsUTF16($)
{
local $_;
my $uni = shift;
my $surrogate;
foreach (@$uni) {
my $hiBits = ($_ & 0xfc00);
if ($hiBits == 0xfc00) {
# check for invalid values in UTF-16
return 0 if $_ == 0xffff or $_ == 0xfffe or ($_ >= 0xfdd0 and $_ <= 0xfdef);
} elsif ($surrogate) {
return 0 if $hiBits != 0xdc00;
$surrogate = 0;
} else {
return 0 if $hiBits == 0xdc00;
$surrogate = 1 if $hiBits == 0xd800;
}
}
return 1 if not defined $surrogate;
return 2 unless $surrogate;
return 0;
}
#------------------------------------------------------------------------------
# Decompose string with specified encoding into an array of integer code points
# Inputs: 0) ExifTool object ref (or undef), 1) string, 2) character set name,
# 3) optional byte order ('II','MM','Unknown' or undef to use ExifTool ordering)
# Returns: Reference to array of Unicode values
# Notes: Accepts any type of character set
# - byte order only used for fixed-width 2-byte and 4-byte character sets
# - byte order mark observed and then removed with UCS2 and UCS4
# - no warnings are issued if ExifTool object is not provided
# - sets ExifTool WrongByteOrder flag if byte order is Unknown and current order is wrong
sub Decompose($$$;$)
{
local $_;
my ($et, $val, $charset) = @_; # ($byteOrder assigned later if required)
my $type = $csType{$charset};
my (@uni, $conv);
if ($type & 0x001) {
$conv = LoadCharset($charset);
unless ($conv) {
# (shouldn't happen)
$et->Warn("Invalid character set $charset") if $et;
return \@uni; # error!
}
} elsif ($type == 0x100) {
# convert ASCII and UTF8 (treat ASCII as UTF8)
if ($] < 5.006001) {
# do it ourself
@uni = Image::ExifTool::UnpackUTF8($val);
} else {
# handle warnings from malformed UTF-8
undef $Image::ExifTool::evalWarning;
local $SIG{'__WARN__'} = \&Image::ExifTool::SetWarning;
# (somehow the meaning of "U0" was reversed in Perl 5.10.0!)
@uni = unpack($] < 5.010000 ? 'U0U*' : 'C0U*', $val);
# issue warning if we had errors
if ($Image::ExifTool::evalWarning and $et and not $$et{WarnBadUTF8}) {
$et->Warn('Malformed UTF-8 character(s)');
$$et{WarnBadUTF8} = 1;
}
}
return \@uni; # all done!
}
if ($type & 0x100) { # 1-byte fixed-width characters
@uni = unpack('C*', $val);
foreach (@uni) {
$_ = $$conv{$_} if defined $$conv{$_};
}
} elsif ($type & 0x600) { # 2-byte or 4-byte fixed-width characters
my $unknown;
my $byteOrder = $_[3];
if (not $byteOrder) {
$byteOrder = GetByteOrder();
} elsif ($byteOrder eq 'Unknown') {
$byteOrder = GetByteOrder();
$unknown = 1;
}
my $fmt = $byteOrder eq 'MM' ? 'n*' : 'v*';
if ($type & 0x400) { # 4-byte
$fmt = uc $fmt; # unpack as 'N*' or 'V*'
# honour BOM if it exists
$val =~ s/^(\0\0\xfe\xff|\xff\xfe\0\0)// and $fmt = $1 eq "\0\0\xfe\xff" ? 'N*' : 'V*';
undef $unknown; # (byte order logic applies to 2-byte only)
} elsif ($val =~ s/^(\xfe\xff|\xff\xfe)//) {
$fmt = $1 eq "\xfe\xff" ? 'n*' : 'v*';
undef $unknown;
}
# convert from UCS2 or UCS4
@uni = unpack($fmt, $val);
if (not $conv) {
# no translation necessary
if ($unknown) {
# check the byte order
my (%bh, %bl);
my ($zh, $zl) = (0, 0);
foreach (@uni) {
$bh{$_ >> 8} = 1;
$bl{$_ & 0xff} = 1;
++$zh unless $_ & 0xff00;
++$zl unless $_ & 0x00ff;
}
# count the number of unique values in the hi and lo bytes
my ($bh, $bl) = (scalar(keys %bh), scalar(keys %bl));
# the byte with the greater number of unique values should be
# the low-order byte, otherwise the byte which is zero more
# often is likely the high-order byte
if ($bh > $bl or ($bh == $bl and $zl > $zh)) {
# we guessed wrong, so decode using the other byte order
$fmt =~ tr/nvNV/vnVN/;
@uni = unpack($fmt, $val);
$$et{WrongByteOrder} = 1;
}
}
# handle surrogate pairs of UTF-16
if ($charset eq 'UTF16') {
my $i;
for ($i=0; $i<$#uni; ++$i) {
next unless ($uni[$i] & 0xfc00) == 0xd800 and
($uni[$i+1] & 0xfc00) == 0xdc00;
my $cp = 0x10000 + (($uni[$i] & 0x3ff) << 10) + ($uni[$i+1] & 0x3ff);
splice(@uni, $i, 2, $cp);
}
}
} elsif ($unknown) {
# count encoding errors as we do the translation
my $e1 = 0;
foreach (@uni) {
defined $$conv{$_} and $_ = $$conv{$_}, next;
++$e1;
}
# try the other byte order if we had any errors
if ($e1) {
$fmt = $byteOrder eq 'MM' ? 'v*' : 'n*'; #(reversed)
my @try = unpack($fmt, $val);
my $e2 = 0;
foreach (@try) {
defined $$conv{$_} and $_ = $$conv{$_}, next;
++$e2;
}
# use this byte order if there are fewer errors
if ($e2 < $e1) {
$$et{WrongByteOrder} = 1;
return \@try;
}
}
} else {
# translate any characters found in the lookup
foreach (@uni) {
$_ = $$conv{$_} if defined $$conv{$_};
}
}
} else { # variable-width characters
# unpack into bytes
my @bytes = unpack('C*', $val);
while (@bytes) {
my $ch = shift @bytes;
my $cv = $$conv{$ch};
# pass straight through if no translation
$cv or push(@uni, $ch), next;
# byte translates into single Unicode character
ref $cv or push(@uni, $cv), next;
# byte maps into multiple Unicode characters
ref $cv eq 'ARRAY' and push(@uni, @$cv), next;
# handle 2-byte character codes
$ch = shift @bytes;
if (defined $ch) {
if ($$cv{$ch}) {
$cv = $$cv{$ch};
ref $cv or push(@uni, $cv), next;
push @uni, @$cv; # multiple Unicode characters
} else {
push @uni, ord('?'); # encoding error
unshift @bytes, $ch;
}
} else {
push @uni, ord('?'); # encoding error
}
}
}
return \@uni;
}
#------------------------------------------------------------------------------
# Convert array of code point integers into a string with specified encoding
# Inputs: 0) ExifTool ref (or undef), 1) unicode character array ref,
# 2) character set (note: not all types are supported)
# 3) byte order ('MM' or 'II', multi-byte sets only, defaults to current byte order)
# Returns: converted string (truncated at null character if it exists), empty on error
# Notes: converts elements of input character array to new code points
# - ExifTool ref may be undef provided $charset is defined
sub Recompose($$;$$)
{
local $_;
my ($et, $uni, $charset) = @_; # ($byteOrder assigned later if required)
my ($outVal, $conv, $inv);
$charset or $charset = $$et{OPTIONS}{Charset};
my $csType = $csType{$charset};
if ($csType == 0x100) { # UTF8 (also treat ASCII as UTF8)
if ($] >= 5.006001) {
# let Perl do it
$outVal = pack('C0U*', @$uni);
} else {
# do it ourself
$outVal = Image::ExifTool::PackUTF8(@$uni);
}
$outVal =~ s/\0.*//s; # truncate at null terminator
return $outVal;
}
# get references to forward and inverse lookup tables
if ($csType & 0x801) {
$conv = LoadCharset($charset);
unless ($conv) {
$et->Warn("Missing charset $charset") if $et;
return '';
}
$inv = $unicode2byte{$charset};
# generate inverse lookup if necessary
unless ($inv) {
if (not $csType or $csType & 0x802) {
$et->Warn("Invalid destination charset $charset") if $et;
return '';
}
# prepare table to convert from Unicode to 1-byte characters
my ($char, %inv);
foreach $char (keys %$conv) {
$inv{$$conv{$char}} = $char;
}
$inv = $unicode2byte{$charset} = \%inv;
}
}
if ($csType & 0x100) { # 1-byte fixed-width
# convert to specified character set
foreach (@$uni) {
next if $_ < 0x80;
$$inv{$_} and $_ = $$inv{$_}, next;
# our tables omit 1-byte characters with the same values as Unicode,
# so pass them straight through after making sure there isn't a
# different character with this byte value
next if $_ < 0x100 and not $$conv{$_};
$_ = ord('?'); # set invalid characters to '?'
if ($et and not $$et{EncodingError}) {
$et->Warn("Some character(s) could not be encoded in $charset");
$$et{EncodingError} = 1;
}
}
# repack as an 8-bit string and truncate at null
$outVal = pack('C*', @$uni);
$outVal =~ s/\0.*//s;
} else { # 2-byte and 4-byte fixed-width
# convert if required
if ($inv) {
$$inv{$_} and $_ = $$inv{$_} foreach @$uni;
}
# generate surrogate pairs of UTF-16
if ($charset eq 'UTF16') {
my $i;
for ($i=0; $i<@$uni; ++$i) {
next unless $$uni[$i] >= 0x10000 and $$uni[$i] < 0x10ffff;
my $t = $$uni[$i] - 0x10000;
my $w1 = 0xd800 + (($t >> 10) & 0x3ff);
my $w2 = 0xdc00 + ($t & 0x3ff);
splice(@$uni, $i, 1, $w1, $w2);
++$i; # skip surrogate pair
}
}
# pack as 2- or 4-byte integer in specified byte order
my $byteOrder = $_[3] || GetByteOrder();
my $fmt = $byteOrder eq 'MM' ? 'n*' : 'v*';
$fmt = uc($fmt) if $csType & 0x400;
$outVal = pack($fmt, @$uni);
}
return $outVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Charset - ExifTool character encoding routines
=head1 SYNOPSIS
This module is required by Image::ExifTool.
=head1 DESCRIPTION
This module contains routines used by ExifTool to translate special
character sets. Currently, the following character sets are supported:
UTF8, UTF16, UCS2, UCS4, Arabic, Baltic, Cyrillic, Greek, Hebrew, JIS,
Latin, Latin2, DOSLatinUS, DOSLatin1, MacArabic, MacChineseCN,
MacChineseTW, MacCroatian, MacCyrillic, MacGreek, MacHebrew, MacIceland,
MacJapanese, MacKorean, MacLatin2, MacRSymbol, MacRoman, MacRomanian,
MacThai, MacTurkish, PDFDoc, RSymbol, ShiftJIS, Symbol, Thai, Turkish,
Vietnam
However, only some of these character sets are available to the user via
ExifTool options -- the multi-byte character sets are used only internally
when decoding certain types of information.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,39 @@
#------------------------------------------------------------------------------
# File: Arabic.pm
#
# Description: cp1256 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1256.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Arabic = (
0x80 => 0x20ac, 0x81 => 0x067e, 0x82 => 0x201a, 0x83 => 0x0192,
0x84 => 0x201e, 0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021,
0x88 => 0x02c6, 0x89 => 0x2030, 0x8a => 0x0679, 0x8b => 0x2039,
0x8c => 0x0152, 0x8d => 0x0686, 0x8e => 0x0698, 0x8f => 0x0688,
0x90 => 0x06af, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x98 => 0x06a9, 0x99 => 0x2122, 0x9a => 0x0691, 0x9b => 0x203a,
0x9c => 0x0153, 0x9d => 0x200c, 0x9e => 0x200d, 0x9f => 0x06ba,
0xa1 => 0x060c, 0xaa => 0x06be, 0xba => 0x061b, 0xbf => 0x061f,
0xc0 => 0x06c1, 0xc1 => 0x0621, 0xc2 => 0x0622, 0xc3 => 0x0623,
0xc4 => 0x0624, 0xc5 => 0x0625, 0xc6 => 0x0626, 0xc7 => 0x0627,
0xc8 => 0x0628, 0xc9 => 0x0629, 0xca => 0x062a, 0xcb => 0x062b,
0xcc => 0x062c, 0xcd => 0x062d, 0xce => 0x062e, 0xcf => 0x062f,
0xd0 => 0x0630, 0xd1 => 0x0631, 0xd2 => 0x0632, 0xd3 => 0x0633,
0xd4 => 0x0634, 0xd5 => 0x0635, 0xd6 => 0x0636, 0xd8 => 0x0637,
0xd9 => 0x0638, 0xda => 0x0639, 0xdb => 0x063a, 0xdc => 0x0640,
0xdd => 0x0641, 0xde => 0x0642, 0xdf => 0x0643, 0xe1 => 0x0644,
0xe3 => 0x0645, 0xe4 => 0x0646, 0xe5 => 0x0647, 0xe6 => 0x0648,
0xec => 0x0649, 0xed => 0x064a, 0xf0 => 0x064b, 0xf1 => 0x064c,
0xf2 => 0x064d, 0xf3 => 0x064e, 0xf5 => 0x064f, 0xf6 => 0x0650,
0xf8 => 0x0651, 0xfa => 0x0652, 0xfd => 0x200e, 0xfe => 0x200f,
0xff => 0x06d2,
);
1; # end

View File

@@ -0,0 +1,35 @@
#------------------------------------------------------------------------------
# File: Baltic.pm
#
# Description: cp1257 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1257.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Baltic = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x84 => 0x201e, 0x85 => 0x2026,
0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030, 0x8b => 0x2039, 0x8d => 0xa8,
0x8e => 0x02c7, 0x8f => 0xb8, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x99 => 0x2122, 0x9b => 0x203a, 0x9d => 0xaf, 0x9e => 0x02db, 0xa8 => 0xd8,
0xaa => 0x0156, 0xaf => 0xc6, 0xb8 => 0xf8, 0xba => 0x0157, 0xbf => 0xe6,
0xc0 => 0x0104, 0xc1 => 0x012e, 0xc2 => 0x0100, 0xc3 => 0x0106,
0xc6 => 0x0118, 0xc7 => 0x0112, 0xc8 => 0x010c, 0xca => 0x0179,
0xcb => 0x0116, 0xcc => 0x0122, 0xcd => 0x0136, 0xce => 0x012a,
0xcf => 0x013b, 0xd0 => 0x0160, 0xd1 => 0x0143, 0xd2 => 0x0145,
0xd4 => 0x014c, 0xd8 => 0x0172, 0xd9 => 0x0141, 0xda => 0x015a,
0xdb => 0x016a, 0xdd => 0x017b, 0xde => 0x017d, 0xe0 => 0x0105,
0xe1 => 0x012f, 0xe2 => 0x0101, 0xe3 => 0x0107, 0xe6 => 0x0119,
0xe7 => 0x0113, 0xe8 => 0x010d, 0xea => 0x017a, 0xeb => 0x0117,
0xec => 0x0123, 0xed => 0x0137, 0xee => 0x012b, 0xef => 0x013c,
0xf0 => 0x0161, 0xf1 => 0x0144, 0xf2 => 0x0146, 0xf4 => 0x014d,
0xf8 => 0x0173, 0xf9 => 0x0142, 0xfa => 0x015b, 0xfb => 0x016b,
0xfd => 0x017c, 0xfe => 0x017e, 0xff => 0x02d9,
);
1; # end

View File

@@ -0,0 +1,45 @@
#------------------------------------------------------------------------------
# File: Cyrillic.pm
#
# Description: cp1251 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1251.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Cyrillic = (
0x80 => 0x0402, 0x81 => 0x0403, 0x82 => 0x201a, 0x83 => 0x0453,
0x84 => 0x201e, 0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021,
0x88 => 0x20ac, 0x89 => 0x2030, 0x8a => 0x0409, 0x8b => 0x2039,
0x8c => 0x040a, 0x8d => 0x040c, 0x8e => 0x040b, 0x8f => 0x040f,
0x90 => 0x0452, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x99 => 0x2122, 0x9a => 0x0459, 0x9b => 0x203a, 0x9c => 0x045a,
0x9d => 0x045c, 0x9e => 0x045b, 0x9f => 0x045f, 0xa1 => 0x040e,
0xa2 => 0x045e, 0xa3 => 0x0408, 0xa5 => 0x0490, 0xa8 => 0x0401,
0xaa => 0x0404, 0xaf => 0x0407, 0xb2 => 0x0406, 0xb3 => 0x0456,
0xb4 => 0x0491, 0xb8 => 0x0451, 0xb9 => 0x2116, 0xba => 0x0454,
0xbc => 0x0458, 0xbd => 0x0405, 0xbe => 0x0455, 0xbf => 0x0457,
0xc0 => 0x0410, 0xc1 => 0x0411, 0xc2 => 0x0412, 0xc3 => 0x0413,
0xc4 => 0x0414, 0xc5 => 0x0415, 0xc6 => 0x0416, 0xc7 => 0x0417,
0xc8 => 0x0418, 0xc9 => 0x0419, 0xca => 0x041a, 0xcb => 0x041b,
0xcc => 0x041c, 0xcd => 0x041d, 0xce => 0x041e, 0xcf => 0x041f,
0xd0 => 0x0420, 0xd1 => 0x0421, 0xd2 => 0x0422, 0xd3 => 0x0423,
0xd4 => 0x0424, 0xd5 => 0x0425, 0xd6 => 0x0426, 0xd7 => 0x0427,
0xd8 => 0x0428, 0xd9 => 0x0429, 0xda => 0x042a, 0xdb => 0x042b,
0xdc => 0x042c, 0xdd => 0x042d, 0xde => 0x042e, 0xdf => 0x042f,
0xe0 => 0x0430, 0xe1 => 0x0431, 0xe2 => 0x0432, 0xe3 => 0x0433,
0xe4 => 0x0434, 0xe5 => 0x0435, 0xe6 => 0x0436, 0xe7 => 0x0437,
0xe8 => 0x0438, 0xe9 => 0x0439, 0xea => 0x043a, 0xeb => 0x043b,
0xec => 0x043c, 0xed => 0x043d, 0xee => 0x043e, 0xef => 0x043f,
0xf0 => 0x0440, 0xf1 => 0x0441, 0xf2 => 0x0442, 0xf3 => 0x0443,
0xf4 => 0x0444, 0xf5 => 0x0445, 0xf6 => 0x0446, 0xf7 => 0x0447,
0xf8 => 0x0448, 0xf9 => 0x0449, 0xfa => 0x044a, 0xfb => 0x044b,
0xfc => 0x044c, 0xfd => 0x044d, 0xfe => 0x044e, 0xff => 0x044f,
);
1; # end

View File

@@ -0,0 +1,49 @@
#------------------------------------------------------------------------------
# File: DOSLatin1.pm
#
# Description: cp850 to Unicode
#
# Revisions: 2017/10/31- P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/PC/CP850.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::DOSLatin1 = (
0x80 => 0x00c7, 0x81 => 0x00fc, 0x82 => 0x00e9, 0x83 => 0x00e2,
0x84 => 0x00e4, 0x85 => 0x00e0, 0x86 => 0x00e5, 0x87 => 0x00e7,
0x88 => 0x00ea, 0x89 => 0x00eb, 0x8a => 0x00e8, 0x8b => 0x00ef,
0x8c => 0x00ee, 0x8d => 0x00ec, 0x8e => 0x00c4, 0x8f => 0x00c5,
0x90 => 0x00c9, 0x91 => 0x00e6, 0x92 => 0x00c6, 0x93 => 0x00f4,
0x94 => 0x00f6, 0x95 => 0x00f2, 0x96 => 0x00fb, 0x97 => 0x00f9,
0x98 => 0x00ff, 0x99 => 0x00d6, 0x9a => 0x00dc, 0x9b => 0x00f8,
0x9c => 0x00a3, 0x9d => 0x00d8, 0x9e => 0x00d7, 0x9f => 0x0192,
0xa0 => 0x00e1, 0xa1 => 0x00ed, 0xa2 => 0x00f3, 0xa3 => 0x00fa,
0xa4 => 0x00f1, 0xa5 => 0x00d1, 0xa6 => 0x00aa, 0xa7 => 0x00ba,
0xa8 => 0x00bf, 0xa9 => 0x00ae, 0xaa => 0x00ac, 0xab => 0x00bd,
0xac => 0x00bc, 0xad => 0x00a1, 0xae => 0x00ab, 0xaf => 0x00bb,
0xb0 => 0x2591, 0xb1 => 0x2592, 0xb2 => 0x2593, 0xb3 => 0x2502,
0xb4 => 0x2524, 0xb5 => 0x00c1, 0xb6 => 0x00c2, 0xb7 => 0x00c0,
0xb8 => 0x00a9, 0xb9 => 0x2563, 0xba => 0x2551, 0xbb => 0x2557,
0xbc => 0x255d, 0xbd => 0x00a2, 0xbe => 0x00a5, 0xbf => 0x2510,
0xc0 => 0x2514, 0xc1 => 0x2534, 0xc2 => 0x252c, 0xc3 => 0x251c,
0xc4 => 0x2500, 0xc5 => 0x253c, 0xc6 => 0x00e3, 0xc7 => 0x00c3,
0xc8 => 0x255a, 0xc9 => 0x2554, 0xca => 0x2569, 0xcb => 0x2566,
0xcc => 0x2560, 0xcd => 0x2550, 0xce => 0x256c, 0xcf => 0x00a4,
0xd0 => 0x00f0, 0xd1 => 0x00d0, 0xd2 => 0x00ca, 0xd3 => 0x00cb,
0xd4 => 0x00c8, 0xd5 => 0x0131, 0xd6 => 0x00cd, 0xd7 => 0x00ce,
0xd8 => 0x00cf, 0xd9 => 0x2518, 0xda => 0x250c, 0xdb => 0x2588,
0xdc => 0x2584, 0xdd => 0x00a6, 0xde => 0x00cc, 0xdf => 0x2580,
0xe0 => 0x00d3, 0xe1 => 0x00df, 0xe2 => 0x00d4, 0xe3 => 0x00d2,
0xe4 => 0x00f5, 0xe5 => 0x00d5, 0xe6 => 0x00b5, 0xe7 => 0x00fe,
0xe8 => 0x00de, 0xe9 => 0x00da, 0xea => 0x00db, 0xeb => 0x00d9,
0xec => 0x00fd, 0xed => 0x00dd, 0xee => 0x00af, 0xef => 0x00b4,
0xf0 => 0x00ad, 0xf1 => 0x00b1, 0xf2 => 0x2017, 0xf3 => 0x00be,
0xf4 => 0x00b6, 0xf5 => 0x00a7, 0xf6 => 0x00f7, 0xf7 => 0x00b8,
0xf8 => 0x00b0, 0xf9 => 0x00a8, 0xfa => 0x00b7, 0xfb => 0x00b9,
0xfc => 0x00b3, 0xfd => 0x00b2, 0xfe => 0x25a0, 0xff => 0x00a0,
);
1; # end

View File

@@ -0,0 +1,49 @@
#------------------------------------------------------------------------------
# File: DOSLatinUS.pm
#
# Description: cp437 to Unicode
#
# Revisions: 2017/10/31- P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/PC/CP437.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::DOSLatinUS = (
0x80 => 0x00c7, 0x81 => 0x00fc, 0x82 => 0x00e9, 0x83 => 0x00e2,
0x84 => 0x00e4, 0x85 => 0x00e0, 0x86 => 0x00e5, 0x87 => 0x00e7,
0x88 => 0x00ea, 0x89 => 0x00eb, 0x8a => 0x00e8, 0x8b => 0x00ef,
0x8c => 0x00ee, 0x8d => 0x00ec, 0x8e => 0x00c4, 0x8f => 0x00c5,
0x90 => 0x00c9, 0x91 => 0x00e6, 0x92 => 0x00c6, 0x93 => 0x00f4,
0x94 => 0x00f6, 0x95 => 0x00f2, 0x96 => 0x00fb, 0x97 => 0x00f9,
0x98 => 0x00ff, 0x99 => 0x00d6, 0x9a => 0x00dc, 0x9b => 0x00a2,
0x9c => 0x00a3, 0x9d => 0x00a5, 0x9e => 0x20a7, 0x9f => 0x0192,
0xa0 => 0x00e1, 0xa1 => 0x00ed, 0xa2 => 0x00f3, 0xa3 => 0x00fa,
0xa4 => 0x00f1, 0xa5 => 0x00d1, 0xa6 => 0x00aa, 0xa7 => 0x00ba,
0xa8 => 0x00bf, 0xa9 => 0x2310, 0xaa => 0x00ac, 0xab => 0x00bd,
0xac => 0x00bc, 0xad => 0x00a1, 0xae => 0x00ab, 0xaf => 0x00bb,
0xb0 => 0x2591, 0xb1 => 0x2592, 0xb2 => 0x2593, 0xb3 => 0x2502,
0xb4 => 0x2524, 0xb5 => 0x2561, 0xb6 => 0x2562, 0xb7 => 0x2556,
0xb8 => 0x2555, 0xb9 => 0x2563, 0xba => 0x2551, 0xbb => 0x2557,
0xbc => 0x255d, 0xbd => 0x255c, 0xbe => 0x255b, 0xbf => 0x2510,
0xc0 => 0x2514, 0xc1 => 0x2534, 0xc2 => 0x252c, 0xc3 => 0x251c,
0xc4 => 0x2500, 0xc5 => 0x253c, 0xc6 => 0x255e, 0xc7 => 0x255f,
0xc8 => 0x255a, 0xc9 => 0x2554, 0xca => 0x2569, 0xcb => 0x2566,
0xcc => 0x2560, 0xcd => 0x2550, 0xce => 0x256c, 0xcf => 0x2567,
0xd0 => 0x2568, 0xd1 => 0x2564, 0xd2 => 0x2565, 0xd3 => 0x2559,
0xd4 => 0x2558, 0xd5 => 0x2552, 0xd6 => 0x2553, 0xd7 => 0x256b,
0xd8 => 0x256a, 0xd9 => 0x2518, 0xda => 0x250c, 0xdb => 0x2588,
0xdc => 0x2584, 0xdd => 0x258c, 0xde => 0x2590, 0xdf => 0x2580,
0xe0 => 0x03b1, 0xe1 => 0x00df, 0xe2 => 0x0393, 0xe3 => 0x03c0,
0xe4 => 0x03a3, 0xe5 => 0x03c3, 0xe6 => 0x00b5, 0xe7 => 0x03c4,
0xe8 => 0x03a6, 0xe9 => 0x0398, 0xea => 0x03a9, 0xeb => 0x03b4,
0xec => 0x221e, 0xed => 0x03c6, 0xee => 0x03b5, 0xef => 0x2229,
0xf0 => 0x2261, 0xf1 => 0x00b1, 0xf2 => 0x2265, 0xf3 => 0x2264,
0xf4 => 0x2320, 0xf5 => 0x2321, 0xf6 => 0x00f7, 0xf7 => 0x2248,
0xf8 => 0x00b0, 0xf9 => 0x2219, 0xfa => 0x00b7, 0xfb => 0x221a,
0xfc => 0x207f, 0xfd => 0x00b2, 0xfe => 0x25a0, 0xff => 0x00a0,
);
1; # end

View File

@@ -0,0 +1,40 @@
#------------------------------------------------------------------------------
# File: Greek.pm
#
# Description: cp1253 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1253.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Greek = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030,
0x8b => 0x2039, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x99 => 0x2122, 0x9b => 0x203a, 0xa1 => 0x0385, 0xa2 => 0x0386,
0xaf => 0x2015, 0xb4 => 0x0384, 0xb8 => 0x0388, 0xb9 => 0x0389,
0xba => 0x038a, 0xbc => 0x038c, 0xbe => 0x038e, 0xbf => 0x038f,
0xc0 => 0x0390, 0xc1 => 0x0391, 0xc2 => 0x0392, 0xc3 => 0x0393,
0xc4 => 0x0394, 0xc5 => 0x0395, 0xc6 => 0x0396, 0xc7 => 0x0397,
0xc8 => 0x0398, 0xc9 => 0x0399, 0xca => 0x039a, 0xcb => 0x039b,
0xcc => 0x039c, 0xcd => 0x039d, 0xce => 0x039e, 0xcf => 0x039f,
0xd0 => 0x03a0, 0xd1 => 0x03a1, 0xd3 => 0x03a3, 0xd4 => 0x03a4,
0xd5 => 0x03a5, 0xd6 => 0x03a6, 0xd7 => 0x03a7, 0xd8 => 0x03a8,
0xd9 => 0x03a9, 0xda => 0x03aa, 0xdb => 0x03ab, 0xdc => 0x03ac,
0xdd => 0x03ad, 0xde => 0x03ae, 0xdf => 0x03af, 0xe0 => 0x03b0,
0xe1 => 0x03b1, 0xe2 => 0x03b2, 0xe3 => 0x03b3, 0xe4 => 0x03b4,
0xe5 => 0x03b5, 0xe6 => 0x03b6, 0xe7 => 0x03b7, 0xe8 => 0x03b8,
0xe9 => 0x03b9, 0xea => 0x03ba, 0xeb => 0x03bb, 0xec => 0x03bc,
0xed => 0x03bd, 0xee => 0x03be, 0xef => 0x03bf, 0xf0 => 0x03c0,
0xf1 => 0x03c1, 0xf2 => 0x03c2, 0xf3 => 0x03c3, 0xf4 => 0x03c4,
0xf5 => 0x03c5, 0xf6 => 0x03c6, 0xf7 => 0x03c7, 0xf8 => 0x03c8,
0xf9 => 0x03c9, 0xfa => 0x03ca, 0xfb => 0x03cb, 0xfc => 0x03cc,
0xfd => 0x03cd, 0xfe => 0x03ce,
);
1; # end

View File

@@ -0,0 +1,36 @@
#------------------------------------------------------------------------------
# File: Hebrew.pm
#
# Description: cp1255 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1255.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Hebrew = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
0x89 => 0x2030, 0x8b => 0x2039, 0x91 => 0x2018, 0x92 => 0x2019,
0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013,
0x97 => 0x2014, 0x98 => 0x02dc, 0x99 => 0x2122, 0x9b => 0x203a,
0xa4 => 0x20aa, 0xaa => 0xd7, 0xba => 0xf7, 0xc0 => 0x05b0, 0xc1 => 0x05b1,
0xc2 => 0x05b2, 0xc3 => 0x05b3, 0xc4 => 0x05b4, 0xc5 => 0x05b5,
0xc6 => 0x05b6, 0xc7 => 0x05b7, 0xc8 => 0x05b8, 0xc9 => 0x05b9,
0xcb => 0x05bb, 0xcc => 0x05bc, 0xcd => 0x05bd, 0xce => 0x05be,
0xcf => 0x05bf, 0xd0 => 0x05c0, 0xd1 => 0x05c1, 0xd2 => 0x05c2,
0xd3 => 0x05c3, 0xd4 => 0x05f0, 0xd5 => 0x05f1, 0xd6 => 0x05f2,
0xd7 => 0x05f3, 0xd8 => 0x05f4, 0xe0 => 0x05d0, 0xe1 => 0x05d1,
0xe2 => 0x05d2, 0xe3 => 0x05d3, 0xe4 => 0x05d4, 0xe5 => 0x05d5,
0xe6 => 0x05d6, 0xe7 => 0x05d7, 0xe8 => 0x05d8, 0xe9 => 0x05d9,
0xea => 0x05da, 0xeb => 0x05db, 0xec => 0x05dc, 0xed => 0x05dd,
0xee => 0x05de, 0xef => 0x05df, 0xf0 => 0x05e0, 0xf1 => 0x05e1,
0xf2 => 0x05e2, 0xf3 => 0x05e3, 0xf4 => 0x05e4, 0xf5 => 0x05e5,
0xf6 => 0x05e6, 0xf7 => 0x05e7, 0xf8 => 0x05e8, 0xf9 => 0x05e9,
0xfa => 0x05ea, 0xfd => 0x200e, 0xfe => 0x200f,
);
1; # end

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,24 @@
#------------------------------------------------------------------------------
# File: Latin.pm
#
# Description: cp1252 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1252.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Latin = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
0x89 => 0x2030, 0x8a => 0x0160, 0x8b => 0x2039, 0x8c => 0x0152,
0x8e => 0x017d, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x98 => 0x02dc, 0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a,
0x9c => 0x0153, 0x9e => 0x017e, 0x9f => 0x0178,
);
1; # end

View File

@@ -0,0 +1,36 @@
#------------------------------------------------------------------------------
# File: Latin2.pm
#
# Description: cp1250 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1250.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Latin2 = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x84 => 0x201e, 0x85 => 0x2026,
0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030, 0x8a => 0x0160,
0x8b => 0x2039, 0x8c => 0x015a, 0x8d => 0x0164, 0x8e => 0x017d,
0x8f => 0x0179, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a, 0x9c => 0x015b,
0x9d => 0x0165, 0x9e => 0x017e, 0x9f => 0x017a, 0xa1 => 0x02c7,
0xa2 => 0x02d8, 0xa3 => 0x0141, 0xa5 => 0x0104, 0xaa => 0x015e,
0xaf => 0x017b, 0xb2 => 0x02db, 0xb3 => 0x0142, 0xb9 => 0x0105,
0xba => 0x015f, 0xbc => 0x013d, 0xbd => 0x02dd, 0xbe => 0x013e,
0xbf => 0x017c, 0xc0 => 0x0154, 0xc3 => 0x0102, 0xc5 => 0x0139,
0xc6 => 0x0106, 0xc8 => 0x010c, 0xca => 0x0118, 0xcc => 0x011a,
0xcf => 0x010e, 0xd0 => 0x0110, 0xd1 => 0x0143, 0xd2 => 0x0147,
0xd5 => 0x0150, 0xd8 => 0x0158, 0xd9 => 0x016e, 0xdb => 0x0170,
0xde => 0x0162, 0xe0 => 0x0155, 0xe3 => 0x0103, 0xe5 => 0x013a,
0xe6 => 0x0107, 0xe8 => 0x010d, 0xea => 0x0119, 0xec => 0x011b,
0xef => 0x010f, 0xf0 => 0x0111, 0xf1 => 0x0144, 0xf2 => 0x0148,
0xf5 => 0x0151, 0xf8 => 0x0159, 0xf9 => 0x016f, 0xfb => 0x0171,
0xfe => 0x0163, 0xff => 0x02d9,
);
1; # end

View File

@@ -0,0 +1,47 @@
#------------------------------------------------------------------------------
# File: MacArabic.pm
#
# Description: Mac Arabic to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ARABIC.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
# and directional characters are ignored
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacArabic = (
0x80 => 0xc4, 0x81 => 0xa0, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0x06ba, 0x8c => 0xab, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0x2026,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xbb,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf7, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x20, 0xa1 => 0x21, 0xa2 => 0x22,
0xa3 => 0x23, 0xa4 => 0x24, 0xa5 => 0x066a, 0xa6 => 0x26, 0xa7 => 0x27,
0xa8 => 0x28, 0xa9 => 0x29, 0xaa => 0x2a, 0xab => 0x2b, 0xac => 0x060c,
0xad => 0x2d, 0xae => 0x2e, 0xaf => 0x2f, 0xb0 => 0x0660, 0xb1 => 0x0661,
0xb2 => 0x0662, 0xb3 => 0x0663, 0xb4 => 0x0664, 0xb5 => 0x0665,
0xb6 => 0x0666, 0xb7 => 0x0667, 0xb8 => 0x0668, 0xb9 => 0x0669, 0xba => 0x3a,
0xbb => 0x061b, 0xbc => 0x3c, 0xbd => 0x3d, 0xbe => 0x3e, 0xbf => 0x061f,
0xc0 => 0x274a, 0xc1 => 0x0621, 0xc2 => 0x0622, 0xc3 => 0x0623,
0xc4 => 0x0624, 0xc5 => 0x0625, 0xc6 => 0x0626, 0xc7 => 0x0627,
0xc8 => 0x0628, 0xc9 => 0x0629, 0xca => 0x062a, 0xcb => 0x062b,
0xcc => 0x062c, 0xcd => 0x062d, 0xce => 0x062e, 0xcf => 0x062f,
0xd0 => 0x0630, 0xd1 => 0x0631, 0xd2 => 0x0632, 0xd3 => 0x0633,
0xd4 => 0x0634, 0xd5 => 0x0635, 0xd6 => 0x0636, 0xd7 => 0x0637,
0xd8 => 0x0638, 0xd9 => 0x0639, 0xda => 0x063a, 0xdb => 0x5b, 0xdc => 0x5c,
0xdd => 0x5d, 0xde => 0x5e, 0xdf => 0x5f, 0xe0 => 0x0640, 0xe1 => 0x0641,
0xe2 => 0x0642, 0xe3 => 0x0643, 0xe4 => 0x0644, 0xe5 => 0x0645,
0xe6 => 0x0646, 0xe7 => 0x0647, 0xe8 => 0x0648, 0xe9 => 0x0649,
0xea => 0x064a, 0xeb => 0x064b, 0xec => 0x064c, 0xed => 0x064d,
0xee => 0x064e, 0xef => 0x064f, 0xf0 => 0x0650, 0xf1 => 0x0651,
0xf2 => 0x0652, 0xf3 => 0x067e, 0xf4 => 0x0679, 0xf5 => 0x0686,
0xf6 => 0x06d5, 0xf7 => 0x06a4, 0xf8 => 0x06af, 0xf9 => 0x0688,
0xfa => 0x0691, 0xfb => 0x7b, 0xfc => 0x7c, 0xfd => 0x7d, 0xfe => 0x0698,
0xff => 0x06d2,
);
1; # end

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,43 @@
#------------------------------------------------------------------------------
# File: MacCroatian.pm
#
# Description: Mac Croatian to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CROATIAN.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacCroatian = (
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xa9 => 0x0160,
0xaa => 0x2122, 0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x017d,
0xaf => 0xd8, 0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0x2206,
0xb6 => 0x2202, 0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x0161,
0xba => 0x222b, 0xbb => 0xaa, 0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0x017e,
0xbf => 0xf8, 0xc0 => 0xbf, 0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a,
0xc4 => 0x0192, 0xc5 => 0x2248, 0xc6 => 0x0106, 0xc7 => 0xab, 0xc8 => 0x010c,
0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5,
0xce => 0x0152, 0xcf => 0x0153, 0xd0 => 0x0110, 0xd1 => 0x2014,
0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7,
0xd7 => 0x25ca, 0xd8 => 0xf8ff, 0xd9 => 0xa9, 0xda => 0x2044, 0xdb => 0x20ac,
0xdc => 0x2039, 0xdd => 0x203a, 0xde => 0xc6, 0xdf => 0xbb, 0xe0 => 0x2013,
0xe1 => 0xb7, 0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2,
0xe6 => 0x0107, 0xe7 => 0xc1, 0xe8 => 0x010d, 0xe9 => 0xc8, 0xea => 0xcd,
0xeb => 0xce, 0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4,
0xf0 => 0x0111, 0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9,
0xf5 => 0x0131, 0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x03c0,
0xfa => 0xcb, 0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0xca, 0xfe => 0xe6,
0xff => 0x02c7,
);
1; # end

View File

@@ -0,0 +1,47 @@
#------------------------------------------------------------------------------
# File: MacCyrillic.pm
#
# Description: Mac Cyrillic to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CYRILLIC.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacCyrillic = (
0x80 => 0x0410, 0x81 => 0x0411, 0x82 => 0x0412, 0x83 => 0x0413,
0x84 => 0x0414, 0x85 => 0x0415, 0x86 => 0x0416, 0x87 => 0x0417,
0x88 => 0x0418, 0x89 => 0x0419, 0x8a => 0x041a, 0x8b => 0x041b,
0x8c => 0x041c, 0x8d => 0x041d, 0x8e => 0x041e, 0x8f => 0x041f,
0x90 => 0x0420, 0x91 => 0x0421, 0x92 => 0x0422, 0x93 => 0x0423,
0x94 => 0x0424, 0x95 => 0x0425, 0x96 => 0x0426, 0x97 => 0x0427,
0x98 => 0x0428, 0x99 => 0x0429, 0x9a => 0x042a, 0x9b => 0x042b,
0x9c => 0x042c, 0x9d => 0x042d, 0x9e => 0x042e, 0x9f => 0x042f,
0xa0 => 0x2020, 0xa1 => 0xb0, 0xa2 => 0x0490, 0xa4 => 0xa7, 0xa5 => 0x2022,
0xa6 => 0xb6, 0xa7 => 0x0406, 0xa8 => 0xae, 0xaa => 0x2122, 0xab => 0x0402,
0xac => 0x0452, 0xad => 0x2260, 0xae => 0x0403, 0xaf => 0x0453,
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0x0456,
0xb6 => 0x0491, 0xb7 => 0x0408, 0xb8 => 0x0404, 0xb9 => 0x0454,
0xba => 0x0407, 0xbb => 0x0457, 0xbc => 0x0409, 0xbd => 0x0459,
0xbe => 0x040a, 0xbf => 0x045a, 0xc0 => 0x0458, 0xc1 => 0x0405, 0xc2 => 0xac,
0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248, 0xc6 => 0x2206, 0xc7 => 0xab,
0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x040b, 0xcc => 0x045b,
0xcd => 0x040c, 0xce => 0x045c, 0xcf => 0x0455, 0xd0 => 0x2013,
0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018,
0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x201e, 0xd8 => 0x040e, 0xd9 => 0x045e,
0xda => 0x040f, 0xdb => 0x045f, 0xdc => 0x2116, 0xdd => 0x0401,
0xde => 0x0451, 0xdf => 0x044f, 0xe0 => 0x0430, 0xe1 => 0x0431,
0xe2 => 0x0432, 0xe3 => 0x0433, 0xe4 => 0x0434, 0xe5 => 0x0435,
0xe6 => 0x0436, 0xe7 => 0x0437, 0xe8 => 0x0438, 0xe9 => 0x0439,
0xea => 0x043a, 0xeb => 0x043b, 0xec => 0x043c, 0xed => 0x043d,
0xee => 0x043e, 0xef => 0x043f, 0xf0 => 0x0440, 0xf1 => 0x0441,
0xf2 => 0x0442, 0xf3 => 0x0443, 0xf4 => 0x0444, 0xf5 => 0x0445,
0xf6 => 0x0446, 0xf7 => 0x0447, 0xf8 => 0x0448, 0xf9 => 0x0449,
0xfa => 0x044a, 0xfb => 0x044b, 0xfc => 0x044c, 0xfd => 0x044d,
0xfe => 0x044e, 0xff => 0x20ac,
);
1; # end

View File

@@ -0,0 +1,45 @@
#------------------------------------------------------------------------------
# File: MacGreek.pm
#
# Description: Mac Greek to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/GREEK.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacGreek = (
0x80 => 0xc4, 0x81 => 0xb9, 0x82 => 0xb2, 0x83 => 0xc9, 0x84 => 0xb3,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0x0385, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0x0384, 0x8c => 0xa8, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xa3, 0x93 => 0x2122,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0x2022, 0x97 => 0xbd, 0x98 => 0x2030,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xa6, 0x9c => 0x20ac, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0x0393, 0xa2 => 0x0394,
0xa3 => 0x0398, 0xa4 => 0x039b, 0xa5 => 0x039e, 0xa6 => 0x03a0, 0xa7 => 0xdf,
0xa8 => 0xae, 0xaa => 0x03a3, 0xab => 0x03aa, 0xac => 0xa7, 0xad => 0x2260,
0xae => 0xb0, 0xaf => 0xb7, 0xb0 => 0x0391, 0xb2 => 0x2264, 0xb3 => 0x2265,
0xb4 => 0xa5, 0xb5 => 0x0392, 0xb6 => 0x0395, 0xb7 => 0x0396, 0xb8 => 0x0397,
0xb9 => 0x0399, 0xba => 0x039a, 0xbb => 0x039c, 0xbc => 0x03a6,
0xbd => 0x03ab, 0xbe => 0x03a8, 0xbf => 0x03a9, 0xc0 => 0x03ac,
0xc1 => 0x039d, 0xc2 => 0xac, 0xc3 => 0x039f, 0xc4 => 0x03a1, 0xc5 => 0x2248,
0xc6 => 0x03a4, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
0xcb => 0x03a5, 0xcc => 0x03a7, 0xcd => 0x0386, 0xce => 0x0388,
0xcf => 0x0153, 0xd0 => 0x2013, 0xd1 => 0x2015, 0xd2 => 0x201c,
0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x0389,
0xd8 => 0x038a, 0xd9 => 0x038c, 0xda => 0x038e, 0xdb => 0x03ad,
0xdc => 0x03ae, 0xdd => 0x03af, 0xde => 0x03cc, 0xdf => 0x038f,
0xe0 => 0x03cd, 0xe1 => 0x03b1, 0xe2 => 0x03b2, 0xe3 => 0x03c8,
0xe4 => 0x03b4, 0xe5 => 0x03b5, 0xe6 => 0x03c6, 0xe7 => 0x03b3,
0xe8 => 0x03b7, 0xe9 => 0x03b9, 0xea => 0x03be, 0xeb => 0x03ba,
0xec => 0x03bb, 0xed => 0x03bc, 0xee => 0x03bd, 0xef => 0x03bf,
0xf0 => 0x03c0, 0xf1 => 0x03ce, 0xf2 => 0x03c1, 0xf3 => 0x03c3,
0xf4 => 0x03c4, 0xf5 => 0x03b8, 0xf6 => 0x03c9, 0xf7 => 0x03c2,
0xf8 => 0x03c7, 0xf9 => 0x03c5, 0xfa => 0x03b6, 0xfb => 0x03ca,
0xfc => 0x03cb, 0xfd => 0x0390, 0xfe => 0x03b0, 0xff => 0xad,
);
1; # end

View File

@@ -0,0 +1,47 @@
#------------------------------------------------------------------------------
# File: MacHebrew.pm
#
# Description: Mac Hebrew to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/HEBREW.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
# and directional characters are ignored
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacHebrew = (
0x80 => 0xc4, 0x81 => [0x05f2,0x05b7], 0x82 => 0xc7, 0x83 => 0xc9,
0x84 => 0xd1, 0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0,
0x89 => 0xe2, 0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7,
0x8e => 0xe9, 0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed,
0x93 => 0xec, 0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3,
0x98 => 0xf2, 0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa,
0x9d => 0xf9, 0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x20, 0xa1 => 0x21,
0xa2 => 0x22, 0xa3 => 0x23, 0xa4 => 0x24, 0xa5 => 0x25, 0xa6 => 0x20aa,
0xa7 => 0x27, 0xa8 => 0x29, 0xa9 => 0x28, 0xaa => 0x2a, 0xab => 0x2b,
0xac => 0x2c, 0xad => 0x2d, 0xae => 0x2e, 0xaf => 0x2f, 0xb0 => 0x30,
0xb1 => 0x31, 0xb2 => 0x32, 0xb3 => 0x33, 0xb4 => 0x34, 0xb5 => 0x35,
0xb6 => 0x36, 0xb7 => 0x37, 0xb8 => 0x38, 0xb9 => 0x39, 0xba => 0x3a,
0xbb => 0x3b, 0xbc => 0x3c, 0xbd => 0x3d, 0xbe => 0x3e, 0xbf => 0x3f,
0xc0 => [0xf86a,0x05dc,0x05b9], 0xc1 => 0x201e, 0xc2 => 0xf89b,
0xc3 => 0xf89c, 0xc4 => 0xf89d, 0xc5 => 0xf89e, 0xc6 => 0x05bc,
0xc7 => 0xfb4b, 0xc8 => 0xfb35, 0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x05b8,
0xcc => 0x05b7, 0xcd => 0x05b5, 0xce => 0x05b6, 0xcf => 0x05b4,
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xfb2a, 0xd7 => 0xfb2b,
0xd8 => 0x05bf, 0xd9 => 0x05b0, 0xda => 0x05b2, 0xdb => 0x05b1,
0xdc => 0x05bb, 0xdd => 0x05b9, 0xde => [0x05b8,0xf87f], 0xdf => 0x05b3,
0xe0 => 0x05d0, 0xe1 => 0x05d1, 0xe2 => 0x05d2, 0xe3 => 0x05d3,
0xe4 => 0x05d4, 0xe5 => 0x05d5, 0xe6 => 0x05d6, 0xe7 => 0x05d7,
0xe8 => 0x05d8, 0xe9 => 0x05d9, 0xea => 0x05da, 0xeb => 0x05db,
0xec => 0x05dc, 0xed => 0x05dd, 0xee => 0x05de, 0xef => 0x05df,
0xf0 => 0x05e0, 0xf1 => 0x05e1, 0xf2 => 0x05e2, 0xf3 => 0x05e3,
0xf4 => 0x05e4, 0xf5 => 0x05e5, 0xf6 => 0x05e6, 0xf7 => 0x05e7,
0xf8 => 0x05e8, 0xf9 => 0x05e9, 0xfa => 0x05ea, 0xfb => 0x7d, 0xfc => 0x5d,
0xfd => 0x7b, 0xfe => 0x5b, 0xff => 0x7c,
);
1; # end

View File

@@ -0,0 +1,42 @@
#------------------------------------------------------------------------------
# File: MacIceland.pm
#
# Description: Mac Icelandic to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ICELAND.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacIceland = (
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0xdd, 0xa1 => 0xb0, 0xa4 => 0xa7,
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0xd0, 0xdd => 0xf0,
0xdf => 0xfe, 0xe0 => 0xfd, 0xe1 => 0xb7, 0xe2 => 0x201a, 0xe3 => 0x201e,
0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca, 0xe7 => 0xc1, 0xe8 => 0xcb,
0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce, 0xec => 0xcf, 0xed => 0xcc,
0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff, 0xf1 => 0xd2, 0xf2 => 0xda,
0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131, 0xf6 => 0x02c6, 0xf7 => 0x02dc,
0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9, 0xfb => 0x02da, 0xfc => 0xb8,
0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
);
1; # end

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,44 @@
#------------------------------------------------------------------------------
# File: MacLatin2.pm
#
# Description: Mac Central European to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CENTEURO.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacLatin2 = (
0x80 => 0xc4, 0x81 => 0x0100, 0x82 => 0x0101, 0x83 => 0xc9, 0x84 => 0x0104,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0x0105, 0x89 => 0x010c,
0x8a => 0xe4, 0x8b => 0x010d, 0x8c => 0x0106, 0x8d => 0x0107, 0x8e => 0xe9,
0x8f => 0x0179, 0x90 => 0x017a, 0x91 => 0x010e, 0x92 => 0xed, 0x93 => 0x010f,
0x94 => 0x0112, 0x95 => 0x0113, 0x96 => 0x0116, 0x97 => 0xf3, 0x98 => 0x0117,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0x011a,
0x9e => 0x011b, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa2 => 0x0118,
0xa4 => 0xa7, 0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae,
0xaa => 0x2122, 0xab => 0x0119, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x0123,
0xaf => 0x012e, 0xb0 => 0x012f, 0xb1 => 0x012a, 0xb2 => 0x2264,
0xb3 => 0x2265, 0xb4 => 0x012b, 0xb5 => 0x0136, 0xb6 => 0x2202,
0xb7 => 0x2211, 0xb8 => 0x0142, 0xb9 => 0x013b, 0xba => 0x013c,
0xbb => 0x013d, 0xbc => 0x013e, 0xbd => 0x0139, 0xbe => 0x013a,
0xbf => 0x0145, 0xc0 => 0x0146, 0xc1 => 0x0143, 0xc2 => 0xac, 0xc3 => 0x221a,
0xc4 => 0x0144, 0xc5 => 0x0147, 0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb,
0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x0148, 0xcc => 0x0150, 0xcd => 0xd5,
0xce => 0x0151, 0xcf => 0x014c, 0xd0 => 0x2013, 0xd1 => 0x2014,
0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7,
0xd7 => 0x25ca, 0xd8 => 0x014d, 0xd9 => 0x0154, 0xda => 0x0155,
0xdb => 0x0158, 0xdc => 0x2039, 0xdd => 0x203a, 0xde => 0x0159,
0xdf => 0x0156, 0xe0 => 0x0157, 0xe1 => 0x0160, 0xe2 => 0x201a,
0xe3 => 0x201e, 0xe4 => 0x0161, 0xe5 => 0x015a, 0xe6 => 0x015b, 0xe7 => 0xc1,
0xe8 => 0x0164, 0xe9 => 0x0165, 0xea => 0xcd, 0xeb => 0x017d, 0xec => 0x017e,
0xed => 0x016a, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0x016b, 0xf1 => 0x016e,
0xf2 => 0xda, 0xf3 => 0x016f, 0xf4 => 0x0170, 0xf5 => 0x0171, 0xf6 => 0x0172,
0xf7 => 0x0173, 0xf8 => 0xdd, 0xf9 => 0xfd, 0xfa => 0x0137, 0xfb => 0x017b,
0xfc => 0x0141, 0xfd => 0x017c, 0xfe => 0x0122, 0xff => 0x02c7,
);
1; # end

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,42 @@
#------------------------------------------------------------------------------
# File: MacRoman.pm
#
# Description: Mac Roman to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMAN.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacRoman = (
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0x2039,
0xdd => 0x203a, 0xde => 0xfb01, 0xdf => 0xfb02, 0xe0 => 0x2021, 0xe1 => 0xb7,
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131,
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
);
1; # end

View File

@@ -0,0 +1,42 @@
#------------------------------------------------------------------------------
# File: MacRomanian.pm
#
# Description: Mac Romanian to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMANIAN.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacRomanian = (
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x0102, 0xaf => 0x0218,
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0x0103, 0xbf => 0x0219, 0xc0 => 0xbf,
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0x2039,
0xdd => 0x203a, 0xde => 0x021a, 0xdf => 0x021b, 0xe0 => 0x2021, 0xe1 => 0xb7,
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131,
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
);
1; # end

View File

@@ -0,0 +1,49 @@
#------------------------------------------------------------------------------
# File: MacThai.pm
#
# Description: Mac Thai to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/THAI.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacThai = (
0x80 => 0xab, 0x81 => 0xbb, 0x82 => 0x2026, 0x83 => [0x0e48,0xf875],
0x84 => [0x0e49,0xf875], 0x85 => [0x0e4a,0xf875], 0x86 => [0x0e4b,0xf875],
0x87 => [0x0e4c,0xf875], 0x88 => [0x0e48,0xf873], 0x89 => [0x0e49,0xf873],
0x8a => [0x0e4a,0xf873], 0x8b => [0x0e4b,0xf873], 0x8c => [0x0e4c,0xf873],
0x8d => 0x201c, 0x8e => 0x201d, 0x8f => [0x0e4d,0xf874], 0x91 => 0x2022,
0x92 => [0x0e31,0xf874], 0x93 => [0x0e47,0xf874], 0x94 => [0x0e34,0xf874],
0x95 => [0x0e35,0xf874], 0x96 => [0x0e36,0xf874], 0x97 => [0x0e37,0xf874],
0x98 => [0x0e48,0xf874], 0x99 => [0x0e49,0xf874], 0x9a => [0x0e4a,0xf874],
0x9b => [0x0e4b,0xf874], 0x9c => [0x0e4c,0xf874], 0x9d => 0x2018,
0x9e => 0x2019, 0xa1 => 0x0e01, 0xa2 => 0x0e02, 0xa3 => 0x0e03,
0xa4 => 0x0e04, 0xa5 => 0x0e05, 0xa6 => 0x0e06, 0xa7 => 0x0e07,
0xa8 => 0x0e08, 0xa9 => 0x0e09, 0xaa => 0x0e0a, 0xab => 0x0e0b,
0xac => 0x0e0c, 0xad => 0x0e0d, 0xae => 0x0e0e, 0xaf => 0x0e0f,
0xb0 => 0x0e10, 0xb1 => 0x0e11, 0xb2 => 0x0e12, 0xb3 => 0x0e13,
0xb4 => 0x0e14, 0xb5 => 0x0e15, 0xb6 => 0x0e16, 0xb7 => 0x0e17,
0xb8 => 0x0e18, 0xb9 => 0x0e19, 0xba => 0x0e1a, 0xbb => 0x0e1b,
0xbc => 0x0e1c, 0xbd => 0x0e1d, 0xbe => 0x0e1e, 0xbf => 0x0e1f,
0xc0 => 0x0e20, 0xc1 => 0x0e21, 0xc2 => 0x0e22, 0xc3 => 0x0e23,
0xc4 => 0x0e24, 0xc5 => 0x0e25, 0xc6 => 0x0e26, 0xc7 => 0x0e27,
0xc8 => 0x0e28, 0xc9 => 0x0e29, 0xca => 0x0e2a, 0xcb => 0x0e2b,
0xcc => 0x0e2c, 0xcd => 0x0e2d, 0xce => 0x0e2e, 0xcf => 0x0e2f,
0xd0 => 0x0e30, 0xd1 => 0x0e31, 0xd2 => 0x0e32, 0xd3 => 0x0e33,
0xd4 => 0x0e34, 0xd5 => 0x0e35, 0xd6 => 0x0e36, 0xd7 => 0x0e37,
0xd8 => 0x0e38, 0xd9 => 0x0e39, 0xda => 0x0e3a, 0xdb => 0x2060,
0xdc => 0x200b, 0xdd => 0x2013, 0xde => 0x2014, 0xdf => 0x0e3f,
0xe0 => 0x0e40, 0xe1 => 0x0e41, 0xe2 => 0x0e42, 0xe3 => 0x0e43,
0xe4 => 0x0e44, 0xe5 => 0x0e45, 0xe6 => 0x0e46, 0xe7 => 0x0e47,
0xe8 => 0x0e48, 0xe9 => 0x0e49, 0xea => 0x0e4a, 0xeb => 0x0e4b,
0xec => 0x0e4c, 0xed => 0x0e4d, 0xee => 0x2122, 0xef => 0x0e4f,
0xf0 => 0x0e50, 0xf1 => 0x0e51, 0xf2 => 0x0e52, 0xf3 => 0x0e53,
0xf4 => 0x0e54, 0xf5 => 0x0e55, 0xf6 => 0x0e56, 0xf7 => 0x0e57,
0xf8 => 0x0e58, 0xf9 => 0x0e59, 0xfa => 0xae, 0xfb => 0xa9,
);
1; # end

View File

@@ -0,0 +1,42 @@
#------------------------------------------------------------------------------
# File: MacTurkish.pm
#
# Description: Mac Turkish to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/TURKISH.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::MacTurkish = (
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
0xd9 => 0x0178, 0xda => 0x011e, 0xdb => 0x011f, 0xdc => 0x0130,
0xdd => 0x0131, 0xde => 0x015e, 0xdf => 0x015f, 0xe0 => 0x2021, 0xe1 => 0xb7,
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0xf8a0,
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
);
1; # end

View File

@@ -0,0 +1,28 @@
#------------------------------------------------------------------------------
# File: PDFDoc.pm
#
# Description: PDFDocEncoding to Unicode
#
# Revisions: 2010/10/16 - P. Harvey created
#
# References: 1) http://www.adobe.com/devnet/pdf/pdf_reference.html
#
# Notes: The table omits 1-byte characters with the same values as Unicode
# This set re-maps characters with codepoints less than 0x80
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::PDFDoc = (
0x18 => 0x02d8, 0x82 => 0x2021, 0x8c => 0x201e, 0x96 => 0x0152,
0x19 => 0x02c7, 0x83 => 0x2026, 0x8d => 0x201c, 0x97 => 0x0160,
0x1a => 0x02c6, 0x84 => 0x2014, 0x8e => 0x201d, 0x98 => 0x0178,
0x1b => 0x02d9, 0x85 => 0x2013, 0x8f => 0x2018, 0x99 => 0x017d,
0x1c => 0x02dd, 0x86 => 0x0192, 0x90 => 0x2019, 0x9a => 0x0131,
0x1d => 0x02db, 0x87 => 0x2044, 0x91 => 0x201a, 0x9b => 0x0142,
0x1e => 0x02da, 0x88 => 0x2039, 0x92 => 0x2122, 0x9c => 0x0153,
0x1f => 0x02dc, 0x89 => 0x203a, 0x93 => 0xfb01, 0x9d => 0x0161,
0x80 => 0x2022, 0x8a => 0x2212, 0x94 => 0xfb02, 0x9e => 0x017e,
0x81 => 0x2020, 0x8b => 0x2030, 0x95 => 0x0141, 0xa0 => 0x20ac,
);
1; # end

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,54 @@
#------------------------------------------------------------------------------
# File: Symbol.pm
#
# Description: Symbol to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://blogs.msdn.com/michkap/archive/2005/11/08/490495.aspx
#
# Notes: The table omits 1-byte characters with the same values as Unicode.
# This set re-maps characters with codepoints less than 0x80
# (Although all bytes >= 0x20 should be mapped according to the
# reference, I didn't map chars below 0x80 because I have some
# samples where these are regular ASCII characters, even though
# I think the encoding is probably incorrect for these samples)
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Symbol = (
0x80 => 0xf080, 0x81 => 0xf081, 0x82 => 0xf082, 0x83 => 0xf083,
0x84 => 0xf084, 0x85 => 0xf085, 0x86 => 0xf086, 0x87 => 0xf087,
0x88 => 0xf088, 0x89 => 0xf089, 0x8a => 0xf08a, 0x8b => 0xf08b,
0x8c => 0xf08c, 0x8d => 0xf08d, 0x8e => 0xf08e, 0x8f => 0xf08f,
0x90 => 0xf090, 0x91 => 0xf091, 0x92 => 0xf092, 0x93 => 0xf093,
0x94 => 0xf094, 0x95 => 0xf095, 0x96 => 0xf096, 0x97 => 0xf097,
0x98 => 0xf098, 0x99 => 0xf099, 0x9a => 0xf09a, 0x9b => 0xf09b,
0x9c => 0xf09c, 0x9d => 0xf09d, 0x9e => 0xf09e, 0x9f => 0xf09f,
0xa0 => 0xf0a0, 0xa1 => 0xf0a1, 0xa2 => 0xf0a2, 0xa3 => 0xf0a3,
0xa4 => 0xf0a4, 0xa5 => 0xf0a5, 0xa6 => 0xf0a6, 0xa7 => 0xf0a7,
0xa8 => 0xf0a8, 0xa9 => 0xf0a9, 0xaa => 0xf0aa, 0xab => 0xf0ab,
0xac => 0xf0ac, 0xad => 0xf0ad, 0xae => 0xf0ae, 0xaf => 0xf0af,
0xb0 => 0xf0b0, 0xb1 => 0xf0b1, 0xb2 => 0xf0b2, 0xb3 => 0xf0b3,
0xb4 => 0xf0b4, 0xb5 => 0xf0b5, 0xb6 => 0xf0b6, 0xb7 => 0xf0b7,
0xb8 => 0xf0b8, 0xb9 => 0xf0b9, 0xba => 0xf0ba, 0xbb => 0xf0bb,
0xbc => 0xf0bc, 0xbd => 0xf0bd, 0xbe => 0xf0be, 0xbf => 0xf0bf,
0xc0 => 0xf0c0, 0xc1 => 0xf0c1, 0xc2 => 0xf0c2, 0xc3 => 0xf0c3,
0xc4 => 0xf0c4, 0xc5 => 0xf0c5, 0xc6 => 0xf0c6, 0xc7 => 0xf0c7,
0xc8 => 0xf0c8, 0xc9 => 0xf0c9, 0xca => 0xf0ca, 0xcb => 0xf0cb,
0xcc => 0xf0cc, 0xcd => 0xf0cd, 0xce => 0xf0ce, 0xcf => 0xf0cf,
0xd0 => 0xf0d0, 0xd1 => 0xf0d1, 0xd2 => 0xf0d2, 0xd3 => 0xf0d3,
0xd4 => 0xf0d4, 0xd5 => 0xf0d5, 0xd6 => 0xf0d6, 0xd7 => 0xf0d7,
0xd8 => 0xf0d8, 0xd9 => 0xf0d9, 0xda => 0xf0da, 0xdb => 0xf0db,
0xdc => 0xf0dc, 0xdd => 0xf0dd, 0xde => 0xf0de, 0xdf => 0xf0df,
0xe0 => 0xf0e0, 0xe1 => 0xf0e1, 0xe2 => 0xf0e2, 0xe3 => 0xf0e3,
0xe4 => 0xf0e4, 0xe5 => 0xf0e5, 0xe6 => 0xf0e6, 0xe7 => 0xf0e7,
0xe8 => 0xf0e8, 0xe9 => 0xf0e9, 0xea => 0xf0ea, 0xeb => 0xf0eb,
0xec => 0xf0ec, 0xed => 0xf0ed, 0xee => 0xf0ee, 0xef => 0xf0ef,
0xf0 => 0xf0f0, 0xf1 => 0xf0f1, 0xf2 => 0xf0f2, 0xf3 => 0xf0f3,
0xf4 => 0xf0f4, 0xf5 => 0xf0f5, 0xf6 => 0xf0f6, 0xf7 => 0xf0f7,
0xf8 => 0xf0f8, 0xf9 => 0xf0f9, 0xfa => 0xf0fa, 0xfb => 0xf0fb,
0xfc => 0xf0fc, 0xfd => 0xf0fd, 0xfe => 0xf0fe, 0xff => 0xf0ff,
);
1; # end

View File

@@ -0,0 +1,41 @@
#------------------------------------------------------------------------------
# File: Thai.pm
#
# Description: cp874 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP874.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Thai = (
0x80 => 0x20ac, 0x85 => 0x2026, 0x91 => 0x2018, 0x92 => 0x2019,
0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013,
0x97 => 0x2014, 0xa1 => 0x0e01, 0xa2 => 0x0e02, 0xa3 => 0x0e03,
0xa4 => 0x0e04, 0xa5 => 0x0e05, 0xa6 => 0x0e06, 0xa7 => 0x0e07,
0xa8 => 0x0e08, 0xa9 => 0x0e09, 0xaa => 0x0e0a, 0xab => 0x0e0b,
0xac => 0x0e0c, 0xad => 0x0e0d, 0xae => 0x0e0e, 0xaf => 0x0e0f,
0xb0 => 0x0e10, 0xb1 => 0x0e11, 0xb2 => 0x0e12, 0xb3 => 0x0e13,
0xb4 => 0x0e14, 0xb5 => 0x0e15, 0xb6 => 0x0e16, 0xb7 => 0x0e17,
0xb8 => 0x0e18, 0xb9 => 0x0e19, 0xba => 0x0e1a, 0xbb => 0x0e1b,
0xbc => 0x0e1c, 0xbd => 0x0e1d, 0xbe => 0x0e1e, 0xbf => 0x0e1f,
0xc0 => 0x0e20, 0xc1 => 0x0e21, 0xc2 => 0x0e22, 0xc3 => 0x0e23,
0xc4 => 0x0e24, 0xc5 => 0x0e25, 0xc6 => 0x0e26, 0xc7 => 0x0e27,
0xc8 => 0x0e28, 0xc9 => 0x0e29, 0xca => 0x0e2a, 0xcb => 0x0e2b,
0xcc => 0x0e2c, 0xcd => 0x0e2d, 0xce => 0x0e2e, 0xcf => 0x0e2f,
0xd0 => 0x0e30, 0xd1 => 0x0e31, 0xd2 => 0x0e32, 0xd3 => 0x0e33,
0xd4 => 0x0e34, 0xd5 => 0x0e35, 0xd6 => 0x0e36, 0xd7 => 0x0e37,
0xd8 => 0x0e38, 0xd9 => 0x0e39, 0xda => 0x0e3a, 0xdf => 0x0e3f,
0xe0 => 0x0e40, 0xe1 => 0x0e41, 0xe2 => 0x0e42, 0xe3 => 0x0e43,
0xe4 => 0x0e44, 0xe5 => 0x0e45, 0xe6 => 0x0e46, 0xe7 => 0x0e47,
0xe8 => 0x0e48, 0xe9 => 0x0e49, 0xea => 0x0e4a, 0xeb => 0x0e4b,
0xec => 0x0e4c, 0xed => 0x0e4d, 0xee => 0x0e4e, 0xef => 0x0e4f,
0xf0 => 0x0e50, 0xf1 => 0x0e51, 0xf2 => 0x0e52, 0xf3 => 0x0e53,
0xf4 => 0x0e54, 0xf5 => 0x0e55, 0xf6 => 0x0e56, 0xf7 => 0x0e57,
0xf8 => 0x0e58, 0xf9 => 0x0e59, 0xfa => 0x0e5a, 0xfb => 0x0e5b,
);
1; # end

View File

@@ -0,0 +1,25 @@
#------------------------------------------------------------------------------
# File: Turkish.pm
#
# Description: cp1254 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1254.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Turkish = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
0x89 => 0x2030, 0x8a => 0x0160, 0x8b => 0x2039, 0x8c => 0x0152,
0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c, 0x94 => 0x201d,
0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014, 0x98 => 0x02dc,
0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a, 0x9c => 0x0153,
0x9f => 0x0178, 0xd0 => 0x011e, 0xdd => 0x0130, 0xde => 0x015e,
0xf0 => 0x011f, 0xfd => 0x0131, 0xfe => 0x015f,
);
1; # end

View File

@@ -0,0 +1,27 @@
#------------------------------------------------------------------------------
# File: Vietnam.pm
#
# Description: cp1258 to Unicode
#
# Revisions: 2010/01/20 - P. Harvey created
#
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1258.TXT
#
# Notes: The table omits 1-byte characters with the same values as Unicode
#------------------------------------------------------------------------------
use strict;
%Image::ExifTool::Charset::Vietnam = (
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
0x89 => 0x2030, 0x8b => 0x2039, 0x8c => 0x0152, 0x91 => 0x2018,
0x92 => 0x2019, 0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022,
0x96 => 0x2013, 0x97 => 0x2014, 0x98 => 0x02dc, 0x99 => 0x2122,
0x9b => 0x203a, 0x9c => 0x0153, 0x9f => 0x0178, 0xc3 => 0x0102,
0xcc => 0x0300, 0xd0 => 0x0110, 0xd2 => 0x0309, 0xd5 => 0x01a0,
0xdd => 0x01af, 0xde => 0x0303, 0xe3 => 0x0103, 0xec => 0x0301,
0xf0 => 0x0111, 0xf2 => 0x0323, 0xf5 => 0x01a1, 0xfd => 0x01b0,
0xfe => 0x20ab,
);
1; # end

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,90 @@
#------------------------------------------------------------------------------
# File: DJI.pm
#
# Description: DJI Phantom maker notes tags
#
# Revisions: 2016-07-25 - P. Harvey Created
# 2017-06-23 - PH Added XMP tags
#------------------------------------------------------------------------------
package Image::ExifTool::DJI;
use strict;
use vars qw($VERSION);
use Image::ExifTool::Exif;
use Image::ExifTool::XMP;
$VERSION = '1.01';
my %convFloat2 = (
PrintConv => 'sprintf("%+.2f", $val)',
PrintConvInv => '$val',
);
# DJI maker notes (ref PH, mostly educated guesses based on DJI QuickTime::UserData tags)
%Image::ExifTool::DJI::Main = (
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => q{
This table lists tags found in the maker notes of images from some DJI
Phantom drones.
},
0x01 => { Name => 'Make', Writable => 'string' },
# 0x02 - int8u[4]: "1 0 0 0", "1 1 0 0"
0x03 => { Name => 'SpeedX', Writable => 'float', %convFloat2 }, # (guess)
0x04 => { Name => 'SpeedY', Writable => 'float', %convFloat2 }, # (guess)
0x05 => { Name => 'SpeedZ', Writable => 'float', %convFloat2 }, # (guess)
0x06 => { Name => 'Pitch', Writable => 'float', %convFloat2 },
0x07 => { Name => 'Yaw', Writable => 'float', %convFloat2 },
0x08 => { Name => 'Roll', Writable => 'float', %convFloat2 },
0x09 => { Name => 'CameraPitch',Writable => 'float', %convFloat2 },
0x0a => { Name => 'CameraYaw', Writable => 'float', %convFloat2 },
0x0b => { Name => 'CameraRoll', Writable => 'float', %convFloat2 },
);
%Image::ExifTool::DJI::XMP = (
%Image::ExifTool::XMP::xmpTableDefaults,
GROUPS => { 0 => 'XMP', 1 => 'XMP-drone-dji', 2 => 'Image' },
NAMESPACE => 'drone-dji',
TABLE_DESC => 'XMP DJI',
VARS => { NO_ID => 1 },
NOTES => 'XMP tags used by DJI for images from drones.',
AbsoluteAltitude => { Writable => 'real' },
RelativeAltitude => { Writable => 'real' },
GimbalRollDegree => { Writable => 'real' },
GimbalYawDegree => { Writable => 'real' },
GimbalPitchDegree => { Writable => 'real' },
FlightRollDegree => { Writable => 'real' },
FlightYawDegree => { Writable => 'real' },
FlightPitchDegree => { Writable => 'real' },
);
__END__
=head1 NAME
Image::ExifTool::DJI - DJI Phantom maker notes tags
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
the maker notes in images from some DJI Phantom drones.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/DJI Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,835 @@
#------------------------------------------------------------------------------
# File: DNG.pm
#
# Description: Read DNG-specific information
#
# Revisions: 01/09/2006 - P. Harvey Created
#
# References: 1) http://www.adobe.com/products/dng/
#------------------------------------------------------------------------------
package Image::ExifTool::DNG;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::Exif;
use Image::ExifTool::MakerNotes;
use Image::ExifTool::CanonRaw;
$VERSION = '1.23';
sub ProcessOriginalRaw($$$);
sub ProcessAdobeData($$$);
sub ProcessAdobeMakN($$$);
sub ProcessAdobeCRW($$$);
sub ProcessAdobeRAF($$$);
sub ProcessAdobeMRW($$$);
sub ProcessAdobeSR2($$$);
sub ProcessAdobeIFD($$$);
sub WriteAdobeStuff($$$);
# data in OriginalRawFileData
%Image::ExifTool::DNG::OriginalRaw = (
GROUPS => { 2 => 'Image' },
PROCESS_PROC => \&ProcessOriginalRaw,
NOTES => q{
This table defines tags extracted from the DNG OriginalRawFileData
information.
},
0 => { Name => 'OriginalRawImage', Binary => 1 },
1 => { Name => 'OriginalRawResource', Binary => 1 },
2 => 'OriginalRawFileType',
3 => 'OriginalRawCreator',
4 => { Name => 'OriginalTHMImage', Binary => 1 },
5 => { Name => 'OriginalTHMResource', Binary => 1 },
6 => 'OriginalTHMFileType',
7 => 'OriginalTHMCreator',
);
%Image::ExifTool::DNG::AdobeData = ( #PH
GROUPS => { 0 => 'MakerNotes', 1 => 'AdobeDNG', 2 => 'Image' },
PROCESS_PROC => \&ProcessAdobeData,
WRITE_PROC => \&WriteAdobeStuff,
NOTES => q{
This information is found in the "Adobe" DNGPrivateData.
The maker notes ('MakN') are processed by ExifTool, but some information may
have been lost by the Adobe DNG Converter. This is because the Adobe DNG
Converter (as of version 6.3) doesn't properly handle information referenced
from inside the maker notes that lies outside the original maker notes
block. This information is lost when only the maker note block is copied to
the DNG image. While this doesn't effect all makes of cameras, it is a
problem for some major brands such as Olympus and Sony.
Other entries in this table represent proprietary information that is
extracted from the original RAW image and restructured to a different (but
still proprietary) Adobe format.
},
MakN => [ ], # (filled in later)
'CRW ' => {
Name => 'AdobeCRW',
SubDirectory => {
TagTable => 'Image::ExifTool::CanonRaw::Main',
ProcessProc => \&ProcessAdobeCRW,
WriteProc => \&WriteAdobeStuff,
},
},
'MRW ' => {
Name => 'AdobeMRW',
SubDirectory => {
TagTable => 'Image::ExifTool::MinoltaRaw::Main',
ProcessProc => \&ProcessAdobeMRW,
WriteProc => \&WriteAdobeStuff,
},
},
'SR2 ' => {
Name => 'AdobeSR2',
SubDirectory => {
TagTable => 'Image::ExifTool::Sony::SR2Private',
ProcessProc => \&ProcessAdobeSR2,
},
},
'RAF ' => {
Name => 'AdobeRAF',
SubDirectory => {
TagTable => 'Image::ExifTool::FujiFilm::RAF',
ProcessProc => \&ProcessAdobeRAF,
},
},
'Pano' => {
Name => 'AdobePano',
SubDirectory => {
TagTable => 'Image::ExifTool::PanasonicRaw::Main',
ProcessProc => \&ProcessAdobeIFD,
},
},
'Koda' => {
Name => 'AdobeKoda',
SubDirectory => {
TagTable => 'Image::ExifTool::Kodak::IFD',
ProcessProc => \&ProcessAdobeIFD,
},
},
'Leaf' => {
Name => 'AdobeLeaf',
SubDirectory => {
TagTable => 'Image::ExifTool::Leaf::SubIFD',
ProcessProc => \&ProcessAdobeIFD,
},
},
);
# fill in maker notes
{
my $tagInfo;
my $list = $Image::ExifTool::DNG::AdobeData{MakN};
foreach $tagInfo (@Image::ExifTool::MakerNotes::Main) {
unless (ref $tagInfo eq 'HASH') {
push @$list, $tagInfo;
next;
}
my %copy = %$tagInfo;
delete $copy{Groups};
delete $copy{GotGroups};
delete $copy{Table};
push @$list, \%copy;
}
}
#------------------------------------------------------------------------------
# Process DNG OriginalRawFileData information
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
sub ProcessOriginalRaw($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $start = $$dirInfo{DirStart};
my $end = $start + $$dirInfo{DirLen};
my $pos = $start;
my ($index, $err);
SetByteOrder('MM'); # pointers are always big-endian in this structure
for ($index=0; $index<8; ++$index) {
last if $pos + 4 > $end;
my $val = Get32u($dataPt, $pos);
$val or $pos += 4, next; # ignore zero values
my $tagInfo = $et->GetTagInfo($tagTablePtr, $index);
$tagInfo or $err = "Missing DNG tag $index", last;
if ($index & 0x02) {
# extract a simple file type (tags 2, 3, 6 and 7)
$val = substr($$dataPt, $pos, 4);
$pos += 4;
} else {
# extract a compressed data block (tags 0, 1, 4 and 5)
my $n = int(($val + 65535) / 65536);
my $hdrLen = 4 * ($n + 2);
$pos + $hdrLen > $end and $err = '', last;
my $tag = $$tagInfo{Name};
# only extract this information if requested (because it takes time)
my $lcTag = lc $tag;
if (($$et{OPTIONS}{Binary} and not $$et{EXCL_TAG_LOOKUP}{$lcTag}) or
$$et{REQ_TAG_LOOKUP}{$lcTag})
{
unless (eval { require Compress::Zlib }) {
$err = 'Install Compress::Zlib to extract compressed images';
last;
}
my $i;
$val = '';
my $p2 = $pos + Get32u($dataPt, $pos + 4);
for ($i=0; $i<$n; ++$i) {
# inflate this compressed block
my $p1 = $p2;
$p2 = $pos + Get32u($dataPt, $pos + ($i + 2) * 4);
if ($p1 >= $p2 or $p2 > $end) {
$err = 'Bad compressed RAW image';
last;
}
my $buff = substr($$dataPt, $p1, $p2 - $p1);
my ($v2, $stat);
my $inflate = Compress::Zlib::inflateInit();
$inflate and ($v2, $stat) = $inflate->inflate($buff);
if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
$val .= $v2;
} else {
$err = 'Error inflating compressed RAW image';
last;
}
}
$pos = $p2;
} else {
$pos + $hdrLen > $end and $err = '', last;
my $len = Get32u($dataPt, $pos + $hdrLen - 4);
$pos + $len > $end and $err = '', last;
$val = substr($$dataPt, $pos + $hdrLen, $len - $hdrLen);
$val = "Binary data $len bytes";
$pos += $len; # skip over this block
}
}
$et->FoundTag($tagInfo, $val);
}
$et->Warn($err || 'Bad OriginalRawFileData') if defined $err;
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe DNGPrivateData directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessAdobeData($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $pos = $$dirInfo{DirStart};
my $end = $$dirInfo{DirLen} + $pos;
my $outfile = $$dirInfo{OutFile};
my $verbose = $et->Options('Verbose');
my $htmlDump = $et->Options('HtmlDump');
return 0 unless $$dataPt =~ /^Adobe\0/;
unless ($outfile) {
$et->VerboseDir($dirInfo);
# don't parse makernotes if FastScan > 1
my $fast = $et->Options('FastScan');
return 1 if $fast and $fast > 1;
}
$htmlDump and $et->HDump($dataPos, 6, 'Adobe DNGPrivateData header');
SetByteOrder('MM'); # always big endian
$pos += 6;
while ($pos + 8 <= $end) {
my ($tag, $size) = unpack("x${pos}a4N", $$dataPt);
$pos += 8;
last if $pos + $size > $end;
my $tagInfo = $$tagTablePtr{$tag};
if ($htmlDump) {
my $name = "Adobe$tag";
$name =~ tr/ //d;
$et->HDump($dataPos + $pos - 8, 8, "$name header", "Data Size: $size bytes");
# dump non-EXIF format data
unless ($tag =~ /^(MakN|SR2 )$/) {
$et->HDump($dataPos + $pos, $size, "$name data");
}
}
if ($verbose and not $outfile) {
$tagInfo or $et->VPrint(0, "$$et{INDENT}Unsupported DNGAdobeData record: ($tag)\n");
$et->VerboseInfo($tag,
ref $tagInfo eq 'HASH' ? $tagInfo : undef,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $pos,
Size => $size,
);
}
my $value;
while ($tagInfo) {
my ($subTable, $subName, $processProc);
if (ref $tagInfo eq 'HASH') {
unless ($$tagInfo{SubDirectory}) {
if ($outfile) {
# copy value across to outfile
$value = substr($$dataPt, $pos, $size);
} else {
$et->HandleTag($tagTablePtr, $tag, substr($$dataPt, $pos, $size));
}
last;
}
$subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
$subName = $$tagInfo{Name};
$processProc = $tagInfo->{SubDirectory}->{ProcessProc};
} else {
$subTable = $tagTablePtr;
$subName = 'AdobeMakN';
$processProc = \&ProcessAdobeMakN;
}
my %dirInfo = (
Base => $$dirInfo{Base},
DataPt => $dataPt,
DataPos => $dataPos,
DataLen => $$dirInfo{DataLen},
DirStart => $pos,
DirLen => $size,
DirName => $subName,
);
if ($outfile) {
$dirInfo{Proc} = $processProc; # WriteAdobeStuff() calls this to do the actual writing
$value = $et->WriteDirectory(\%dirInfo, $subTable, \&WriteAdobeStuff);
# use old directory if an error occurred
defined $value or $value = substr($$dataPt, $pos, $size);
} else {
# override process proc for MakN
$et->ProcessDirectory(\%dirInfo, $subTable, $processProc);
}
last;
}
if (defined $value and length $value) {
# add "Adobe" header if necessary
$$outfile = "Adobe\0" unless $$outfile and length $$outfile;
$$outfile .= $tag . pack('N', length $value) . $value;
$$outfile .= "\0" if length($value) & 0x01; # pad if necessary
}
$pos += $size;
++$pos if $size & 0x01; # (darn padding)
}
$pos == $end or $et->Warn("$pos $end Adobe private data is corrupt");
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe CRW directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
# - this routine would be as simple as ProcessAdobeMRW() below if Adobe hadn't
# pulled the bonehead move of reformatting the CRW information
sub ProcessAdobeCRW($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $start = $$dirInfo{DirStart};
my $end = $start + $$dirInfo{DirLen};
my $verbose = $et->Options('Verbose');
my $buildMakerNotes = $et->Options('MakerNotes');
my $outfile = $$dirInfo{OutFile};
my ($newTags, $oldChanged);
SetByteOrder('MM'); # always big endian
return 0 if $$dirInfo{DirLen} < 4;
my $byteOrder = substr($$dataPt, $start, 2);
return 0 unless $byteOrder =~ /^(II|MM)$/;
# initialize maker note data if building maker notes
$buildMakerNotes and Image::ExifTool::CanonRaw::InitMakerNotes($et);
my $entries = Get16u($dataPt, $start + 2);
my $pos = $start + 4;
$et->VerboseDir($dirInfo, $entries) unless $outfile;
if ($outfile) {
# get hash of new tags
$newTags = $et->GetNewTagInfoHash($tagTablePtr);
$$outfile = substr($$dataPt, $start, 4);
$oldChanged = $$et{CHANGED};
}
# loop through entries in Adobe CRW information
my $index;
for ($index=0; $index<$entries; ++$index) {
last if $pos + 6 > $end;
my $tag = Get16u($dataPt, $pos);
my $size = Get32u($dataPt, $pos + 2);
$pos += 6;
last if $pos + $size > $end;
my $value = substr($$dataPt, $pos, $size);
my $tagID = $tag & 0x3fff;
my $tagType = ($tag >> 8) & 0x38; # get tag type
my $format = $Image::ExifTool::CanonRaw::crwTagFormat{$tagType};
my $count;
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$value);
if ($tagInfo) {
$format = $$tagInfo{Format} if $$tagInfo{Format};
$count = $$tagInfo{Count};
}
# set count to 1 by default for values that were in the directory entry
if (not defined $count and $tag & 0x4000 and $format and $format ne 'string') {
$count = 1;
}
# set count from tagInfo count if necessary
if ($format and not $count) {
# set count according to format and size
my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
$count = int($size / $fsiz);
}
$format or $format = 'undef';
SetByteOrder($byteOrder);
my $val = ReadValue(\$value, 0, $format, $count, $size);
if ($outfile) {
if ($tagInfo) {
my $subdir = $$tagInfo{SubDirectory};
if ($subdir and $$subdir{TagTable}) {
my $name = $$tagInfo{Name};
my $newTagTable = GetTagTable($$subdir{TagTable});
return 0 unless $newTagTable;
my $subdirStart = 0;
#### eval Start ()
$subdirStart = eval $$subdir{Start} if $$subdir{Start};
my $dirData = \$value;
my %subdirInfo = (
Name => $name,
DataPt => $dirData,
DataLen => $size,
DirStart => $subdirStart,
DirLen => $size - $subdirStart,
Parent => $$dirInfo{DirName},
);
#### eval Validate ($dirData, $subdirStart, $size)
if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
$et->Warn("Invalid $name data");
} else {
$subdir = $et->WriteDirectory(\%subdirInfo, $newTagTable);
if (defined $subdir and length $subdir) {
if ($subdirStart) {
# add header before data directory
$value = substr($value, 0, $subdirStart) . $subdir;
} else {
$value = $subdir;
}
}
}
} elsif ($$newTags{$tagID}) {
my $nvHash = $et->GetNewValueHash($tagInfo);
if ($et->IsOverwriting($nvHash, $val)) {
my $newVal = $et->GetNewValue($nvHash);
my $verboseVal;
$verboseVal = $newVal if $verbose > 1;
# convert to specified format if necessary
if (defined $newVal and $format) {
$newVal = WriteValue($newVal, $format, $count);
}
if (defined $newVal) {
$et->VerboseValue("- CanonRaw:$$tagInfo{Name}", $value);
$et->VerboseValue("+ CanonRaw:$$tagInfo{Name}", $verboseVal);
$value = $newVal;
++$$et{CHANGED};
}
}
}
}
# write out new value (always big-endian)
SetByteOrder('MM');
# (verified that there is no padding here)
$$outfile .= Set16u($tag) . Set32u(length($value)) . $value;
} else {
$et->HandleTag($tagTablePtr, $tagID, $val,
Index => $index,
DataPt => $dataPt,
DataPos => $$dirInfo{DataPos},
Start => $pos,
Size => $size,
TagInfo => $tagInfo,
);
if ($buildMakerNotes) {
# build maker notes information if requested
Image::ExifTool::CanonRaw::BuildMakerNotes($et, $tagID, $tagInfo,
\$value, $format, $count);
}
}
# (we lost the directory structure, but the second tag 0x0805
# should be in the ImageDescription directory)
$$et{DIR_NAME} = 'ImageDescription' if $tagID == 0x0805;
SetByteOrder('MM');
$pos += $size;
}
if ($outfile and (not defined $$outfile or $index != $entries or
$$et{CHANGED} == $oldChanged))
{
$$et{CHANGED} = $oldChanged; # nothing changed
undef $$outfile; # rewrite old directory
}
if ($index != $entries) {
$et->Warn('Truncated CRW notes');
} elsif ($pos < $end) {
$et->Warn($end-$pos . ' extra bytes at end of CRW notes');
}
# finish building maker notes if necessary
if ($buildMakerNotes) {
SetByteOrder($byteOrder);
Image::ExifTool::CanonRaw::SaveMakerNotes($et);
}
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe MRW directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
sub ProcessAdobeMRW($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dirLen = $$dirInfo{DirLen};
my $dirStart = $$dirInfo{DirStart};
my $outfile = $$dirInfo{OutFile};
# construct fake MRW file
my $buff = "\0MRM" . pack('N', $dirLen - 4);
# ignore leading byte order and directory count words
$buff .= substr($$dataPt, $dirStart + 4, $dirLen - 4);
my $raf = new File::RandomAccess(\$buff);
my %dirInfo = ( RAF => $raf, OutFile => $outfile );
my $rtnVal = Image::ExifTool::MinoltaRaw::ProcessMRW($et, \%dirInfo);
if ($outfile and defined $$outfile and length $$outfile) {
# remove MRW header and add Adobe header
$$outfile = substr($$dataPt, $dirStart, 4) . substr($$outfile, 8);
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Process Adobe RAF directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
sub ProcessAdobeRAF($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
my $dataPt = $$dirInfo{DataPt};
my $pos = $$dirInfo{DirStart};
my $dirEnd = $$dirInfo{DirLen} + $pos;
my ($readIt, $warn);
# set byte order according to first 2 bytes of Adobe RAF data
if ($pos + 2 <= $dirEnd and SetByteOrder(substr($$dataPt, $pos, 2))) {
$pos += 2;
} else {
$et->Warn('Invalid DNG RAF data');
return 0;
}
$et->VerboseDir($dirInfo);
# make fake RAF object for processing (same acronym, different meaning)
my $raf = new File::RandomAccess($dataPt);
my $num = '';
# loop through all records in Adobe RAF data:
# 0 - RAF table (not processed)
# 1 - first RAF directory
# 2 - second RAF directory (if available)
for (;;) {
last if $pos + 4 > $dirEnd;
my $len = Get32u($dataPt, $pos);
$pos += 4 + $len; # step to next entry in Adobe RAF record
$len or last; # ends with an empty entry
$readIt or $readIt = 1, next; # ignore first entry (RAF table)
my %dirInfo = (
RAF => $raf,
DirStart => $pos - $len,
);
$$et{SET_GROUP1} = "RAF$num";
$et->ProcessDirectory(\%dirInfo, $tagTablePtr) or $warn = 1;
delete $$et{SET_GROUP1};
$num = ($num || 1) + 1;
}
$warn and $et->Warn('Possibly corrupt RAF information');
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe SR2 directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
sub ProcessAdobeSR2($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
my $dataPt = $$dirInfo{DataPt};
my $start = $$dirInfo{DirStart};
my $len = $$dirInfo{DirLen};
return 0 if $len < 6;
SetByteOrder('MM');
my $originalPos = Get32u($dataPt, $start + 2);
return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
$et->VerboseDir($dirInfo);
my $dataPos = $$dirInfo{DataPos};
my $dirStart = $start + 6; # pointer to maker note directory
my $dirLen = $len - 6;
# initialize subdirectory information
my $fix = $dataPos + $dirStart - $originalPos;
my %subdirInfo = (
DirName => 'AdobeSR2',
Base => $$dirInfo{Base} + $fix,
DataPt => $dataPt,
DataPos => $dataPos - $fix,
DataLen => $$dirInfo{DataLen},
DirStart => $dirStart,
DirLen => $dirLen,
Parent => $$dirInfo{DirName},
);
if ($et->Options('HtmlDump')) {
$et->HDump($dataPos + $start, 6, 'Adobe SR2 data');
}
# parse the SR2 directory
$et->ProcessDirectory(\%subdirInfo, $tagTablePtr);
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe-mutilated IFD directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
# Notes: data has 2 byte header (byte order of the data)
sub ProcessAdobeIFD($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
my $dataPt = $$dirInfo{DataPt};
my $pos = $$dirInfo{DirStart};
my $dataPos = $$dirInfo{DataPos};
return 0 if $$dirInfo{DirLen} < 4;
my $dataOrder = substr($$dataPt, $pos, 2);
return 0 unless SetByteOrder($dataOrder); # validate byte order of data
# parse the mutilated IFD. This is similar to a TIFF IFD, except:
# - data follows directly after Count entry in IFD
# - byte order of IFD entires is always big-endian, but byte order of data changes
SetByteOrder('MM'); # IFD structure is always big-endian
my $entries = Get16u($dataPt, $pos + 2);
$et->VerboseDir($dirInfo, $entries);
$pos += 4;
my $end = $pos + $$dirInfo{DirLen};
my $index;
for ($index=0; $index<$entries; ++$index) {
last if $pos + 8 > $end;
SetByteOrder('MM'); # directory entries always big-endian (doh!)
my $tagID = Get16u($dataPt, $pos);
my $format = Get16u($dataPt, $pos+2);
my $count = Get32u($dataPt, $pos+4);
if ($format < 1 or $format > 13) {
# warn unless the IFD was just padded with zeros
$format and $et->Warn(
sprintf("Unknown format ($format) for $$dirInfo{DirName} tag 0x%x",$tagID));
return 0; # must be corrupted
}
my $size = $Image::ExifTool::Exif::formatSize[$format] * $count;
last if $pos + 8 + $size > $end;
my $formatStr = $Image::ExifTool::Exif::formatName[$format];
SetByteOrder($dataOrder); # data stored in native order
my $val = ReadValue($dataPt, $pos + 8, $formatStr, $count, $size);
$et->HandleTag($tagTablePtr, $tagID, $val,
Index => $index,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $pos + 8,
Size => $size
);
$pos += 8 + $size;
}
if ($index < $entries) {
$et->Warn("Truncated $$dirInfo{DirName} directory");
return 0;
}
return 1;
}
#------------------------------------------------------------------------------
# Process Adobe MakerNotes directory
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
sub ProcessAdobeMakN($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $start = $$dirInfo{DirStart};
my $len = $$dirInfo{DirLen};
my $outfile = $$dirInfo{OutFile};
return 0 if $len < 6;
SetByteOrder('MM');
my $originalPos = Get32u($dataPt, $start + 2);
return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
$et->VerboseDir($dirInfo) unless $outfile;
my $dataPos = $$dirInfo{DataPos};
my $dirStart = $start + 6; # pointer to maker note directory
my $dirLen = $len - 6;
my $hdr = substr($$dataPt, $dirStart, $dirLen < 48 ? $dirLen : 48);
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'MakN', \$hdr);
return 0 unless $tagInfo and $$tagInfo{SubDirectory};
my $subdir = $$tagInfo{SubDirectory};
my $subTable = GetTagTable($$subdir{TagTable});
# initialize subdirectory information
my %subdirInfo = (
DirName => 'MakerNotes',
Name => $$tagInfo{Name}, # needed for maker notes verbose dump
Base => $$dirInfo{Base},
DataPt => $dataPt,
DataPos => $dataPos,
DataLen => $$dirInfo{DataLen},
DirStart => $dirStart,
DirLen => $dirLen,
TagInfo => $tagInfo,
FixBase => $$subdir{FixBase},
EntryBased=> $$subdir{EntryBased},
Parent => $$dirInfo{DirName},
);
# look for start of maker notes IFD
my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
unless (defined $loc) {
$et->Warn('Maker notes could not be parsed');
return 0;
}
if ($et->Options('HtmlDump')) {
$et->HDump($dataPos + $start, 6, 'Adobe MakN data');
$et->HDump($dataPos + $dirStart, $loc, "$$tagInfo{Name} header") if $loc;
}
my $fix = 0;
unless ($$subdir{Base}) {
# adjust base offset for current maker note position
$fix = $dataPos + $dirStart - $originalPos;
$subdirInfo{Base} += $fix;
$subdirInfo{DataPos} -= $fix;
}
if ($outfile) {
# rewrite the maker notes directory
my $fixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
my $oldChanged = $$et{CHANGED};
my $buff = $et->WriteDirectory(\%subdirInfo, $subTable);
# nothing to do if error writing directory or nothing changed
unless (defined $buff and $$et{CHANGED} != $oldChanged) {
$$et{CHANGED} = $oldChanged;
return 1;
}
# deleting maker notes if directory is empty
unless (length $buff) {
$$outfile = '';
return 1;
}
# apply a one-time fixup to offsets
if ($subdirInfo{Relative}) {
# shift all offsets to be relative to new base
my $baseShift = $dataPos + $dirStart + $$dirInfo{Base} - $subdirInfo{Base};
$fixup->{Shift} += $baseShift;
} else {
# shift offsets to position of original maker notes
$fixup->{Shift} += $originalPos;
}
# if we wrote the directory as a block the header is already included
$loc = 0 if $subdirInfo{BlockWrite};
$fixup->{Shift} += $loc; # adjust for makernotes header
$fixup->ApplyFixup(\$buff); # fix up pointer offsets
# get copy of original Adobe header (6) and makernotes header ($loc)
my $header = substr($$dataPt, $start, 6 + $loc);
# add Adobe and makernotes headers to new directory
$$outfile = $header . $buff;
} else {
# parse the maker notes directory
$et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc});
# extract maker notes as a block if specified
if ($et->Options('MakerNotes') or
$$et{REQ_TAG_LOOKUP}{lc($$tagInfo{Name})})
{
my $val;
if ($$tagInfo{MakerNotes}) {
$subdirInfo{Base} = $$dirInfo{Base} + $fix;
$subdirInfo{DataPos} = $dataPos - $fix;
$subdirInfo{DirStart} = $dirStart;
$subdirInfo{DirLen} = $dirLen;
# rebuild the maker notes to identify all offsets that require fixing up
$val = Image::ExifTool::Exif::RebuildMakerNotes($et, \%subdirInfo, $subTable);
if (not defined $val and $dirLen > 4) {
$et->Warn('Error rebuilding maker notes (may be corrupt)');
}
} else {
# extract this directory as a block if specified
return 1 unless $$tagInfo{Writable};
}
$val = substr($$dataPt, 20) unless defined $val;
$et->FoundTag($tagInfo, $val);
}
}
return 1;
}
#------------------------------------------------------------------------------
# Write Adobe information (calls appropriate ProcessProc to do the actual work)
# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
# Returns: new data block (may be empty if directory is deleted) or undef on error
sub WriteAdobeStuff($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
$et or return 1; # allow dummy access
my $proc = $$dirInfo{Proc} || \&ProcessAdobeData;
my $buff;
$$dirInfo{OutFile} = \$buff;
&$proc($et, $dirInfo, $tagTablePtr) or undef $buff;
return $buff;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::DNG.pm - Read DNG-specific information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to process
information in DNG (Digital Negative) images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.adobe.com/products/dng/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/DNG Tags>,
L<Image::ExifTool::TagNames/EXIF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,182 @@
#------------------------------------------------------------------------------
# File: DPX.pm
#
# Description: Read DPX meta information
#
# Revisions: 2013-09-19 - P. Harvey created
#
# References: 1) http://www.cineon.com/ff_draft.php
#------------------------------------------------------------------------------
package Image::ExifTool::DPX;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.03';
# DPX tags
%Image::ExifTool::DPX::Main = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
NOTES => 'Tags extracted from DPX (Digital Picture Exchange) images.',
0 => { Name => 'ByteOrder', Format => 'undef[4]', PrintConv => { SDPX => 'Big-endian', XPDS => 'Little-endian' } },
8 => { Name => 'HeaderVersion', Format => 'string[8]' },
# 24 => { Name => 'GenericHeaderSize', Format => 'int32u' }, # = 1664
# 28 => { Name => 'IndustryStandardHeaderSize', Format => 'int32u' }, # = 384
16 => { Name => 'DPXFileSize', Format => 'int32u' },
20 => { Name => 'DittoKey', Format => 'int32u', PrintConv => { 0 => 'Same', 1 => 'New' } },
36 => { Name => 'ImageFileName', Format => 'string[100]' },
136 => {
Name => 'CreateDate',
Format => 'string[24]',
Groups => { 2 => 'Time' },
ValueConv => '$val =~ s/(\d{4}:\d{2}:\d{2}):/$1 /; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
160 => { Name => 'Creator', Format => 'string[100]', Groups => { 2 => 'Author' } },
260 => { Name => 'Project', Format => 'string[200]' },
460 => { Name => 'Copyright', Format => 'string[200]', Groups => { 2 => 'Author' } },
660 => { Name => 'EncryptionKey', Format => 'int32u', PrintConv => 'sprintf("%.8x",$val)' },
768 => {
Name => 'Orientation',
Format => 'int16u',
PrintConv => {
0 => 'Horizontal (normal)',
1 => 'Mirror vertical',
2 => 'Mirror horizontal',
3 => 'Rotate 180',
4 => 'Mirror horizontal and rotate 270 CW',
5 => 'Rotate 90 CW',
6 => 'Rotate 270 CW',
7 => 'Mirror horizontal and rotate 90 CW',
},
},
770 => { Name => 'ImageElements', Format => 'int16u' },
772 => { Name => 'ImageWidth', Format => 'int32u' },
776 => { Name => 'ImageHeight', Format => 'int32u' },
780 => { Name => 'DataSign', Format => 'int32u', PrintConv => { 0 => 'Unsigned', 1 => 'Signed' } },
800 => {
Name => 'ComponentsConfiguration',
Format => 'int8u',
PrintConv => {
0 => 'User-defined single component',
1 => 'Red (R)',
2 => 'Green (G)',
3 => 'Blue (B)',
4 => 'Alpha (matte)',
6 => 'Luminance (Y)',
7 => 'Chrominance (Cb, Cr, subsampled by two)',
8 => 'Depth (Z)',
9 => 'Composite video',
50 => 'R, G, B',
51 => 'R, G, B, Alpha',
52 => 'Alpha, B, G, R',
100 => 'Cb, Y, Cr, Y (4:2:2)',
101 => 'Cb, Y, A, Cr, Y, A (4:2:2:4)',
102 => 'Cb, Y, Cr (4:4:4)',
103 => 'Cb, Y, Cr, A (4:4:4:4)',
150 => 'User-defined 2 component element',
151 => 'User-defined 3 component element',
152 => 'User-defined 4 component element',
153 => 'User-defined 5 component element',
154 => 'User-defined 6 component element',
155 => 'User-defined 7 component element',
156 => 'User-defined 8 component element',
},
},
803 => { Name => 'BitDepth', Format => 'int8u' },
820 => { Name => 'ImageDescription', Format => 'string[32]' },
892 => { Name => 'Image2Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
964 => { Name => 'Image3Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
1036=> { Name => 'Image4Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
1108=> { Name => 'Image5Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
1180=> { Name => 'Image6Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
1252=> { Name => 'Image7Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
1324=> { Name => 'Image8Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
# 1408=> { Name => 'XOffset', Format => 'int32u' },
# 1412=> { Name => 'YOffset', Format => 'int32u' },
# 1416=> { Name => 'XCenter', Format => 'float' },
# 1420=> { Name => 'YCenter', Format => 'float' },
# 1424=> { Name => 'XOriginalSize', Format => 'int32u' },
# 1428=> { Name => 'YOriginalSize', Format => 'int32u' },
1432=> { Name => 'SourceFileName', Format => 'string[100]' },
1532=> { Name => 'SourceCreateDate', Format => 'string[24]' },
1556=> { Name => 'InputDeviceName', Format => 'string[32]' },
1588=> { Name => 'InputDeviceSerialNumber', Format => 'string[32]' },
# 1620=> { Name => 'AspectRatio', Format => 'int32u' },
1724 => { Name => 'FrameRate', Format => 'float' },
1732 => { Name => 'FrameID', Format => 'string[32]' },
1764 => { Name => 'SlateInformation', Format => 'string[100]' },
1972 => { Name => 'Reserved5', Format => 'string[76]', Unknown => 1 },
2048 => { Name => 'UserID', Format => 'string[32]' },
);
#------------------------------------------------------------------------------
# Extract EXIF information from a DPX image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid DPX file
sub ProcessDPX($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $buff;
# verify this is a valid DPX file
return 0 unless $raf->Read($buff, 2080) == 2080;
return 0 unless $buff =~ /^(SDPX|XPDS)/;
SetByteOrder($1 eq 'SDPX' ? 'MM' : 'II');
$et->SetFileType(); # set the FileType tag
my $hdrLen = Get32u(\$buff,24) + Get32u(\$buff,28);
$hdrLen == 2048 or $et->Warn("Unexpected DPX header length ($hdrLen)");
my %dirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => length($buff),
);
my $tagTablePtr = GetTagTable('Image::ExifTool::DPX::Main');
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::DPX - Read DPX 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 DPX (Digital Picture Exchange) images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.cineon.com/ff_draft.php>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/DPX Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,319 @@
#------------------------------------------------------------------------------
# File: DV.pm
#
# Description: Read DV meta information
#
# Revisions: 2010/12/24 - P. Harvey Created
#
# References: 1) http://www.ffmpeg.org/
# 2) http://dvswitch.alioth.debian.org/wiki/DV_format/
#------------------------------------------------------------------------------
package Image::ExifTool::DV;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.01';
# DV profiles (ref 1)
my @dvProfiles = (
{
DSF => 0,
VideoSType => 0x0,
FrameSize => 120000,
VideoFormat => 'IEC 61834, SMPTE-314M - 525/60 (NTSC)',
VideoScanType => 'Progressive',
Colorimetry => '4:1:1',
FrameRate => 30000/1001,
ImageHeight => 480,
ImageWidth => 720,
},{
DSF => 1,
VideoSType => 0x0,
FrameSize => 144000,
VideoFormat => 'IEC 61834 - 625/50 (PAL)',
VideoScanType => 'Progressive',
Colorimetry => '4:2:0',
FrameRate => 25/1,
ImageHeight => 576,
ImageWidth => 720,
},{
DSF => 1,
VideoSType => 0x0,
FrameSize => 144000,
VideoFormat => 'SMPTE-314M - 625/50 (PAL)',
VideoScanType => 'Progressive',
Colorimetry => '4:1:1',
FrameRate => 25/1,
ImageHeight => 576,
ImageWidth => 720,
},{
DSF => 0,
VideoSType => 0x4,
FrameSize => 240000,
VideoFormat => 'DVCPRO50: SMPTE-314M - 525/60 (NTSC) 50 Mbps',
VideoScanType => 'Progressive',
Colorimetry => '4:2:2',
FrameRate => 30000/1001,
ImageHeight => 480,
ImageWidth => 720,
},{
DSF => 1,
VideoSType => 0x4,
FrameSize => 288000,
VideoFormat => 'DVCPRO50: SMPTE-314M - 625/50 (PAL) 50 Mbps',
VideoScanType => 'Progressive',
Colorimetry => '4:2:2',
FrameRate => 25/1,
ImageHeight => 576,
ImageWidth => 720,
},{
DSF => 0,
VideoSType => 0x14,
FrameSize => 480000,
VideoFormat => 'DVCPRO HD: SMPTE-370M - 1080i60 100 Mbps',
VideoScanType => 'Interlaced',
Colorimetry => '4:2:2',
FrameRate => 30000/1001,
ImageHeight => 1080,
ImageWidth => 1280,
},{
DSF => 1,
VideoSType => 0x14,
FrameSize => 576000,
VideoFormat => 'DVCPRO HD: SMPTE-370M - 1080i50 100 Mbps',
VideoScanType => 'Interlaced',
Colorimetry => '4:2:2',
FrameRate => 25/1,
ImageHeight => 1080,
ImageWidth => 1440,
},{
DSF => 0,
VideoSType => 0x18,
FrameSize => 240000,
VideoFormat => 'DVCPRO HD: SMPTE-370M - 720p60 100 Mbps',
VideoScanType => 'Progressive',
Colorimetry => '4:2:2',
FrameRate => 60000/1001,
ImageHeight => 720,
ImageWidth => 960,
},{
DSF => 1,
VideoSType => 0x18,
FrameSize => 288000,
VideoFormat => 'DVCPRO HD: SMPTE-370M - 720p50 100 Mbps',
VideoScanType => 'Progressive',
Colorimetry => '4:2:2',
FrameRate => 50/1,
ImageHeight => 720,
ImageWidth => 960,
},{
DSF => 1,
VideoSType => 0x1,
FrameSize => 144000,
VideoFormat => 'IEC 61883-5 - 625/50 (PAL)',
VideoScanType => 'Progressive',
Colorimetry => '4:2:0',
FrameRate => 25/1,
ImageHeight => 576,
ImageWidth => 720,
},
);
# tags to extract, in the order we want to extract them
my @dvTags = (
'DateTimeOriginal', 'ImageWidth', 'ImageHeight', 'Duration',
'TotalBitrate', 'VideoFormat', 'VideoScanType', 'FrameRate',
'AspectRatio', 'Colorimetry', 'AudioChannels', 'AudioSampleRate',
'AudioBitsPerSample',
);
# DV tags
%Image::ExifTool::DV::Main = (
GROUPS => { 2 => 'Video' },
VARS => { NO_ID => 1 },
NOTES => 'The following tags are extracted from DV videos.',
DateTimeOriginal => {
Groups => { 2 => 'Time' },
PrintConv => '$self->ConvertDateTime($val)',
},
ImageWidth => { },
ImageHeight => { },
Duration => { PrintConv => 'ConvertDuration($val)' },
TotalBitrate => { PrintConv => 'ConvertBitrate($val)' },
VideoFormat => { },
VideoScanType => { },
FrameRate => { PrintConv => 'int($val * 1000 + 0.5) / 1000' },
AspectRatio => { },
Colorimetry => { },
AudioChannels => { Groups => { 2 => 'Audio' } },
AudioSampleRate => { Groups => { 2 => 'Audio' } },
AudioBitsPerSample => { Groups => { 2 => 'Audio' } },
);
#------------------------------------------------------------------------------
# Read information in a DV file (ref 1)
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid DV file
sub ProcessDV($$)
{
my ($et, $dirInfo) = @_;
local $_;
my $raf = $$dirInfo{RAF};
my ($buff, $start, $profile, $tag, $i, $j);
$raf->Read($buff, 12000) or return 0;
if ($buff =~ /\x1f\x07\0[\x3f\xbf]/sg) {
$start = pos($buff) - 4;
} else {
while ($buff =~ /[\0\xff]\x3f\x07\0.{76}\xff\x3f\x07\x01/sg) {
next if pos($buff) - 163 < 0;
$start = pos($buff) - 163;
last;
}
return 0 unless defined $start;
}
my $len = length $buff;
# must at least have a full DIF header
return 0 if $start + 80 * 6 > $len;
$et->SetFileType();
my $pos = $start;
my $dsf = Get8u(\$buff, $pos + 3) & 0x80 >> 7;
my $stype = Get8u(\$buff, $pos + 80*5 + 48 + 3) & 0x1f;
# 576i50 25Mbps 4:1:1 is a special case
if ($dsf == 1 && $stype == 0 && Get8u(\$buff, 4) & 0x07) {
$profile = $dvProfiles[2];
} else {
foreach (@dvProfiles) {
next unless $dsf == $$_{DSF} and $stype == $$_{VideoSType};
$profile = $_;
last;
}
$profile or $et->Warn("Unrecognized DV profile"), return 1;
}
my $tagTablePtr = GetTagTable('Image::ExifTool::DV::Main');
# calculate total bit rate and duration
my $byteRate = $$profile{FrameSize} * $$profile{FrameRate};
my $fileSize = $$et{VALUE}{FileSize};
$$profile{TotalBitrate} = 8 * $byteRate;
$$profile{Duration} = $fileSize / $byteRate if defined $fileSize;
# read DVPack metadata from the VAUX DIF's to extract video tags
delete $$profile{DateTimeOriginal};
delete $$profile{AspectRatio};
my ($date, $time, $is16_9);
for ($i=1; $i<6; ++$i) {
$pos += 80;
my $type = Get8u(\$buff, $pos);
next unless ($type & 0xf0) == 0x50; # look for VAUX types
for ($j=0; $j<15; ++$j) {
my $p = $pos + $j * 5 + 3;
$type = Get8u(\$buff, $p);
if ($type == 0x61) { # video control
my $apt = Get8u(\$buff, $start + 4) & 0x07;
my $t = Get8u(\$buff, $p + 2);
$is16_9 = (($t & 0x07) == 0x02 or (not $apt and ($t & 0x07) == 0x07));
} elsif ($type == 0x62) { # date
# mask off unused bits
my @d = unpack('C*', substr($buff, $p + 1, 4));
# (ignore timezone in byte 0 until we can test this properly - see ref 2)
$date = sprintf('%.2x:%.2x:%.2x', $d[3], $d[2] & 0x1f, $d[1] & 0x3f);
if ($date =~ /[a-f]/) {
undef $date; # invalid date
} else {
# add century (this will work until 2089)
$date = ($date lt '9' ? '20' : '19') . $date;
}
undef $time;
} elsif ($type == 0x63 and $date) { # time
# (ignore frames past second in byte 0 for now - see ref 2)
my $val = Get32u(\$buff, $p + 1) & 0x007f7f3f;
my @t = unpack('C*', substr($buff, $p + 1, 4));
$time = sprintf('%.2x:%.2x:%.2x', $t[3] & 0x3f, $t[2] & 0x7f, $t[1] & 0x7f);
last;
} else {
undef $time; # must be consecutive
}
}
}
if ($date and $time) {
$$profile{DateTimeOriginal} = "$date $time";
$$profile{AspectRatio} = $is16_9 ? '16:9' : '5:4' if defined $is16_9;
}
# read audio tags if available
delete $$profile{AudioSampleRate};
delete $$profile{AudioBitsPerSample};
delete $$profile{AudioChannels};
$pos = $start + 80*6 + 80*16*3 + 3;
if ($pos + 4 < $len and Get8u(\$buff, $pos) == 0x50) {
my $smpls = Get8u(\$buff, $pos + 1);
my $freq = (Get8u(\$buff, $pos + 4) >> 3) & 0x07;
my $stype = Get8u(\$buff, $pos + 3) & 0x1f;
my $quant = Get8u(\$buff, $pos + 4) & 0x07;
if ($freq < 3) {
$$profile{AudioSampleRate} = {0=>48000, 1=>44100, 2=>32000}->{$freq};
}
if ($stype < 3) {
$stype = 2 if $stype == 0 and $quant and $freq == 2;
$$profile{AudioChannels} = {0=>2, 1=>0, 2=>4, 3=>8}->{$stype};
}
$$profile{AudioBitsPerSample} = $quant ? 12 : 16;
}
# save our metadata
foreach $tag (@dvTags) {
next unless defined $$profile{$tag};
$et->HandleTag($tagTablePtr, $tag, $$profile{$tag});
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::DV - Read DV meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read meta
information from DV (raw Digital Video) files.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://ffmpeg.org/>
=item L<http://dvswitch.alioth.debian.org/wiki/DV_format/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/DV Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,362 @@
#------------------------------------------------------------------------------
# File: DarwinCore.pm
#
# Description: Darwin Core XMP tags
#
# Revisions: 2013-01-28 - P. Harvey Created
#
# References: 1) http://rs.tdwg.org/dwc/index.htm
# 2) http://u88.n24.queensu.ca/exiftool/forum/index.php/topic,4442.0/all.html
#------------------------------------------------------------------------------
package Image::ExifTool::DarwinCore;
use strict;
use vars qw($VERSION);
use Image::ExifTool::XMP;
$VERSION = '1.02';
my %dateTimeInfo = (
# NOTE: Do NOT put "Groups" here because Groups hash must not be common!
Writable => 'date',
Shift => 'Time',
PrintConv => '$self->ConvertDateTime($val)',
PrintConvInv => '$self->InverseDateTime($val,undef,1)',
);
my %materialSample = (
STRUCT_NAME => 'DarwinCore MaterialSample',
NAMESPACE => 'dwc',
materialSampleID => { },
);
my %event = (
STRUCT_NAME => 'DarwinCore Event',
NAMESPACE => 'dwc',
day => { Writable => 'integer', Groups => { 2 => 'Time' } },
earliestDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
endDayOfYear => { Writable => 'integer', Groups => { 2 => 'Time' } },
eventDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
eventID => { },
eventRemarks => { Writable => 'lang-alt' },
eventTime => { %dateTimeInfo, Groups => { 2 => 'Time' } },
fieldNotes => { },
fieldNumber => { },
habitat => { },
latestDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
month => { Writable => 'integer', Groups => { 2 => 'Time' } },
parentEventID => { },
samplingEffort => { },
samplingProtocol => { },
sampleSizeValue => { },
sampleSizeUnit => { },
startDayOfYear => { Writable => 'integer', Groups => { 2 => 'Time' } },
verbatimEventDate => { Groups => { 2 => 'Time' } },
year => { Writable => 'integer', Groups => { 2 => 'Time' } },
);
# Darwin Core tags
%Image::ExifTool::DarwinCore::Main = (
GROUPS => { 0 => 'XMP', 1 => 'XMP-dwc', 2 => 'Other' },
NAMESPACE => 'dwc',
WRITABLE => 'string',
NOTES => q{
Tags defined in the Darwin Core (dwc) XMP namespace. See
L<http://rs.tdwg.org/dwc/index.htm> for the official specification.
},
Event => {
Name => 'DCEvent', # (avoid conflict with XMP-iptcExt:Event)
FlatName => 'Event',
Struct => \%event,
},
# tweak a few of the flattened tag names
EventEventDate => { Name => 'EventDate', Flat => 1 },
EventEventID => { Name => 'EventID', Flat => 1 },
EventEventRemarks => { Name => 'EventRemarks', Flat => 1 },
EventEventTime => { Name => 'EventTime', Flat => 1 },
FossilSpecimen => { Struct => \%materialSample },
GeologicalContext => {
FlatName => '', # ('GeologicalContext' is too long)
Struct => {
STRUCT_NAME => 'DarwinCore GeologicalContext',
NAMESPACE => 'dwc',
bed => { },
earliestAgeOrLowestStage => { },
earliestEonOrLowestEonothem => { },
earliestEpochOrLowestSeries => { },
earliestEraOrLowestErathem => { },
earliestPeriodOrLowestSystem=> { },
formation => { },
geologicalContextID => { },
group => { },
highestBiostratigraphicZone => { },
latestAgeOrHighestStage => { },
latestEonOrHighestEonothem => { },
latestEpochOrHighestSeries => { },
latestEraOrHighestErathem => { },
latestPeriodOrHighestSystem => { },
lithostratigraphicTerms => { },
lowestBiostratigraphicZone => { },
member => { },
},
},
GeologicalContextBed => { Name => 'GeologicalContextBed', Flat => 1 },
GeologicalContextFormation => { Name => 'GeologicalContextFormation', Flat => 1 },
GeologicalContextGroup => { Name => 'GeologicalContextGroup', Flat => 1 },
GeologicalContextMember => { Name => 'GeologicalContextMember', Flat => 1 },
HumanObservation => { Struct => \%event },
Identification => {
FlatName => '', # ('Identification' is redundant)
Struct => {
STRUCT_NAME => 'DarwinCore Identification',
NAMESPACE => 'dwc',
dateIdentified => { %dateTimeInfo, Groups => { 2 => 'Time' } },
identificationID => { },
identificationQualifier => { },
identificationReferences => { },
identificationRemarks => { },
identificationVerificationStatus => { },
identifiedBy => { },
typeStatus => { },
},
},
LivingSpecimen => { Struct => \%materialSample },
MachineObservation => { Struct => \%event },
MaterialSample => { Struct => \%materialSample },
MaterialSampleMaterialSampleID => { Name => 'MaterialSampleID', Flat => 1 },
MeasurementOrFact => {
FlatName => '', # ('MeasurementOrFact' is redundant and too long)
Struct => {
STRUCT_NAME => 'DarwinCore MeasurementOrFact',
NAMESPACE => 'dwc',
measurementAccuracy => { Format => 'real' },
measurementDeterminedBy => { },
measurementDeterminedDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
measurementID => { },
measurementMethod => { },
measurementRemarks => { },
measurementType => { },
measurementUnit => { },
measurementValue => { },
},
},
Occurrence => {
Struct => {
STRUCT_NAME => 'DarwinCore Occurrence',
NAMESPACE => 'dwc',
associatedMedia => { },
associatedOccurrences => { },
associatedReferences => { },
associatedSequences => { },
associatedTaxa => { },
behavior => { },
catalogNumber => { },
disposition => { },
establishmentMeans => { },
individualCount => { },
individualID => { },
lifeStage => { },
occurrenceDetails => { },
occurrenceID => { },
occurrenceRemarks => { },
occurrenceStatus => { },
organismQuantity => { },
organismQuantityType => { },
otherCatalogNumbers => { },
preparations => { },
previousIdentifications => { },
recordedBy => { },
recordNumber => { },
reproductiveCondition => { },
sex => { },
},
},
OccurrenceOccurrenceDetails => { Name => 'OccurrenceDetails', Flat => 1 },
OccurrenceOccurrenceID => { Name => 'OccurrenceID', Flat => 1 },
OccurrenceOccurrenceRemarks => { Name => 'OccurrenceRemarks', Flat => 1 },
OccurrenceOccurrenceStatus => { Name => 'OccurrenceStatus', Flat => 1 },
Organism => {
Struct => {
STRUCT_NAME => 'DarwinCore Organism',
NAMESPACE => 'dwc',
associatedOccurrences => { },
associatedOrganisms => { },
organismID => { },
organismName => { },
organismRemarks => { },
organismScope => { },
previousIdentifications => { },
},
},
OrganismOrganismID => { Name => 'OrganismID', Flat => 1 },
OrganismOrganismName => { Name => 'OrganismName', Flat => 1 },
OrganismOrganismRemarks => { Name => 'OrganismRemarks', Flat => 1 },
OrganismOrganismScope => { Name => 'OrganismScope', Flat => 1 },
PreservedSpecimen => { Struct => \%materialSample },
Record => {
Struct => {
STRUCT_NAME => 'DarwinCore Record',
NAMESPACE => 'dwc',
basisOfRecord => { },
collectionCode => { },
collectionID => { },
dataGeneralizations => { },
datasetID => { },
datasetName => { },
dynamicProperties => { },
informationWithheld => { },
institutionCode => { },
institutionID => { },
ownerInstitutionCode => { },
},
},
ResourceRelationship => {
FlatName => '', # ('ResourceRelationship' is redundant and too long)
Struct => {
STRUCT_NAME => 'DarwinCore ResourceRelationship',
NAMESPACE => 'dwc',
relatedResourceID => { },
relationshipAccordingTo => { },
relationshipEstablishedDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
relationshipOfResource => { },
relationshipRemarks => { },
resourceID => { },
resourceRelationshipID => { },
},
},
Taxon => {
Struct => {
STRUCT_NAME => 'DarwinCore Taxon',
NAMESPACE => 'dwc',
acceptedNameUsage => { },
acceptedNameUsageID => { },
class => { },
family => { },
genus => { },
higherClassification => { },
infraspecificEpithet => { },
kingdom => { },
nameAccordingTo => { },
nameAccordingToID => { },
namePublishedIn => { },
namePublishedInID => { },
namePublishedInYear => { },
nomenclaturalCode => { },
nomenclaturalStatus => { },
order => { },
originalNameUsage => { },
originalNameUsageID => { },
parentNameUsage => { },
parentNameUsageID => { },
phylum => { },
scientificName => { },
scientificNameAuthorship => { },
scientificNameID => { },
specificEpithet => { },
subgenus => { },
taxonConceptID => { },
taxonID => { },
taxonRank => { },
taxonRemarks => { },
taxonomicStatus => { },
verbatimTaxonRank => { },
vernacularName => { Writable => 'lang-alt' },
},
},
TaxonTaxonConceptID => { Name => 'TaxonConceptID', Flat => 1 },
TaxonTaxonID => { Name => 'TaxonID', Flat => 1 },
TaxonTaxonRank => { Name => 'TaxonRank', Flat => 1 },
TaxonTaxonRemarks => { Name => 'TaxonRemarks', Flat => 1 },
dctermsLocation => {
Name => 'DCTermsLocation',
Groups => { 2 => 'Location' },
FlatName => 'DC', # ('dctermsLocation' is too long)
Struct => {
STRUCT_NAME => 'DarwinCore DCTermsLocation',
NAMESPACE => 'dwc',
continent => { },
coordinatePrecision => { },
coordinateUncertaintyInMeters => { },
country => { },
countryCode => { },
county => { },
decimalLatitude => { },
decimalLongitude => { },
footprintSpatialFit => { },
footprintSRS => { },
footprintWKT => { },
geodeticDatum => { },
georeferencedBy => { },
georeferencedDate => { },
georeferenceProtocol => { },
georeferenceRemarks => { },
georeferenceSources => { },
georeferenceVerificationStatus => { },
higherGeography => { },
higherGeographyID => { },
island => { },
islandGroup => { },
locality => { },
locationAccordingTo => { },
locationID => { },
locationRemarks => { },
maximumDepthInMeters => { },
maximumDistanceAboveSurfaceInMeters => { },
maximumElevationInMeters => { },
minimumDepthInMeters => { },
minimumDistanceAboveSurfaceInMeters => { },
minimumElevationInMeters => { },
municipality => { },
pointRadiusSpatialFit => { },
stateProvince => { },
verbatimCoordinates => { },
verbatimCoordinateSystem => { },
verbatimDepth => { },
verbatimElevation => { },
verbatimLatitude => { },
verbatimLocality => { },
verbatimLongitude => { },
verbatimSRS => { },
waterBody => { },
},
},
);
1; #end
__END__
=head1 NAME
Image::ExifTool::DarwinCore - Darwin Core XMP tags
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This file contains tag definitions for the Darwin Core XMP namespace.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://rs.tdwg.org/dwc/index.htm>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/XMP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,378 @@
#------------------------------------------------------------------------------
# File: DjVu.pm
#
# Description: Read DjVu archive meta information
#
# Revisions: 09/25/2008 - P. Harvey Created
#
# References: 1) http://djvu.sourceforge.net/ (DjVu v3 specification, Nov 2005)
# 2) http://www.djvu.org/
#
# Notes: DjVu files are recognized and the IFF structure is processed
# by Image::ExifTool::AIFF
#------------------------------------------------------------------------------
package Image::ExifTool::DjVu;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.06';
sub ParseAnt($);
sub ProcessAnt($$$);
sub ProcessMeta($$$);
sub ProcessBZZ($$$);
# DjVu chunks that we parse (ref 4)
%Image::ExifTool::DjVu::Main = (
GROUPS => { 2 => 'Image' },
NOTES => q{
Information is extracted from the following chunks in DjVu images. See
L<http://www.djvu.org/> for the DjVu specification.
},
INFO => {
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Info' },
},
FORM => {
TypeOnly => 1, # extract chunk type only, then descend into chunk
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Form' },
},
ANTa => {
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Ant' },
},
ANTz => {
Name => 'CompressedAnnotation',
SubDirectory => {
TagTable => 'Image::ExifTool::DjVu::Ant',
ProcessProc => \&ProcessBZZ,
}
},
INCL => 'IncludedFileID',
);
# information in the DjVu INFO chunk
%Image::ExifTool::DjVu::Info = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
FORMAT => 'int8u',
PRIORITY => 0, # first INFO block takes priority
0 => {
Name => 'ImageWidth',
Format => 'int16u',
},
2 => {
Name => 'ImageHeight',
Format => 'int16u',
},
4 => {
Name => 'DjVuVersion',
Description => 'DjVu Version',
Format => 'int8u[2]',
# (this may be just one byte as with version 0.16)
ValueConv => '$val=~/(\d+) (\d+)/ ? "$2.$1" : "0.$val"',
},
6 => {
Name => 'SpatialResolution',
Format => 'int16u',
ValueConv => '(($val & 0xff)<<8) + ($val>>8)', # (little-endian!)
},
8 => {
Name => 'Gamma',
ValueConv => '$val / 10',
},
9 => {
Name => 'Orientation',
Mask => 0x07, # (upper 5 bits reserved)
PrintConv => {
1 => 'Horizontal (normal)',
2 => 'Rotate 180',
5 => 'Rotate 90 CW',
6 => 'Rotate 270 CW',
},
},
);
# information in the DjVu FORM chunk
%Image::ExifTool::DjVu::Form = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
0 => {
Name => 'SubfileType',
Format => 'undef[4]',
Priority => 0,
PrintConv => {
DJVU => 'Single-page image',
DJVM => 'Multi-page document',
PM44 => 'Color IW44',
BM44 => 'Grayscale IW44',
DJVI => 'Shared component',
THUM => 'Thumbnail image',
},
},
);
# tags found in the DjVu annotation chunk (ANTz or ANTa)
%Image::ExifTool::DjVu::Ant = (
PROCESS_PROC => \&Image::ExifTool::DjVu::ProcessAnt,
GROUPS => { 2 => 'Image' },
NOTES => 'Information extracted from annotation chunks.',
# Note: For speed, ProcessAnt() pre-scans for known tag ID's, so if any
# new tags are added here they must also be added to the pre-scan check
metadata => {
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Meta' }
},
xmp => {
Name => 'XMP',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' }
},
);
# tags found in the DjVu annotation metadata
%Image::ExifTool::DjVu::Meta = (
PROCESS_PROC => \&Image::ExifTool::DjVu::ProcessMeta,
GROUPS => { 1 => 'DjVu-Meta', 2 => 'Image' },
NOTES => q{
This table lists the standard DjVu metadata tags, but ExifTool will extract
any tags that exist even if they don't appear here. The DjVu v3
documentation endorses tags borrowed from two standards: 1) BibTeX
bibliography system tags (all lowercase Tag ID's in the table below), and 2)
PDF DocInfo tags (capitalized Tag ID's).
},
# BibTeX tags (ref http://en.wikipedia.org/wiki/BibTeX)
address => { Groups => { 2 => 'Location' } },
annote => { Name => 'Annotation' },
author => { Groups => { 2 => 'Author' } },
booktitle => { Name => 'BookTitle' },
chapter => { },
crossref => { Name => 'CrossRef' },
edition => { },
eprint => { Name => 'EPrint' },
howpublished=> { Name => 'HowPublished' },
institution => { },
journal => { },
key => { },
month => { Groups => { 2 => 'Time' } },
note => { },
number => { },
organization=> { },
pages => { },
publisher => { },
school => { },
series => { },
title => { },
type => { },
url => { Name => 'URL' },
volume => { },
year => { Groups => { 2 => 'Time' } },
# PDF tags (same as Image::ExifTool::PDF::Info)
Title => { },
Author => { Groups => { 2 => 'Author' } },
Subject => { },
Keywords => { },
Creator => { },
Producer => { },
CreationDate => {
Name => 'CreateDate',
Groups => { 2 => 'Time' },
# RFC 3339 date/time format
ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
ModDate => {
Name => 'ModifyDate',
Groups => { 2 => 'Time' },
ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
Trapped => {
# remove leading '/' from '/True' or '/False'
ValueConv => '$val=~s{^/}{}; $val',
},
);
#------------------------------------------------------------------------------
# Parse DjVu annotation "s-expression" syntax (recursively)
# Inputs: 0) data ref (with pos($$dataPt) set to start of annotation)
# Returns: reference to list of tokens/references, or undef if no tokens,
# and the position in $$dataPt is set to end of last token
# Notes: The DjVu annotation syntax is not well documented, so I make
# a number of assumptions here!
sub ParseAnt($)
{
my $dataPt = shift;
my (@toks, $tok, $more);
# (the DjVu annotation syntax really sucks, and requires that every
# single token be parsed in order to properly scan through the items)
Tok: for (;;) {
# find the next token
last unless $$dataPt =~ /(\S)/sg; # get next non-space character
if ($1 eq '(') { # start of list
$tok = ParseAnt($dataPt);
} elsif ($1 eq ')') { # end of list
$more = 1;
last;
} elsif ($1 eq '"') { # quoted string
$tok = '';
for (;;) {
# get string up to the next quotation mark
# this doesn't work in perl 5.6.2! grrrr
# last Tok unless $$dataPt =~ /(.*?)"/sg;
# $tok .= $1;
my $pos = pos($$dataPt);
last Tok unless $$dataPt =~ /"/sg;
$tok .= substr($$dataPt, $pos, pos($$dataPt)-1-$pos);
# we're good unless quote was escaped by odd number of backslashes
last unless $tok =~ /(\\+)$/ and length($1) & 0x01;
$tok .= '"'; # quote is part of the string
}
# must protect unescaped "$" and "@" symbols, and "\" at end of string
$tok =~ s{\\(.)|([\$\@]|\\$)}{'\\'.($2 || $1)}sge;
# convert C escape sequences (allowed in quoted text)
$tok = eval qq{"$tok"};
} else { # key name
pos($$dataPt) = pos($$dataPt) - 1;
# allow anything in key but whitespace, braces and double quotes
# (this is one of those assumptions I mentioned)
$$dataPt =~ /([^\s()"]+)/sg;
$tok = $1;
}
push @toks, $tok if defined $tok;
}
# prevent further parsing unless more after this
pos($$dataPt) = length $$dataPt unless $more;
return @toks ? \@toks : undef;
}
#------------------------------------------------------------------------------
# Process DjVu annotation chunk (ANTa or decoded ANTz)
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
# Returns: 1 on success
sub ProcessAnt($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
# quick pre-scan to check for metadata or XMP
return 1 unless $$dataPt =~ /\(\s*(metadata|xmp)[\s("]/s;
# parse annotations into a tree structure
pos($$dataPt) = 0;
my $toks = ParseAnt($dataPt) or return 0;
# process annotations individually
my $ant;
foreach $ant (@$toks) {
next unless ref $ant eq 'ARRAY' and @$ant >= 2;
my $tag = shift @$ant;
next if ref $tag or not defined $$tagTablePtr{$tag};
if ($tag eq 'metadata') {
# ProcessMeta() takes array reference
$et->HandleTag($tagTablePtr, $tag, $ant);
} else {
next if ref $$ant[0]; # only process simple values
$et->HandleTag($tagTablePtr, $tag, $$ant[0]);
}
}
return 1;
}
#------------------------------------------------------------------------------
# Process DjVu metadata
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
# Returns: 1 on success
# Notes: input dirInfo DataPt is a reference to a list of pre-parsed metadata entries
sub ProcessMeta($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
return 0 unless ref $$dataPt eq 'ARRAY';
$et->VerboseDir('Metadata', scalar @$$dataPt);
my ($item, $err);
foreach $item (@$$dataPt) {
# make sure item is a simple tag/value pair
$err=1, next unless ref $item eq 'ARRAY' and @$item >= 2 and
not ref $$item[0] and not ref $$item[1];
# add any new tags to the table
unless ($$tagTablePtr{$$item[0]}) {
my $name = $$item[0];
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
length $name or $err = 1, next;
AddTagToTable($tagTablePtr, $$item[0], { Name => ucfirst($name) });
}
$et->HandleTag($tagTablePtr, $$item[0], $$item[1]);
}
$err and $et->Warn('Ignored invalid metadata entry(s)');
return 1;
}
#------------------------------------------------------------------------------
# Process BZZ-compressed data (in DjVu images)
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
# Returns: 1 on success
sub ProcessBZZ($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
require Image::ExifTool::BZZ;
my $buff = Image::ExifTool::BZZ::Decode($$dirInfo{DataPt});
unless (defined $buff) {
$et->Warn("Error decoding $$dirInfo{DirName}");
return 0;
}
my $verbose = $et->Options('Verbose');
if ($verbose >= 3) {
# dump the decoded data in very verbose mode
$et->VerboseDir("Decoded $$dirInfo{DirName}", 0, length $buff);
$et->VerboseDump(\$buff);
}
$$dirInfo{DataPt} = \$buff;
$$dirInfo{DataLen} = $$dirInfo{DirLen} = length $buff;
# process the data using the default process proc for this table
my $processProc = $$tagTablePtr{PROCESS_PROC} or return 0;
return &$processProc($et, $dirInfo, $tagTablePtr);
}
1; # end
__END__
=head1 NAME
Image::ExifTool::DjVu - Read DjVu meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to extract meta
information from DjVu images. Parsing of the DjVu IFF structure is done by
Image::ExifTool::AIFF.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://djvu.sourceforge.net/>
=item L<http://www.djvu.org/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/DjVu Tags>,
L<Image::ExifTool::AIFF(3pm)|Image::ExifTool::AIFF>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,307 @@
#------------------------------------------------------------------------------
# File: FLAC.pm
#
# Description: Read Free Lossless Audio Codec information
#
# Revisions: 11/13/2006 - P. Harvey Created
#
# References: 1) http://flac.sourceforge.net/
#------------------------------------------------------------------------------
package Image::ExifTool::FLAC;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.08';
sub ProcessBitStream($$$);
# FLAC metadata blocks
%Image::ExifTool::FLAC::Main = (
NOTES => q{
Free Lossless Audio Codec (FLAC) meta information. ExifTool also extracts
ID3 information from these files.
},
0 => {
Name => 'StreamInfo',
SubDirectory => { TagTable => 'Image::ExifTool::FLAC::StreamInfo' },
},
1 => { Name => 'Padding', Binary => 1, Unknown => 1 },
2 => { Name => 'Application', Binary => 1, Unknown => 1 },
3 => { Name => 'SeekTable', Binary => 1, Unknown => 1 },
4 => {
Name => 'VorbisComment',
SubDirectory => { TagTable => 'Image::ExifTool::Vorbis::Comments' },
},
5 => { Name => 'CueSheet', Binary => 1, Unknown => 1 },
6 => {
Name => 'Picture',
SubDirectory => { TagTable => 'Image::ExifTool::FLAC::Picture' },
},
# 7-126 - Reserved
# 127 - Invalid
);
%Image::ExifTool::FLAC::StreamInfo = (
PROCESS_PROC => \&ProcessBitStream,
NOTES => 'FLAC is big-endian, so bit 0 is the high-order bit in this table.',
GROUPS => { 2 => 'Audio' },
'Bit000-015' => 'BlockSizeMin',
'Bit016-031' => 'BlockSizeMax',
'Bit032-055' => 'FrameSizeMin',
'Bit056-079' => 'FrameSizeMax',
'Bit080-099' => 'SampleRate',
'Bit100-102' => {
Name => 'Channels',
ValueConv => '$val + 1',
},
'Bit103-107' => {
Name => 'BitsPerSample',
ValueConv => '$val + 1',
},
'Bit108-143' => 'TotalSamples',
'Bit144-271' => { #Tim Eliseo
Name => 'MD5Signature',
Format => 'undef',
ValueConv => 'unpack("H*",$val)',
},
);
%Image::ExifTool::FLAC::Picture = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
FORMAT => 'int32u',
0 => {
Name => 'PictureType',
PrintConv => { # (Note: Duplicated in ID3, ASF and FLAC modules!)
0 => 'Other',
1 => '32x32 PNG Icon',
2 => 'Other Icon',
3 => 'Front Cover',
4 => 'Back Cover',
5 => 'Leaflet',
6 => 'Media',
7 => 'Lead Artist',
8 => 'Artist',
9 => 'Conductor',
10 => 'Band',
11 => 'Composer',
12 => 'Lyricist',
13 => 'Recording Studio or Location',
14 => 'Recording Session',
15 => 'Performance',
16 => 'Capture from Movie or Video',
17 => 'Bright(ly) Colored Fish',
18 => 'Illustration',
19 => 'Band Logo',
20 => 'Publisher Logo',
},
},
1 => {
Name => 'PictureMIMEType',
Format => 'var_pstr32',
},
2 => {
Name => 'PictureDescription',
Format => 'var_pstr32',
ValueConv => '$self->Decode($val, "UTF8")',
},
3 => 'PictureWidth',
4 => 'PictureHeight',
5 => 'PictureBitsPerPixel',
6 => 'PictureIndexedColors',
7 => 'PictureLength',
8 => {
Name => 'Picture',
Groups => { 2 => 'Preview' },
Format => 'undef[$val{7}]',
Binary => 1,
},
);
# FLAC composite tags
%Image::ExifTool::FLAC::Composite = (
Duration => {
Require => {
0 => 'FLAC:SampleRate',
1 => 'FLAC:TotalSamples',
},
ValueConv => '($val[0] and $val[1]) ? $val[1] / $val[0] : undef',
PrintConv => 'ConvertDuration($val)',
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::FLAC');
#------------------------------------------------------------------------------
# Process information in a bit stream
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Notes: Byte order is used to determine the ordering of bits in the stream:
# 'MM' = bit 0 is most significant, 'II' = bit 0 is least significant
# - can handle arbitrarily wide values (eg. 8-byte or larger integers)
sub ProcessBitStream($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirStart = $$dirInfo{DirStart} || 0;
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
my $verbose = $et->Options('Verbose');
my $byteOrder = GetByteOrder();
my $tag;
if ($verbose) {
$et->VPrint(0, " + [BitStream directory, $dirLen bytes, '${byteOrder}' order]\n");
}
foreach $tag (sort keys %$tagTablePtr) {
next unless $tag =~ /^Bit(\d+)-?(\d+)?/;
my ($b1, $b2) = ($1, $2 || $1); # start/end bit numbers in stream
my ($i1, $i2) = (int($b1 / 8), int($b2 / 8)); # start/end byte numbers
my ($f1, $f2) = ($b1 % 8, $b2 % 8); # start/end bit numbers within each byte
last if $i2 >= $dirLen;
my ($val, $extra);
# if Format is unspecified, convert the specified number of bits to an unsigned integer,
# otherwise allow HandleTag to convert whole bytes the normal way (via undefined $val)
if (ref $$tagTablePtr{$tag} ne 'HASH' or not $$tagTablePtr{$tag}{Format}) {
my ($i, $mask);
$val = 0;
$extra = ', Mask=0x' if $verbose and ($f1 != 0 or $f2 != 7);
if ($byteOrder eq 'MM') {
# loop from high byte to low byte
for ($i=$i1; $i<=$i2; ++$i) {
$mask = 0xff;
if ($i == $i1 and $f1) {
# mask off high bits in first word (0 is high bit)
foreach ((8-$f1) .. 7) { $mask ^= (1 << $_) }
}
if ($i == $i2 and $f2 < 7) {
# mask off low bits in last word (7 is low bit)
foreach (0 .. (6-$f2)) { $mask ^= (1 << $_) }
}
$val = $val * 256 + ($mask & Get8u($dataPt, $i + $dirStart));
$extra .= sprintf('%.2x', $mask) if $extra;
}
} else {
# (FLAC is big-endian, but support little-endian bit streams
# so this routine can be used by other modules)
# loop from high byte to low byte
for ($i=$i2; $i>=$i1; --$i) {
$mask = 0xff;
if ($i == $i1 and $f1) {
# mask off low bits in first word (0 is low bit)
foreach (0 .. ($f1-1)) { $mask ^= (1 << $_) }
}
if ($i == $i2 and $f2 < 7) {
# mask off high bits in last word (7 is high bit)
foreach (($f2+1) .. 7) { $mask ^= (1 << $_) }
}
$val = $val * 256 + ($mask & Get8u($dataPt, $i + $dirStart));
$extra .= sprintf('%.2x', $mask) if $extra;
}
}
# shift word down until low bit is in position 0
until ($mask & 0x01) {
$val /= 2;
$mask >>= 1;
}
}
$et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $dirStart + $i1,
Size => $i2 - $i1 + 1,
Extra => $extra,
);
}
return 1;
}
#------------------------------------------------------------------------------
# Extract information from an Ogg FLAC file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid Ogg FLAC file
sub ProcessFLAC($$)
{
my ($et, $dirInfo) = @_;
# must first check for leading/trailing ID3 information
unless ($$et{DoneID3}) {
require Image::ExifTool::ID3;
Image::ExifTool::ID3::ProcessID3($et, $dirInfo) and return 1;
}
my $raf = $$dirInfo{RAF};
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
my ($buff, $err);
# check FLAC signature
$raf->Read($buff, 4) == 4 and $buff eq 'fLaC' or return 0;
$et->SetFileType();
SetByteOrder('MM');
my $tagTablePtr = GetTagTable('Image::ExifTool::FLAC::Main');
for (;;) {
# read next metadata block header
$raf->Read($buff, 4) == 4 or last;
my $flag = unpack('C', $buff);
my $size = unpack('N', $buff) & 0x00ffffff;
$raf->Read($buff, $size) == $size or $err = 1, last;
my $last = $flag & 0x80; # last-metadata-block flag
my $tag = $flag & 0x7f; # tag bits
if ($verbose) {
print $out "FLAC metadata block, type $tag:\n";
$et->VerboseDump(\$buff, DataPos => $raf->Tell() - $size);
}
$et->HandleTag($tagTablePtr, $tag, undef,
DataPt => \$buff,
DataPos => $raf->Tell() - $size,
);
last if $last; # all done if is set
}
$err and $et->Warn('Format error in FLAC file');
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::FLAC - Read Free Lossless Audio Codec information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to extract meta
information from Free Lossless Audio Codec (FLAC) audio files.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://flac.sourceforge.net/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/FLAC Tags>,
L<Image::ExifTool::TagNames/Ogg Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,353 @@
#------------------------------------------------------------------------------
# File: FLIF.pm
#
# Description: Read/write FLIF meta information
#
# Revisions: 2016/10/11 - P. Harvey Created
# 2016/10/14 - PH Added write support
#
# References: 1) http://flif.info/
# 2) https://github.com/FLIF-hub/FLIF/blob/master/doc/metadata
#------------------------------------------------------------------------------
package Image::ExifTool::FLIF;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.02';
my %flifMap = (
EXIF => 'FLIF',
XMP => 'FLIF',
ICC_Profile => 'FLIF',
IFD0 => 'EXIF',
IFD1 => 'IFD0',
ExifIFD => 'IFD0',
GPS => 'IFD0',
SubIFD => 'IFD0',
GlobParamIFD => 'IFD0',
PrintIM => 'IFD0',
InteropIFD => 'ExifIFD',
MakerNotes => 'ExifIFD',
);
# FLIF tags
%Image::ExifTool::FLIF::Main = (
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
VARS => { HEX_ID => 0 },
NOTES => q{
Information extracted from Free Lossless Image Format files. See
L<http://flif.info/> for more information.
},
#
# header information
#
0 => {
Name => 'ImageType',
PrintConv => {
'1' => 'Grayscale (non-interlaced)',
'3' => 'RGB (non-interlaced)',
'4' => 'RGBA (non-interlaced)',
'A' => 'Grayscale (interlaced)',
'C' => 'RGB (interlaced)',
'D' => 'RGBA (interlaced)',
'Q' => 'Grayscale Animation (non-interlaced)',
'S' => 'RGB Animation (non-interlaced)',
'T' => 'RGBA Animation (non-interlaced)',
'a' => 'Grayscale Animation (interlaced)',
'c' => 'RGB Animation (interlaced)',
'd' => 'RGBA Animation (interlaced)',
},
},
1 => {
Name => 'BitDepth',
PrintConv => {
'0' => 'Custom',
'1' => 8,
'2' => 16,
},
},
2 => 'ImageWidth',
3 => 'ImageHeight',
4 => 'AnimationFrames',
5 => {
Name => 'Encoding',
PrintConv => {
0 => 'FLIF16',
},
},
#
# metadata chunks
#
iCCP => {
Name => 'ICC_Profile',
SubDirectory => {
TagTable => 'Image::ExifTool::ICC_Profile::Main',
},
},
eXif => {
Name => 'EXIF',
SubDirectory => {
TagTable => 'Image::ExifTool::Exif::Main',
ProcessProc => \&Image::ExifTool::ProcessTIFF,
WriteProc => \&Image::ExifTool::WriteTIFF,
Start => 6, # (skip "Exif\0\0" header)
Header => "Exif\0\0",
},
},
eXmp => {
Name => 'XMP',
SubDirectory => {
TagTable => 'Image::ExifTool::XMP::Main',
},
},
# tRko - list of truncation offsets
# \0 - FLIF16-format image data
);
#------------------------------------------------------------------------------
# Read variable-length FLIF integer
# Inputs: 0) raf reference, 1) number to add to returned value
# Returns: integer, or undef on EOF
sub GetVarInt($;$)
{
my ($raf, $add) = @_;
my ($val, $buff);
for ($val=0; ; $val<<=7) {
$raf->Read($buff, 1) or return undef;
my $byte = ord($buff);
$val |= ($byte & 0x7f);
last unless $byte & 0x80;
}
return $val + ($add || 0);
}
#------------------------------------------------------------------------------
# Construct variable-length FLIF integer
# Inputs: 0) integer
# Returns: FLIF variable-length integer byte stream
sub SetVarInt($)
{
my $val = shift;
my $buff = '';
my $high = 0;
for (;;) {
$buff = chr(($val & 0x7f) | $high) . $buff;
last unless $val >>= 7;
$high = 0x80;
}
return $buff;
}
#------------------------------------------------------------------------------
# Read FLIF header
# Inputs: 0) RAF ref
# Returns: Scalar context: binary header block
# List context: header values (4 or 5 elements: type,depth,width,height[,frames])
# or undef if this isn't a valid FLIF file header
sub ReadFLIFHeader($)
{
my $raf = shift;
my ($buff, @vals);
# verify this is a valid FLIF file
return () unless $raf->Read($buff, 6) == 6 and $buff =~ /^FLIF([0-\x6f])([0-2])/;
# decode header information ("FLIF" chunk)
push @vals, $1, $2; # type, depth
push @vals, GetVarInt($raf,+1), GetVarInt($raf,+1); # width, height (+1 each)
push @vals, GetVarInt($raf,+2) if $vals[0] gt 'H'; # frames (+2)
return () unless defined $vals[-1];
return @vals if wantarray; # return the decoded header values
# return the binary header block
my $hdrLen = $raf->Tell();
return () unless $raf->Seek(0,0) and $raf->Read($buff, $hdrLen) == $hdrLen;
return $buff;
}
#------------------------------------------------------------------------------
# WriteFLIF : Write FLIF image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid FLIF file, or -1 if
# an output file was specified and a write error occurred
sub WriteFLIF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $soi, @addTags, %doneTag);
# verify FLIF header and copy it to the output file
$buff = ReadFLIFHeader($raf) or return 0;
my $outfile = $$dirInfo{OutFile};
Write($outfile, $buff) or return -1;
$et->InitWriteDirs(\%flifMap);
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIF::Main');
# loop through the FLIF chunks
for (;;) {
my ($tag, $size, $inflated);
# read new tag (or soi) unless we already hit the soi (start of image)
if (not defined $soi) {
$raf->Read($buff, 4) == 4 or $et->Error('Unexpected EOF'), last;
if ($buff lt ' ') {
$soi = $buff; # we have hit the start of image (no more metadata)
# make list of new tags to add
foreach $tag ('eXif', 'eXmp', 'iCCP') {
push @addTags, $tag if $$et{ADD_DIRS}{$$tagTablePtr{$tag}{Name}} and not $doneTag{$tag};
}
}
}
if (not defined $soi) {
$tag = $buff;
$size = GetVarInt($raf); # read the data size
} elsif (@addTags) {
$tag = shift @addTags;
($buff, $size) = ('', 0); # create metadata from scratch
} else {
# finish copying file (no more metadata to add)
Write($outfile, $soi) or return -1;
Write($outfile, $buff) or return -1 while $raf->Read($buff, 65536);
last; # all done!
}
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
if ($tagInfo and $$tagInfo{SubDirectory} and $$et{EDIT_DIRS}{$$tagInfo{Name}}) {
$doneTag{$tag} = 1; # prevent adding this back again later
unless (defined $soi) {
$raf->Read($buff, $size) == $size or $et->Error("Truncated FLIF $tag chunk"), last;
}
# rewrite the compressed data
if (eval { require IO::Uncompress::RawInflate } and eval { require IO::Compress::RawDeflate } ) {
if (length $buff == 0) {
$inflated = $buff; # (creating from scratch, so no need to inflate)
} elsif (not IO::Uncompress::RawInflate::rawinflate(\$buff => \$inflated)) {
$et->Error("Error inflating FLIF $tag chunk"), last;
}
my $subdir = $$tagInfo{SubDirectory};
my %subdirInfo = (
DirName => $$tagInfo{Name},
DataPt => \$inflated,
DirStart => length($inflated) ? $$subdir{Start} : undef,
ReadOnly => 1, # (used only by WriteXMP)
);
my $subTable = GetTagTable($$subdir{TagTable});
$inflated = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
if (defined $inflated) {
next unless length $inflated; # (delete directory if length is zero)
$inflated = $$subdir{Header} . $inflated if $$subdir{Header}; # (add back header if necessary)
unless (IO::Compress::RawDeflate::rawdeflate(\$inflated => \$buff)) {
$et->Error("Error deflating FLIF $tag chunk"), last;
}
}
} else {
$et->WarnOnce('Install IO::Compress::RawDeflate to write FLIF metadata');
}
Write($outfile, $tag, SetVarInt(length $buff), $buff) or return -1;
} elsif (not defined $soi) {
Write($outfile, $tag, SetVarInt($size)) or return -1;
Image::ExifTool::CopyBlock($raf, $outfile, $size) or return -1;
}
}
return 1;
}
#------------------------------------------------------------------------------
# Extract information from an FLIF file
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid FLIF file
sub ProcessFLIF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $tag, $inflated);
# verify this is a valid FLIF file and read the header
my @vals = ReadFLIFHeader($raf) or return 0;
$et->SetFileType();
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIF::Main');
my $verbose = $et->Options('Verbose');
# save the header information
$et->VPrint(0, "FLIF header:\n") if $verbose;
for ($tag=0; defined $vals[$tag]; ++$tag) {
$et->HandleTag($tagTablePtr, $tag, $vals[$tag]);
}
# loop through the FLIF chunks
for (;;) {
$raf->Read($tag, 4) == 4 or $et->Warn('Unexpected EOF'), last;
my $byte = ord substr($tag, 0, 1);
# all done if we arrived at the image chunk
$byte < 32 and $et->HandleTag($tagTablePtr, 5, $byte), last;
my $size = GetVarInt($raf);
$et->VPrint(0, "FLIF $tag ($size bytes):\n") if $verbose;
if ($$tagTablePtr{$tag}) {
$raf->Read($buff, $size) == $size or $et->Warn("Truncated FLIF $tag chunk"), last;
$et->VerboseDump(\$buff, Addr => $raf->Tell() - $size) if $verbose > 2;
# inflate the compressed data
if (eval { require IO::Uncompress::RawInflate }) {
if (IO::Uncompress::RawInflate::rawinflate(\$buff => \$inflated)) {
$et->HandleTag($tagTablePtr, $tag, $inflated,
DataPt => \$inflated,
Size => length $inflated,
Extra => ' inflated',
);
} else {
$et->Warn("Error inflating FLIF $tag chunk");
}
} else {
$et->WarnOnce('Install IO::Uncompress::RawInflate to decode FLIF metadata');
}
} else {
$raf->Seek($size, 1) or $et->Warn('Seek error'), last;
}
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::FLIF - Read/write FLIF meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to read and write
meta information in FLIF (Free Lossless Image Format) images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://flif.info/>
=item L<https://github.com/FLIF-hub/FLIF/blob/master/doc/metadata>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/FLIF Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,366 @@
#------------------------------------------------------------------------------
# File: Fixup.pm
#
# Description: Utility to handle pointer fixups
#
# Revisions: 01/19/2005 - P. Harvey Created
# 04/11/2005 - P. Harvey Allow fixups to be tagged with a marker,
# and add new marker-related routines
# 06/21/2006 - P. Harvey Patch to work with negative offsets
# 07/07/2006 - P. Harvey Added support for 16-bit pointers
# 02/19/2013 - P. Harvey Added IsEmpty()
#
# Data Members:
#
# Start - Position in data where a zero pointer points to.
# Shift - Amount to shift offsets (relative to Start).
# Fixups - List of Fixup object references to to shift relative to this Fixup.
# Pointers - Hash of references to fixup pointer arrays, keyed by ByteOrder
# string (with "2" added if pointer is 16-bit [default is 32-bit],
# plus "_$marker" suffix if tagged with a marker name).
#
# Procedure:
#
# 1. Create a Fixup object for each data block containing pointers
# 2. Call AddFixup with the offset of each pointer in the block
# - pointer is assumed int32u with the current byte order
# - may also be called with a fixup reference for contained blocks
# 3. Add the necessary pointer offset to $$fixup{Shift}
# 4. Add data size to $$fixup{Start} if data is added before the block
# - automatically also shifts pointers by this amount
# 5. Call ApplyFixup to apply the fixup to all pointers
# - resets Shift and Start to 0 after applying fixup
#------------------------------------------------------------------------------
package Image::ExifTool::Fixup;
use strict;
use Image::ExifTool qw(GetByteOrder SetByteOrder Get32u Get32s Set32u
Get16u Get16s Set16u);
use vars qw($VERSION);
$VERSION = '1.05';
sub AddFixup($$;$$);
sub ApplyFixup($$);
sub Dump($;$);
#------------------------------------------------------------------------------
# New - create new Fixup object
# Inputs: 0) reference to Fixup object or Fixup class name
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::Fixup';
my $self = bless {}, $class;
# initialize required members
$self->{Start} = 0;
$self->{Shift} = 0;
return $self;
}
#------------------------------------------------------------------------------
# Clone this object
# Inputs: 0) reference to Fixup object or Fixup class name
# Returns: reference to new Fixup object
sub Clone($)
{
my $self = shift;
my $clone = new Image::ExifTool::Fixup;
$clone->{Start} = $self->{Start};
$clone->{Shift} = $self->{Shift};
my $phash = $self->{Pointers};
if ($phash) {
$clone->{Pointers} = { };
my $byteOrder;
foreach $byteOrder (keys %$phash) {
my @pointers = @{$phash->{$byteOrder}};
$clone->{Pointers}->{$byteOrder} = \@pointers;
}
}
if ($self->{Fixups}) {
$clone->{Fixups} = [ ];
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
push @{$clone->{Fixups}}, $subFixup->Clone();
}
}
return $clone;
}
#------------------------------------------------------------------------------
# Add fixup pointer or another fixup object below this one
# Inputs: 0) Fixup object reference
# 1) Scalar for pointer offset, or reference to Fixup object
# 2) Optional marker name for the pointer
# 3) Optional pointer format ('int16u' or 'int32u', defaults to 'int32u')
# Notes: Byte ordering must be set properly for the pointer being added (must keep
# track of the byte order of each offset since MakerNotes may have different byte order!)
sub AddFixup($$;$$)
{
my ($self, $pointer, $marker, $format) = @_;
if (ref $pointer) {
$self->{Fixups} or $self->{Fixups} = [ ];
push @{$self->{Fixups}}, $pointer;
} else {
my $byteOrder = GetByteOrder();
if (defined $format) {
if ($format eq 'int16u') {
$byteOrder .= '2';
} elsif ($format ne 'int32u') {
warn "Bad Fixup pointer format $format\n";
}
}
$byteOrder .= "_$marker" if defined $marker;
my $phash = $self->{Pointers};
$phash or $phash = $self->{Pointers} = { };
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
push @{$phash->{$byteOrder}}, $pointer;
}
}
#------------------------------------------------------------------------------
# fix up pointer offsets
# Inputs: 0) Fixup object reference, 1) data reference
# Outputs: Collapses fixup hierarchy into linear lists of fixup pointers
sub ApplyFixup($$)
{
my ($self, $dataPt) = @_;
my $start = $self->{Start};
my $shift = $self->{Shift} + $start; # make shift relative to start
my $phash = $self->{Pointers};
# fix up pointers in this fixup
if ($phash and ($start or $shift)) {
my $saveOrder = GetByteOrder(); # save original byte ordering
my ($byteOrder, $ptr);
foreach $byteOrder (keys %$phash) {
SetByteOrder(substr($byteOrder,0,2));
# apply the fixup offset shift (must get as signed integer
# to avoid overflow in case it was negative before)
my ($get, $set) = ($byteOrder =~ /^(II2|MM2)/) ?
(\&Get16s, \&Set16u) : (\&Get32s, \&Set32u);
foreach $ptr (@{$phash->{$byteOrder}}) {
$ptr += $start; # update pointer to new start location
next unless $shift;
&$set(&$get($dataPt, $ptr) + $shift, $dataPt, $ptr);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
# recurse into contained fixups
if ($self->{Fixups}) {
# create our pointer hash if it doesn't exist
$phash or $phash = $self->{Pointers} = { };
# loop through all contained fixups
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
# adjust the subfixup start and shift
$subFixup->{Start} += $start;
$subFixup->{Shift} += $shift - $start;
# recursively apply contained fixups
ApplyFixup($subFixup, $dataPt);
my $shash = $subFixup->{Pointers} or next;
# add all pointers to our collapsed lists
my $byteOrder;
foreach $byteOrder (keys %$shash) {
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
push @{$phash->{$byteOrder}}, @{$shash->{$byteOrder}};
delete $shash->{$byteOrder};
}
delete $subFixup->{Pointers};
}
delete $self->{Fixups}; # remove our contained fixups
}
# reset our Start/Shift for the collapsed fixup
$self->{Start} = $self->{Shift} = 0;
}
#------------------------------------------------------------------------------
# Is this Fixup empty?
# Inputs: 0) Fixup object ref
# Returns: True if there are no offsets to fix
sub IsEmpty($)
{
my $self = shift;
my $phash = $self->{Pointers};
if ($phash) {
my $key;
foreach $key (keys %$phash) {
next unless ref $$phash{$key} eq 'ARRAY';
return 0 if @{$$phash{$key}};
}
}
return 1;
}
#------------------------------------------------------------------------------
# Does specified marker exist?
# Inputs: 0) Fixup object reference, 1) marker name
# Returns: True if fixup contains specified marker name
sub HasMarker($$)
{
my ($self, $marker) = @_;
my $phash = $self->{Pointers};
return 0 unless $phash;
return 1 if grep /_$marker$/, keys %$phash;
return 0 unless $self->{Fixups};
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
return 1 if $subFixup->HasMarker($marker);
}
return 0;
}
#------------------------------------------------------------------------------
# Set all marker pointers to specified value
# Inputs: 0) Fixup object reference, 1) data reference
# 2) marker name, 3) pointer value, 4) offset to start of data
sub SetMarkerPointers($$$$;$)
{
my ($self, $dataPt, $marker, $value, $startOffset) = @_;
my $start = $self->{Start} + ($startOffset || 0);
my $phash = $self->{Pointers};
if ($phash) {
my $saveOrder = GetByteOrder(); # save original byte ordering
my ($byteOrder, $ptr);
foreach $byteOrder (keys %$phash) {
next unless $byteOrder =~ /^(II|MM)(2?)_$marker$/;
SetByteOrder($1);
my $set = $2 ? \&Set16u : \&Set32u;
foreach $ptr (@{$phash->{$byteOrder}}) {
&$set($value, $dataPt, $ptr + $start);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
$subFixup->SetMarkerPointers($dataPt, $marker, $value, $start);
}
}
}
#------------------------------------------------------------------------------
# Get pointer values for specified marker
# Inputs: 0) Fixup object reference, 1) data reference,
# 2) marker name, 3) offset to start of data
# Returns: List of marker pointers in list context, or first marker pointer otherwise
sub GetMarkerPointers($$$;$)
{
my ($self, $dataPt, $marker, $startOffset) = @_;
my $start = $self->{Start} + ($startOffset || 0);
my $phash = $self->{Pointers};
my @pointers;
if ($phash) {
my $saveOrder = GetByteOrder();
my ($byteOrder, $ptr);
foreach $byteOrder (grep /_$marker$/, keys %$phash) {
SetByteOrder(substr($byteOrder,0,2));
my $get = ($byteOrder =~ /^(II2|MM2)/) ? \&Get16u : \&Get32u;
foreach $ptr (@{$phash->{$byteOrder}}) {
push @pointers, &$get($dataPt, $ptr + $start);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
push @pointers, $subFixup->GetMarkerPointers($dataPt, $marker, $start);
}
}
return @pointers if wantarray;
return $pointers[0];
}
#------------------------------------------------------------------------------
# Dump fixup to console for debugging
# Inputs: 0) Fixup object reference, 1) optional initial indent string
sub Dump($;$)
{
my ($self, $indent) = @_;
$indent or $indent = '';
printf "${indent}Fixup start=0x%x shift=0x%x\n", $self->{Start}, $self->{Shift};
my $phash = $self->{Pointers};
if ($phash) {
my $byteOrder;
foreach $byteOrder (sort keys %$phash) {
print "$indent $byteOrder: ", join(' ',@{$phash->{$byteOrder}}),"\n";
}
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
Dump($subFixup, $indent . ' ');
}
}
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Fixup - Utility to handle pointer fixups
=head1 SYNOPSIS
use Image::ExifTool::Fixup;
$fixup = new Image::ExifTool::Fixup;
# add a new fixup to a pointer at the specified offset in data
$fixup->AddFixup($offset);
# add a new Fixup object to the tree
$fixup->AddFixup($subFixup);
$fixup->{Start} += $shift1; # shift pointer offsets and values
$fixup->{Shift} += $shift2; # shift pointer values only
# recursively apply fixups to the specified data
$fixup->ApplyFixups(\$data);
$fixup->Dump(); # dump debugging information
$fixup->IsEmpty(); # return true if no offsets to fix
=head1 DESCRIPTION
This module contains the code to keep track of pointers in memory and to
shift these pointers as required. It is used by ExifTool to maintain the
pointers in image file directories (IFD's).
=head1 NOTES
Keeps track of pointers with different byte ordering, and relies on
Image::ExifTool::GetByteOrder() to determine the current byte ordering
when adding new pointers to a fixup.
Maintains a hierarchical list of fixups so that the whole hierarchy can
be shifted by a simple shift at the base. Hierarchy is collapsed to a
linear list when ApplyFixups() is called.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,755 @@
#------------------------------------------------------------------------------
# File: Flash.pm
#
# Description: Read Shockwave Flash meta information
#
# Revisions: 05/16/2006 - P. Harvey Created
# 06/07/2007 - PH Added support for FLV (Flash Video) files
# 10/23/2008 - PH Added support for XMP in FLV and SWF
#
# References: 1) http://www.the-labs.com/MacromediaFlash/SWF-Spec/SWFfileformat.html
# 2) http://sswf.sourceforge.net/SWFalexref.html
# 3) http://osflash.org/flv/
# 4) http://www.irisa.fr/texmex/people/dufouil/ffmpegdoxy/flv_8h.html
# 5) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf (Oct 2008)
# 6) http://www.adobe.com/devnet/swf/pdf/swf_file_format_spec_v9.pdf
# 7) http://help.adobe.com/en_US/FlashMediaServer/3.5_Deving/WS5b3ccc516d4fbf351e63e3d11a0773d56e-7ff6.html
# 8) http://www.adobe.com/devnet/flv/pdf/video_file_format_spec_v10.pdf
#
# Notes: I'll add AMF3 support if someone sends me a FLV with AMF3 data
#------------------------------------------------------------------------------
package Image::ExifTool::Flash;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::FLAC;
$VERSION = '1.12';
sub ProcessMeta($$$;$);
# Meta packets that we process
my %processMetaPacket = ( onMetaData => 1, onXMPData => 1 );
# information extracted from SWF header
%Image::ExifTool::Flash::Main = (
GROUPS => { 2 => 'Video' },
VARS => { ALPHA_FIRST => 1 },
NOTES => q{
The information below is extracted from SWF (Shockwave Flash) files. Tags
with string ID's represent information extracted from the file header.
},
FlashVersion => { },
Compressed => { PrintConv => { 0 => 'False', 1 => 'True' } },
ImageWidth => { },
ImageHeight => { },
FrameRate => { },
FrameCount => { },
Duration => {
Notes => 'calculated from FrameRate and FrameCount',
PrintConv => 'ConvertDuration($val)',
},
69 => {
Name => 'FlashAttributes',
PrintConv => { BITMASK => {
0 => 'UseNetwork',
3 => 'ActionScript3',
4 => 'HasMetadata',
} },
},
77 => {
Name => 'XMP',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
},
);
# packets in Flash Video files
%Image::ExifTool::Flash::FLV = (
NOTES => q{
Information is extracted from the following packets in FLV (Flash Video)
files.
},
0x08 => {
Name => 'Audio',
BitMask => 0x04,
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Audio' },
},
0x09 => {
Name => 'Video',
BitMask => 0x01,
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Video' },
},
0x12 => {
Name => 'Meta',
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Meta' },
},
);
# tags in Flash Video packet header
%Image::ExifTool::Flash::Audio = (
PROCESS_PROC => \&Image::ExifTool::FLAC::ProcessBitStream,
GROUPS => { 2 => 'Audio' },
NOTES => 'Information extracted from the Flash Audio header.',
'Bit0-3' => {
Name => 'AudioEncoding',
PrintConv => {
0 => 'PCM-BE (uncompressed)', # PCM-BE according to ref 4
1 => 'ADPCM',
2 => 'MP3',
3 => 'PCM-LE (uncompressed)', #4
4 => 'Nellymoser 16kHz Mono', #8
5 => 'Nellymoser 8kHz Mono',
6 => 'Nellymoser',
7 => 'G.711 A-law logarithmic PCM', #8
8 => 'G.711 mu-law logarithmic PCM', #8
# (9 is reserved, ref 8)
10 => 'AAC', #8
11 => 'Speex', #8
13 => 'MP3 8-Khz', #8
15 => 'Device-specific sound', #8
},
},
'Bit4-5' => {
Name => 'AudioSampleRate',
ValueConv => {
0 => 5512,
1 => 11025,
2 => 22050,
3 => 44100,
},
},
'Bit6' => {
Name => 'AudioBitsPerSample',
ValueConv => '8 * ($val + 1)',
},
'Bit7' => {
Name => 'AudioChannels',
ValueConv => '$val + 1',
PrintConv => {
1 => '1 (mono)',
2 => '2 (stereo)',
},
},
);
# tags in Flash Video packet header
%Image::ExifTool::Flash::Video = (
PROCESS_PROC => \&Image::ExifTool::FLAC::ProcessBitStream,
GROUPS => { 2 => 'Video' },
NOTES => 'Information extracted from the Flash Video header.',
'Bit4-7' => {
Name => 'VideoEncoding',
PrintConv => {
1 => 'JPEG', #8
2 => 'Sorensen H.263',
3 => 'Screen Video',
4 => 'On2 VP6',
5 => 'On2 VP6 Alpha', #3
6 => 'Screen Video 2', #3
7 => 'H.264', #7 (called "AVC" by ref 8)
},
},
);
# tags in Flash META packet (in ActionScript Message Format)
%Image::ExifTool::Flash::Meta = (
PROCESS_PROC => \&ProcessMeta,
GROUPS => { 2 => 'Video' },
NOTES => q{
Below are a few observed FLV Meta tags, but ExifTool will attempt to extract
information from any tag found.
},
'audiocodecid' => { Name => 'AudioCodecID', Groups => { 2 => 'Audio' } },
'audiodatarate' => {
Name => 'AudioBitrate',
Groups => { 2 => 'Audio' },
ValueConv => '$val * 1000',
PrintConv => 'ConvertBitrate($val)',
},
'audiodelay' => { Name => 'AudioDelay', Groups => { 2 => 'Audio' } },
'audiosamplerate'=>{ Name => 'AudioSampleRate', Groups => { 2 => 'Audio' } },
'audiosamplesize'=>{ Name => 'AudioSampleSize', Groups => { 2 => 'Audio' } },
'audiosize' => { Name => 'AudioSize', Groups => { 2 => 'Audio' } },
'bytelength' => 'ByteLength', # (youtube)
'canseekontime' => 'CanSeekOnTime', # (youtube)
'canSeekToEnd' => 'CanSeekToEnd',
'creationdate' => {
# (not an AMF date type in my sample)
Name => 'CreateDate',
Groups => { 2 => 'Time' },
ValueConv => '$val=~s/\s+$//; $val', # trim trailing whitespace
},
'createdby' => 'CreatedBy', #7
'cuePoints' => {
Name => 'CuePoint',
SubDirectory => { TagTable => 'Image::ExifTool::Flash::CuePoint' },
},
'datasize' => 'DataSize',
'duration' => {
Name => 'Duration',
PrintConv => 'ConvertDuration($val)',
},
'filesize' => 'FileSizeBytes',
'framerate' => {
Name => 'FrameRate',
PrintConv => 'int($val * 1000 + 0.5) / 1000',
},
'hasAudio' => { Name => 'HasAudio', Groups => { 2 => 'Audio' } },
'hasCuePoints' => 'HasCuePoints',
'hasKeyframes' => 'HasKeyFrames',
'hasMetadata' => 'HasMetadata',
'hasVideo' => 'HasVideo',
'height' => 'ImageHeight',
'httphostheader'=> 'HTTPHostHeader', # (youtube)
'keyframesTimes'=> 'KeyFramesTimes',
'keyframesFilepositions' => 'KeyFramePositions',
'lasttimestamp' => 'LastTimeStamp',
'lastkeyframetimestamp' => 'LastKeyFrameTime',
'metadatacreator'=>'MetadataCreator',
'metadatadate' => {
Name => 'MetadataDate',
Groups => { 2 => 'Time' },
PrintConv => '$self->ConvertDateTime($val)',
},
'purl' => 'URL', # (youtube) (what does P mean?)
'pmsg' => 'Message', # (youtube) (what does P mean?)
'sourcedata' => 'SourceData', # (youtube)
'starttime' => { # (youtube)
Name => 'StartTime',
PrintConv => 'ConvertDuration($val)',
},
'stereo' => { Name => 'Stereo', Groups => { 2 => 'Audio' } },
'totalduration' => { # (youtube)
Name => 'TotalDuration',
PrintConv => 'ConvertDuration($val)',
},
'totaldatarate' => { # (youtube)
Name => 'TotalDataRate',
ValueConv => '$val * 1000',
PrintConv => 'int($val + 0.5)',
},
'totalduration' => 'TotalDuration',
'videocodecid' => 'VideoCodecID',
'videodatarate' => {
Name => 'VideoBitrate',
ValueConv => '$val * 1000',
PrintConv => 'ConvertBitrate($val)',
},
'videosize' => 'VideoSize',
'width' => 'ImageWidth',
# tags in 'onXMPData' packets
'liveXML' => { #5
Name => 'XMP',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
},
);
# tags in Flash META CuePoint structure
%Image::ExifTool::Flash::CuePoint = (
PROCESS_PROC => \&ProcessMeta,
GROUPS => { 2 => 'Video' },
NOTES => q{
These tag names are added to the CuePoint name to generate complete tag
names like "CuePoint0Name".
},
'name' => 'Name',
'type' => 'Type',
'time' => 'Time',
'parameters' => {
Name => 'Parameter',
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Parameter' },
},
);
# tags in Flash META CuePoint Parameter structure
%Image::ExifTool::Flash::Parameter = (
PROCESS_PROC => \&ProcessMeta,
GROUPS => { 2 => 'Video' },
NOTES => q{
There are no pre-defined parameter tags, but ExifTool will extract any
existing parameters, with tag names like "CuePoint0ParameterXxx".
},
);
# name lookup for known AMF data types
my @amfType = qw(double boolean string object movieClip null undefined reference
mixedArray objectEnd array date longString unsupported recordSet
XML typedObject AMF3data);
# test for AMF structure types (object, mixed array or typed object)
my %isStruct = ( 0x03 => 1, 0x08 => 1, 0x10 => 1 );
#------------------------------------------------------------------------------
# Process Flash Video AMF Meta packet (ref 3)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# 3) Set to extract single type/value only
# Returns: 1 on success, (or type/value if extracting single value)
# Notes: Updates DataPos in dirInfo if extracting single value
sub ProcessMeta($$$;$)
{
my ($et, $dirInfo, $tagTablePtr, $single) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirLen = $$dirInfo{DirLen} || length($$dataPt);
my $pos = $$dirInfo{Pos} || 0;
my ($type, $val, $rec);
$et->VerboseDir('Meta') unless $single;
Record: for ($rec=0; ; ++$rec) {
last if $pos >= $dirLen;
$type = ord(substr($$dataPt, $pos));
++$pos;
if ($type == 0x00 or $type == 0x0b) { # double or date
last if $pos + 8 > $dirLen;
$val = GetDouble($dataPt, $pos);
$pos += 8;
if ($type == 0x0b) { # date
$val /= 1000; # convert to seconds
my $frac = $val - int($val); # fractional seconds
# get time zone
last if $pos + 2 > $dirLen;
my $tz = Get16s($dataPt, $pos);
$pos += 2;
# construct date/time string
$val = Image::ExifTool::ConvertUnixTime(int($val));
if ($frac) {
$frac = sprintf('%.6f', $frac);
$frac =~ s/(^0|0+$)//g;
$val .= $frac;
}
# add timezone
if ($tz < 0) {
$val .= '-';
$tz *= -1;
} else {
$val .= '+';
}
$val .= sprintf('%.2d:%.2d', int($tz/60), $tz%60);
}
} elsif ($type == 0x01) { # boolean
last if $pos + 1 > $dirLen;
$val = Get8u($dataPt, $pos);
$val = { 0 => 'No', 1 => 'Yes' }->{$val} if $val < 2;
++$pos;
} elsif ($type == 0x02) { # string
last if $pos + 2 > $dirLen;
my $len = Get16u($dataPt, $pos);
last if $pos + 2 + $len > $dirLen;
$val = substr($$dataPt, $pos + 2, $len);
$pos += 2 + $len;
} elsif ($isStruct{$type}) { # object, mixed array or typed object
$et->VPrint(1, " + [$amfType[$type]]\n");
my $getName;
$val = ''; # dummy value
if ($type == 0x08) { # mixed array
# skip last array index for mixed array
last if $pos + 4 > $dirLen;
$pos += 4;
} elsif ($type == 0x10) { # typed object
$getName = 1;
}
for (;;) {
# get tag ID (or typed object name)
last Record if $pos + 2 > $dirLen;
my $len = Get16u($dataPt, $pos);
if ($pos + 2 + $len > $dirLen) {
$et->Warn("Truncated $amfType[$type] record");
last Record;
}
my $tag = substr($$dataPt, $pos + 2, $len);
$pos += 2 + $len;
# first string of a typed object is the object name
if ($getName) {
$et->VPrint(1," | (object name '${tag}')\n");
undef $getName;
next; # (ignore name for now)
}
my $subTablePtr = $tagTablePtr;
my $tagInfo = $$subTablePtr{$tag};
# switch to subdirectory table if necessary
if ($tagInfo and $$tagInfo{SubDirectory}) {
my $subTable = $tagInfo->{SubDirectory}->{TagTable};
# descend into Flash SubDirectory
if ($subTable =~ /^Image::ExifTool::Flash::/) {
$tag = $$tagInfo{Name}; # use our name for the tag
$subTablePtr = GetTagTable($subTable);
}
}
# get object value
my $valPos = $pos + 1;
$$dirInfo{Pos} = $pos;
my $structName = $$dirInfo{StructName};
# add structure name to start of tag name
$tag = $structName . ucfirst($tag) if defined $structName;
$$dirInfo{StructName} = $tag; # set new structure name
my ($t, $v) = ProcessMeta($et, $dirInfo, $subTablePtr, 1);
$$dirInfo{StructName} = $structName;# restore original structure name
$pos = $$dirInfo{Pos}; # update to new position in packet
# all done if this value contained tags
last Record unless defined $t and defined $v;
next if $isStruct{$t}; # already handled tags in sub-structures
next if ref($v) eq 'ARRAY' and not @$v; # ignore empty arrays
last if $t == 0x09; # (end of object)
if (not $$subTablePtr{$tag} and $tag =~ /^\w+$/) {
AddTagToTable($subTablePtr, $tag, { Name => ucfirst($tag) });
$et->VPrint(1, " | (adding $tag)\n");
}
$et->HandleTag($subTablePtr, $tag, $v,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $valPos,
Size => $pos - $valPos,
Format => $amfType[$t] || sprintf('0x%x',$t),
);
}
# } elsif ($type == 0x04) { # movie clip (not supported)
} elsif ($type == 0x05 or $type == 0x06 or $type == 0x09 or $type == 0x0d) {
# null, undefined, dirLen of object, or unsupported
$val = '';
} elsif ($type == 0x07) { # reference
last if $pos + 2 > $dirLen;
$val = Get16u($dataPt, $pos);
$pos += 2;
} elsif ($type == 0x0a) { # array
last if $pos + 4 > $dirLen;
my $num = Get32u($dataPt, $pos);
$$dirInfo{Pos} = $pos + 4;
my ($i, @vals);
# add array index to compount tag name
my $structName = $$dirInfo{StructName};
for ($i=0; $i<$num; ++$i) {
$$dirInfo{StructName} = $structName . $i if defined $structName;
my ($t, $v) = ProcessMeta($et, $dirInfo, $tagTablePtr, 1);
last Record unless defined $v;
# save value unless contained in a sub-structure
push @vals, $v unless $isStruct{$t};
}
$$dirInfo{StructName} = $structName;
$pos = $$dirInfo{Pos};
$val = \@vals;
} elsif ($type == 0x0c or $type == 0x0f) { # long string or XML
last if $pos + 4 > $dirLen;
my $len = Get32u($dataPt, $pos);
last if $pos + 4 + $len > $dirLen;
$val = substr($$dataPt, $pos + 4, $len);
$pos += 4 + $len;
# } elsif ($type == 0x0e) { # record set (not supported)
# } elsif ($type == 0x11) { # AMF3 data (can't add support for this without a test sample)
} else {
my $t = $amfType[$type] || sprintf('type 0x%x',$type);
$et->Warn("AMF $t record not yet supported");
undef $type; # (so we don't print another warning)
last; # can't continue
}
last if $single; # all done if extracting single value
unless ($isStruct{$type}) {
# only process certain Meta packets
if ($type == 0x02 and not $rec) {
my $verb = $processMetaPacket{$val} ? 'processing' : 'ignoring';
$et->VPrint(0, " | ($verb $val information)\n");
last unless $processMetaPacket{$val};
} else {
# give verbose indication if we ignore a lone value
my $t = $amfType[$type] || sprintf('type 0x%x',$type);
$et->VPrint(1, " | (ignored lone $t value '${val}')\n");
}
}
}
if (not defined $val and defined $type) {
$et->Warn(sprintf("Truncated AMF record 0x%x",$type));
}
return 1 unless $single; # all done
$$dirInfo{Pos} = $pos; # update position
return($type,$val); # return single type/value pair
}
#------------------------------------------------------------------------------
# Read information frame a Flash Video file
# Inputs: 0) ExifTool object reference, 1) Directory information reference
# Returns: 1 on success, 0 if this wasn't a valid Flash Video file
sub ProcessFLV($$)
{
my ($et, $dirInfo) = @_;
my $verbose = $et->Options('Verbose');
my $raf = $$dirInfo{RAF};
my $buff;
$raf->Read($buff, 9) == 9 or return 0;
$buff =~ /^FLV\x01/ or return 0;
SetByteOrder('MM');
$et->SetFileType();
my ($flags, $offset) = unpack('x4CN', $buff);
$raf->Seek($offset-9, 1) or return 1 if $offset > 9;
$flags &= 0x05; # only look for audio/video
my $found = 0;
my $tagTablePtr = GetTagTable('Image::ExifTool::Flash::FLV');
for (;;) {
$raf->Read($buff, 15) == 15 or last;
my $len = unpack('x4N', $buff);
my $type = $len >> 24;
$len &= 0x00ffffff;
my $tagInfo = $et->GetTagInfo($tagTablePtr, $type);
if ($verbose > 1) {
my $name = $tagInfo ? $$tagInfo{Name} : "type $type";
$et->VPrint(1, "FLV $name packet, len $len\n");
}
undef $buff;
if ($tagInfo and $$tagInfo{SubDirectory}) {
my $mask = $$tagInfo{BitMask};
if ($mask) {
# handle audio or video packet
unless ($found & $mask) {
$found |= $mask;
$flags &= ~$mask;
if ($len>=1 and $raf->Read($buff, 1) == 1) {
$len -= 1;
} else {
$et->Warn("Bad $$tagInfo{Name} packet");
last;
}
}
} elsif ($raf->Read($buff, $len) == $len) {
$len = 0;
} else {
$et->Warn('Truncated Meta packet');
last;
}
}
if (defined $buff) {
$et->HandleTag($tagTablePtr, $type, undef,
DataPt => \$buff,
DataPos => $raf->Tell() - length($buff),
);
}
last unless $flags;
$raf->Seek($len, 1) or last if $len;
}
return 1;
}
#------------------------------------------------------------------------------
# Found a Flash tag
# Inputs: 0) ExifTool object ref, 1) tag name, 2) tag value
sub FoundFlashTag($$$)
{
my ($et, $tag, $val) = @_;
$et->HandleTag(\%Image::ExifTool::Flash::Main, $tag, $val);
}
#------------------------------------------------------------------------------
# Read data from possibly compressed file
# Inputs: 0) RAF reference, 1) data buffer, 2) bytes to read, 2) compressed flag
# Returns: number of bytes read (may be greater than requested bytes if compressed)
# - concatenates data to current buffer
# - updates compressed flag with reference to inflate object for future calls
# (or sets to error message and returns zero on error)
sub ReadCompressed($$$$)
{
my ($raf, $len, $inflate) = ($_[0], $_[2], $_[3]);
my $buff;
unless ($raf->Read($buff, $len)) {
$_[3] = 'Error reading file';
return 0;
}
# uncompress if necessary
if ($inflate) {
unless (ref $inflate) {
unless (eval { require Compress::Zlib }) {
$_[3] = 'Install Compress::Zlib to extract compressed information';
return 0;
}
$inflate = Compress::Zlib::inflateInit();
unless ($inflate) {
$_[3] = 'Error initializing inflate for Flash data';
return 0;
}
$_[3] = $inflate; # pass inflate object back to caller
}
my $tmp = $buff;
$buff = '';
# read 64 more bytes at a time and inflate until we get enough uncompressed data
for (;;) {
my ($dat, $stat) = $inflate->inflate($tmp);
if ($stat == Compress::Zlib::Z_STREAM_END() or
$stat == Compress::Zlib::Z_OK())
{
$buff .= $dat; # add inflated data to buffer
last if length $buff >= $len or $stat == Compress::Zlib::Z_STREAM_END();
$raf->Read($tmp,64) or last; # must read a bit more data
} else {
$buff = '';
last;
}
}
$_[3] = 'Error inflating compressed Flash data' unless length $buff;
}
$_[1] = defined $_[1] ? $_[1] . $buff : $buff;
return length $buff;
}
#------------------------------------------------------------------------------
# Read information frame a Flash file
# Inputs: 0) ExifTool object reference, 1) Directory information reference
# Returns: 1 on success, 0 if this wasn't a valid Flash file
sub ProcessSWF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $hasMeta);
$raf->Read($buff, 8) == 8 or return 0;
$buff =~ /^(F|C)WS([^\0])/ or return 0;
my ($compressed, $vers) = ($1 eq 'C' ? 1 : 0, ord($2));
SetByteOrder('II');
$et->SetFileType();
GetTagTable('Image::ExifTool::Flash::Main'); # make sure table is initialized
FoundFlashTag($et, FlashVersion => $vers);
FoundFlashTag($et, Compressed => $compressed);
# read the next 64 bytes of the file (and inflate if necessary)
$buff = '';
unless (ReadCompressed($raf, $buff, 64, $compressed)) {
$et->Warn($compressed) if $compressed;
return 1;
}
# unpack elements of bit-packed Flash Rect structure
my $nBits = unpack('C', $buff) >> 3; # bits in x1,x2,y1,y2 elements
my $totBits = 5 + $nBits * 4; # total bits in Rect structure
my $nBytes = int(($totBits + 7) / 8); # byte length of Rect structure
if (length $buff < $nBytes + 4) {
$et->Warn('Truncated Flash file');
return 1;
}
my $bits = unpack("B$totBits", $buff);
# isolate Rect elements and convert from ASCII bit strings to integers
my @vals = unpack('x5' . "a$nBits" x 4, $bits);
# (do conversion the hard way because oct("0b$val") requires Perl 5.6)
map { $_ = unpack('N', pack('B32', '0' x (32 - length $_) . $_)) } @vals;
# calculate and store ImageWidth/Height
FoundFlashTag($et, ImageWidth => ($vals[1] - $vals[0]) / 20);
FoundFlashTag($et, ImageHeight => ($vals[3] - $vals[2]) / 20);
# get frame rate and count
@vals = unpack("x${nBytes}v2", $buff);
FoundFlashTag($et, FrameRate => $vals[0] / 256);
FoundFlashTag($et, FrameCount => $vals[1]);
FoundFlashTag($et, Duration => $vals[1] * 256 / $vals[0]) if $vals[0];
# scan through the tags to find FlashAttributes and XMP
$buff = substr($buff, $nBytes + 4);
for (;;) {
my $buffLen = length $buff;
last if $buffLen < 2;
my $code = Get16u(\$buff, 0);
my $pos = 2;
my $tag = $code >> 6;
my $size = $code & 0x3f;
$et->VPrint(1, "SWF tag $tag ($size bytes):\n");
last unless $tag == 69 or $tag == 77 or $hasMeta;
# read enough to get a complete short record
if ($pos + $size > $buffLen) {
# (read 2 extra bytes if available to get next tag word)
unless (ReadCompressed($raf, $buff, $size + 2, $compressed)) {
$et->Warn($compressed) if $compressed;
return 1;
}
$buffLen = length $buff;
last if $pos + $size > $buffLen;
}
# read extended record if necessary
if ($size == 0x3f) {
last if $pos + 4 > $buffLen;
$size = Get32u(\$buff, $pos);
$pos += 4;
last if $size > 1000000; # don't read anything huge
if ($pos + $size > $buffLen) {
unless (ReadCompressed($raf, $buff, $size + 2, $compressed)) {
$et->Warn($compressed) if $compressed;
return 1;
}
$buffLen = length $buff;
last if $pos + $size > $buffLen;
}
$et->VPrint(1, " [extended size $size bytes]\n");
}
if ($tag == 69) { # FlashAttributes
last unless $size;
my $flags = Get8u(\$buff, $pos);
FoundFlashTag($et, $tag => $flags);
last unless $flags & 0x10; # only continue if we have metadata (XMP)
$hasMeta = 1;
} elsif ($tag == 77) { # Metadata
my $val = substr($buff, $pos, $size);
FoundFlashTag($et, $tag => $val);
last;
}
last if $pos + 2 > $buffLen;
$buff = substr($buff, $pos); # remove everything before the next tag
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Flash - Read Shockwave Flash meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read SWF
(Shockwave Flash) and FLV (Flash Video) files.
=head1 NOTES
Flash Video AMF3 support has not yet been added because I haven't yet found
a FLV file containing AMF3 information. If someone sends me a sample then I
will add AMF3 support.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.the-labs.com/MacromediaFlash/SWF-Spec/SWFfileformat.html>
=item L<http://sswf.sourceforge.net/SWFalexref.html>
=item L<http://osflash.org/flv/>
=item L<http://www.irisa.fr/texmex/people/dufouil/ffmpegdoxy/flv_8h.html>
=item L<http://help.adobe.com/en_US/FlashMediaServer/3.5_Deving/WS5b3ccc516d4fbf351e63e3d11a0773d56e-7ff6.html>
=item L<http://www.adobe.com/devnet/swf/pdf/swf_file_format_spec_v9.pdf>
=item L<http://www.adobe.com/devnet/flv/pdf/video_file_format_spec_v10.pdf>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/Flash Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,647 @@
#------------------------------------------------------------------------------
# File: Font.pm
#
# Description: Read meta information from font files
#
# Revisions: 2010/01/15 - P. Harvey Created
#
# References: 1) http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html
# 2) http://www.microsoft.com/typography/otspec/otff.htm
# 3) http://partners.adobe.com/public/developer/opentype/index_font_file.html
# 4) http://partners.adobe.com/public/developer/en/font/5178.PFM.pdf
# 5) http://opensource.adobe.com/svn/opensource/flex/sdk/trunk/modules/compiler/src/java/flex2/compiler/util/MimeMappings.java
# 6) http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf
#------------------------------------------------------------------------------
package Image::ExifTool::Font;
use strict;
use vars qw($VERSION %ttLang);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.08';
sub ProcessOTF($$);
# TrueType 'name' platform codes
my %ttPlatform = (
0 => 'Unicode',
1 => 'Macintosh',
2 => 'ISO',
3 => 'Windows',
4 => 'Custom',
);
# convert TrueType 'name' character encoding to ExifTool Charset (ref 1/2)
my %ttCharset = (
Macintosh => {
0 => 'MacRoman', 17 => 'MacMalayalam',
1 => 'MacJapanese', 18 => 'MacSinhalese',
2 => 'MacChineseTW', 19 => 'MacBurmese',
3 => 'MacKorean', 20 => 'MacKhmer',
4 => 'MacArabic', 21 => 'MacThai',
5 => 'MacHebrew', 22 => 'MacLaotian',
6 => 'MacGreek', 23 => 'MacGeorgian',
7 => 'MacCyrillic', 24 => 'MacArmenian', # 7=Russian
8 => 'MacRSymbol', 25 => 'MacChineseCN',
9 => 'MacDevanagari', 26 => 'MacTibetan',
10 => 'MacGurmukhi', 27 => 'MacMongolian',
11 => 'MacGujarati', 28 => 'MacGeez',
12 => 'MacOriya', 29 => 'MacCyrillic', # 29=Slavic
13 => 'MacBengali', 30 => 'MacVietnam',
14 => 'MacTamil', 31 => 'MacSindhi',
15 => 'MacTelugu', 32 => '', # 32=uninterpreted
16 => 'MacKannada',
},
Windows => {
0 => 'Symbol', 4 => 'Big5',
1 => 'UCS2', 5 => 'Wansung',
2 => 'ShiftJIS', 6 => 'Johab',
3 => 'PRC', 10 => 'UCS4',
},
Unicode => {
# (we don't currently handle the various Unicode flavours)
0 => 'UCS2', # Unicode 1.0 semantics
1 => 'UCS2', # Unicode 1.1 semantics
2 => 'UCS2', # ISO 10646 semantics
3 => 'UCS2', # Unicode 2.0 and onwards semantics, Unicode BMP only.
4 => 'UCS2', # Unicode 2.0 and onwards semantics, Unicode full repertoire.
# 5 => Unicode Variation Sequences (not used in Naming table)
},
ISO => { # (deprecated)
0 => 'UTF8', # (7-bit ASCII)
1 => 'UCS2', # ISO 10646
2 => 'Latin', # ISO 8859-1
},
Custom => { },
);
# convert TrueType 'name' language code to ExifTool language code
%ttLang = (
# Macintosh language codes (also used by QuickTime.pm)
# oddities:
# 49 - Cyrllic version 83 - Roman
# 50 - Arabic version 84 - Arabic
# 146 - with dot above
Macintosh => {
0 => 'en', 24 => 'lt', 48 => 'kk', 72 => 'ml', 129 => 'eu',
1 => 'fr', 25 => 'pl', 49 => 'az', 73 => 'kn', 130 => 'ca',
2 => 'de', 26 => 'hu', 50 => 'az', 74 => 'ta', 131 => 'la',
3 => 'it', 27 => 'et', 51 => 'hy', 75 => 'te', 132 => 'qu',
4 => 'nl', 28 => 'lv', 52 => 'ka', 76 => 'si', 133 => 'gn',
5 => 'sv', 29 => 'smi', 53 => 'ro', 77 => 'my', 134 => 'ay',
6 => 'es', 30 => 'fo', 54 => 'ky', 78 => 'km', 135 => 'tt',
7 => 'da', 31 => 'fa', 55 => 'tg', 79 => 'lo', 136 => 'ug',
8 => 'pt', 32 => 'ru', 56 => 'tk', 80 => 'vi', 137 => 'dz',
9 => 'no', 33 => 'zh-CN', 57 => 'mn-MN', 81 => 'id', 138 => 'jv',
10 => 'he', 34 => 'nl', 58 => 'mn-CN', 82 => 'tl', 139 => 'su',
11 => 'ja', 35 => 'ga', 59 => 'ps', 83 => 'ms-MY', 140 => 'gl',
12 => 'ar', 36 => 'sq', 60 => 'ku', 84 => 'ms-BN', 141 => 'af',
13 => 'fi', 37 => 'ro', 61 => 'ks', 85 => 'am', 142 => 'br',
14 => 'iu', 38 => 'cs', 62 => 'sd', 86 => 'ti', 144 => 'gd',
15 => 'is', 39 => 'sk', 63 => 'bo', 87 => 'om', 145 => 'vg',
16 => 'mt', 40 => 'sl', 64 => 'ne', 88 => 'so', 146 => 'ga',
17 => 'tr', 41 => 'yi', 65 => 'sa', 89 => 'sw', 147 => 'rar',
18 => 'hr', 42 => 'sr', 66 => 'mr', 90 => 'rw', 148 => 'el',
19 => 'zh-TW', 43 => 'mk', 67 => 'bn', 91 => 'rn', 149 => 'kl',
20 => 'ur', 44 => 'bg', 68 => 'as', 92 => 'ny', 150 => 'az',
21 => 'hi', 45 => 'uk', 69 => 'gu', 93 => 'mg',
22 => 'th', 46 => 'be', 70 => 'pa', 94 => 'eo',
23 => 'ko', 47 => 'uz', 71 => 'or', 128 => 'cy',
},
# Windows language codes (http://msdn.microsoft.com/en-us/library/0h88fahh(VS.85).aspx)
# Notes: This isn't an exact science. The reference above gives language codes
# which are different from some ISO 639-1 numbers. Also, some Windows language
# codes don't appear to have ISO 639-1 equivalents.
# 0x0428 - fa by ref above
# 0x048c - no ISO equivalent
# 0x081a/0x83c - sr-SP
# 0x0c0a - modern?
# 0x2409 - Carribean country code not found in ISO 3166-1
Windows => {
0x0401 => 'ar-SA', 0x0438 => 'fo', 0x0481 => 'mi', 0x1409 => 'en-NZ',
0x0402 => 'bg', 0x0439 => 'hi', 0x0482 => 'oc', 0x140a => 'es-CR',
0x0403 => 'ca', 0x043a => 'mt', 0x0483 => 'co', 0x140c => 'fr-LU',
0x0404 => 'zh-TW', 0x043b => 'se-NO', 0x0484 => 'gsw', 0x141a => 'bs-BA',
0x0405 => 'cs', 0x043c => 'gd', 0x0485 => 'sah', 0x143b => 'smj-SE',
0x0406 => 'da', 0x043d => 'yi', 0x0486 => 'ny', 0x1801 => 'ar-MA',
0x0407 => 'de-DE', 0x043e => 'ms-MY', 0x0487 => 'rw', 0x1809 => 'en-IE',
0x0408 => 'el', 0x043f => 'kk', 0x048c => 'Dari', 0x180a => 'es-PA',
0x0409 => 'en-US', 0x0440 => 'ky', 0x0801 => 'ar-IQ', 0x180c => 'fr-MC',
0x040a => 'es-ES', 0x0441 => 'sw', 0x0804 => 'zh-CN', 0x181a => 'sr-BA',
0x040b => 'fi', 0x0442 => 'tk', 0x0807 => 'de-CH', 0x183b => 'sma-NO',
0x040c => 'fr-FR', 0x0443 => 'uz-UZ', 0x0809 => 'en-GB', 0x1c01 => 'ar-TN',
0x040d => 'he', 0x0444 => 'tt', 0x080a => 'es-MX', 0x1c09 => 'en-ZA',
0x040e => 'hu', 0x0445 => 'bn-IN', 0x080c => 'fr-BE', 0x1c0a => 'es-DO',
0x040f => 'is', 0x0446 => 'pa', 0x0810 => 'it-CH', 0x1c1a => 'sr-BA',
0x0410 => 'it-IT', 0x0447 => 'gu', 0x0813 => 'nl-BE', 0x1c3b => 'sma-SE',
0x0411 => 'ja', 0x0448 => 'wo', 0x0814 => 'nn', 0x2001 => 'ar-OM',
0x0412 => 'ko', 0x0449 => 'ta', 0x0816 => 'pt-PT', 0x2009 => 'en-JM',
0x0413 => 'nl-NL', 0x044a => 'te', 0x0818 => 'ro-MO', 0x200a => 'es-VE',
0x0414 => 'no-NO', 0x044b => 'kn', 0x0819 => 'ru-MO', 0x201a => 'bs-BA',
0x0415 => 'pl', 0x044c => 'ml', 0x081a => 'sr-RS', 0x203b => 'sms',
0x0416 => 'pt-BR', 0x044d => 'as', 0x081d => 'sv-FI', 0x2401 => 'ar-YE',
0x0417 => 'rm', 0x044e => 'mr', 0x082c => 'az-AZ', 0x2409 => 'en-CB',
0x0418 => 'ro', 0x044f => 'sa', 0x082e => 'dsb', 0x240a => 'es-CO',
0x0419 => 'ru', 0x0450 => 'mn-MN', 0x083b => 'se-SE', 0x243b => 'smn',
0x041a => 'hr', 0x0451 => 'bo', 0x083c => 'ga', 0x2801 => 'ar-SY',
0x041b => 'sk', 0x0452 => 'cy', 0x083e => 'ms-BN', 0x2809 => 'en-BZ',
0x041c => 'sq', 0x0453 => 'km', 0x0843 => 'uz-UZ', 0x280a => 'es-PE',
0x041d => 'sv-SE', 0x0454 => 'lo', 0x0845 => 'bn-BD', 0x2c01 => 'ar-JO',
0x041e => 'th', 0x0456 => 'gl', 0x0850 => 'mn-CN', 0x2c09 => 'en-TT',
0x041f => 'tr', 0x0457 => 'kok', 0x085d => 'iu-CA', 0x2c0a => 'es-AR',
0x0420 => 'ur', 0x045a => 'syr', 0x085f => 'tmh', 0x3001 => 'ar-LB',
0x0421 => 'id', 0x045b => 'si', 0x086b => 'qu-EC', 0x3009 => 'en-ZW',
0x0422 => 'uk', 0x045d => 'iu-CA', 0x0c01 => 'ar-EG', 0x300a => 'es-EC',
0x0423 => 'be', 0x045e => 'am', 0x0c04 => 'zh-HK', 0x3401 => 'ar-KW',
0x0424 => 'sl', 0x0461 => 'ne', 0x0c07 => 'de-AT', 0x3409 => 'en-PH',
0x0425 => 'et', 0x0462 => 'fy', 0x0c09 => 'en-AU', 0x340a => 'es-CL',
0x0426 => 'lv', 0x0463 => 'ps', 0x0c0a => 'es-ES', 0x3801 => 'ar-AE',
0x0427 => 'lt', 0x0464 => 'fil', 0x0c0c => 'fr-CA', 0x380a => 'es-UY',
0x0428 => 'tg', 0x0465 => 'dv', 0x0c1a => 'sr-RS', 0x3c01 => 'ar-BH',
0x042a => 'vi', 0x0468 => 'ha', 0x0c3b => 'se-FI', 0x3c0a => 'es-PY',
0x042b => 'hy', 0x046a => 'yo', 0x0c6b => 'qu-PE', 0x4001 => 'ar-QA',
0x042c => 'az-AZ', 0x046b => 'qu-BO', 0x1001 => 'ar-LY', 0x4009 => 'en-IN',
0x042d => 'eu', 0x046c => 'st', 0x1004 => 'zh-SG', 0x400a => 'es-BO',
0x042e => 'hsb', 0x046d => 'ba', 0x1007 => 'de-LU', 0x4409 => 'en-MY',
0x042f => 'mk', 0x046e => 'lb', 0x1009 => 'en-CA', 0x440a => 'es-SV',
0x0430 => 'st', 0x046f => 'kl', 0x100a => 'es-GT', 0x4809 => 'en-SG',
0x0431 => 'ts', 0x0470 => 'ig', 0x100c => 'fr-CH', 0x480a => 'es-HN',
0x0432 => 'tn', 0x0478 => 'yi', 0x101a => 'hr-BA', 0x4c0a => 'es-NI',
0x0434 => 'xh', 0x047a => 'arn', 0x103b => 'smj-NO',0x500a => 'es-PR',
0x0435 => 'zu', 0x047c => 'moh', 0x1401 => 'ar-DZ', 0x540a => 'es-US',
0x0436 => 'af', 0x047e => 'br', 0x1404 => 'zh-MO',
0x0437 => 'ka', 0x0480 => 'ug', 0x1407 => 'de-LI',
},
Unicode => { },
ISO => { },
Custom => { },
);
# eclectic table of tags for various format font files
%Image::ExifTool::Font::Main = (
GROUPS => { 2 => 'Document' },
NOTES => q{
This table contains a collection of tags found in font files of various
formats. ExifTool current recognizes OTF, TTF, TTC, DFONT, PFA, PFB, PFM,
AFM, ACFM and AMFM font files.
},
name => {
SubDirectory => { TagTable => 'Image::ExifTool::Font::Name' },
},
PFM => {
Name => 'PFMHeader',
SubDirectory => { TagTable => 'Image::ExifTool::Font::PFM' },
},
PSInfo => {
Name => 'PSFontInfo',
SubDirectory => { TagTable => 'Image::ExifTool::Font::PSInfo' },
},
AFM => {
Name => 'AFM',
SubDirectory => { TagTable => 'Image::ExifTool::Font::AFM' },
},
numfonts => 'NumFonts',
fontname => 'FontName',
postfont => {
Name => 'PostScriptFontName',
Description => 'PostScript Font Name',
},
);
# TrueType name tags (ref 1/2)
%Image::ExifTool::Font::Name = (
GROUPS => { 2 => 'Document' },
NOTES => q{
The following tags are extracted from the TrueType font "name" table found
in OTF, TTF, TTC and DFONT files. These tags support localized languages by
adding a hyphen followed by a language code to the end of the tag name (eg.
"Copyright-fr" or "License-en-US"). Tags with no language code use the
default language of "en".
},
0 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
1 => 'FontFamily',
2 => 'FontSubfamily',
3 => 'FontSubfamilyID',
4 => 'FontName', # full name
5 => 'NameTableVersion',
6 => { Name => 'PostScriptFontName', Description => 'PostScript Font Name' },
7 => 'Trademark',
8 => 'Manufacturer',
9 => 'Designer',
10 => 'Description',
11 => 'VendorURL',
12 => 'DesignerURL',
13 => 'License',
14 => 'LicenseInfoURL',
16 => 'PreferredFamily',
17 => 'PreferredSubfamily',
18 => 'CompatibleFontName',
19 => 'SampleText',
20 => {
Name => 'PostScriptFontName',
Description => 'PostScript Font Name',
},
21 => 'WWSFamilyName',
22 => 'WWSSubfamilyName',
);
# PostScript Font Metric file header (ref 4)
%Image::ExifTool::Font::PFM = (
GROUPS => { 2 => 'Document' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
NOTES => 'Tags extracted from the PFM file header.',
0 => {
Name => 'PFMVersion',
Format => 'int16u',
PrintConv => 'sprintf("%x.%.2x",$val>>8,$val&0xff)',
},
6 => { Name => 'Copyright', Format => 'string[60]', Groups => { 2 => 'Author' } },
66 => { Name => 'FontType', Format => 'int16u' },
68 => { Name => 'PointSize', Format => 'int16u' },
70 => { Name => 'YResolution', Format => 'int16u' },
72 => { Name => 'XResolution', Format => 'int16u' },
74 => { Name => 'Ascent', Format => 'int16u' },
76 => { Name => 'InternalLeading', Format => 'int16u' },
78 => { Name => 'ExternalLeading', Format => 'int16u' },
80 => { Name => 'Italic' },
81 => { Name => 'Underline' },
82 => { Name => 'Strikeout' },
83 => { Name => 'Weight', Format => 'int16u' },
85 => { Name => 'CharacterSet' },
86 => { Name => 'PixWidth', Format => 'int16u' },
88 => { Name => 'PixHeight', Format => 'int16u' },
90 => { Name => 'PitchAndFamily' },
91 => { Name => 'AvgWidth', Format => 'int16u' },
93 => { Name => 'MaxWidth', Format => 'int16u' },
95 => { Name => 'FirstChar' },
96 => { Name => 'LastChar' },
97 => { Name => 'DefaultChar' },
98 => { Name => 'BreakChar' },
99 => { Name => 'WidthBytes', Format => 'int16u' },
# 101 => { Name => 'DeviceTypeOffset', Format => 'int32u' },
# 105 => { Name => 'FontNameOffset', Format => 'int32u' },
# 109 => { Name => 'BitsPointer', Format => 'int32u' },
# 113 => { Name => 'BitsOffset', Format => 'int32u' },
);
# PostScript FontInfo attributes (PFA, PFB) (ref PH)
%Image::ExifTool::Font::PSInfo = (
GROUPS => { 2 => 'Document' },
NOTES => 'Tags extracted from PostScript font files (PFA and PFB).',
FullName => { },
FamilyName => { Name => 'FontFamily' },
Weight => { },
ItalicAngle => { },
isFixedPitch=> { },
UnderlinePosition => { },
UnderlineThickness => { },
Copyright => { Groups => { 2 => 'Author' } },
Notice => { Groups => { 2 => 'Author' } },
version => { },
FontName => { },
FontType => { },
FSType => { },
);
# Adobe Font Metrics tags (AFM) (ref 6)
%Image::ExifTool::Font::AFM = (
GROUPS => { 2 => 'Document' },
NOTES => 'Tags extracted from Adobe Font Metrics files (AFM, ACFM and AMFM).',
'Creation Date' => { Name => 'CreateDate', Groups => { 2 => 'Time' } },
FontName => { },
FullName => { },
FamilyName => { Name => 'FontFamily' },
Weight => { },
Version => { },
Notice => { Groups => { 2 => 'Author' } },
EncodingScheme => { },
MappingScheme => { },
EscChar => { },
CharacterSet=> { },
Characters => { },
IsBaseFont => { },
# VVector => { },
IsFixedV => { },
CapHeight => { },
XHeight => { },
Ascender => { },
Descender => { },
);
#------------------------------------------------------------------------------
# Read information from a TrueType font collection (TTC) (refs 2,3)
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid TrueType font collection
sub ProcessTTC($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $i);
return 0 unless $raf->Read($buff, 12) == 12;
return 0 unless $buff =~ /^ttcf\0[\x01\x02]\0\0/;
SetByteOrder('MM');
my $num = Get32u(\$buff, 8);
# might as well put a limit on the number of fonts we will parse (< 256)
return 0 unless $num < 0x100 and $raf->Read($buff, $num * 4) == $num * 4;
$et->SetFileType('TTC');
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
$et->HandleTag($tagTablePtr, 'numfonts', $num);
# loop through all fonts in the collection
for ($i=0; $i<$num; ++$i) {
my $n = $i + 1;
$et->VPrint(0, "Font $n:\n");
$$et{SET_GROUP1} = "+$n";
my $offset = Get32u(\$buff, $i * 4);
$raf->Seek($offset, 0) or last;
ProcessOTF($et, $dirInfo) or last;
}
delete $$et{SET_GROUP1};
return 1;
}
#------------------------------------------------------------------------------
# Read information from a TrueType font file (OTF or TTF) (refs 1,2)
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid TrueType font file
sub ProcessOTF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($tbl, $buff, $pos, $i);
my $base = $$dirInfo{Base} || 0;
return 0 unless $raf->Read($buff, 12) == 12;
return 0 unless $buff =~ /^(\0\x01\0\0|OTTO|true|typ1|\xa5(kbd|lst))[\0\x01]/;
$et->SetFileType($1 eq 'OTTO' ? 'OTF' : 'TTF');
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
SetByteOrder('MM');
my $numTables = Get16u(\$buff, 4);
return 0 unless $numTables > 0 and $numTables < 0x200;
my $len = $numTables * 16;
return 0 unless $raf->Read($tbl, $len) == $len;
my $verbose = $et->Options('Verbose');
my $oldIndent = $$et{INDENT};
$$et{INDENT} .= '| ';
$et->VerboseDir('TrueType', $numTables) if $verbose;
for ($pos=0; $pos<$len; $pos+=16) {
# look for 'name' table
my $tag = substr($tbl, $pos, 4);
next unless $tag eq 'name' or $verbose;
my $offset = Get32u(\$tbl, $pos + 8);
my $size = Get32u(\$tbl, $pos + 12);
unless ($raf->Seek($offset+$base, 0) and $raf->Read($buff, $size) == $size) {
$et->Warn("Error reading '${tag}' data");
next;
}
if ($verbose) {
$tag =~ s/([\0-\x1f\x80-\xff])/sprintf('\x%.2x',ord $1)/ge;
my $str = sprintf("%s%d) Tag '%s' (offset 0x%.4x, %d bytes)\n",
$$et{INDENT}, $pos/16, $tag, $offset, $size);
$et->VPrint(0, $str);
$et->VerboseDump(\$buff, Addr => $offset) if $verbose > 2;
next unless $tag eq 'name';
}
next unless $size >= 8;
my $entries = Get16u(\$buff, 2);
my $recEnd = 6 + $entries * 12;
if ($recEnd > $size) {
$et->Warn('Truncated name record');
last;
}
my $strStart = Get16u(\$buff, 4);
if ($strStart < $recEnd or $strStart > $size) {
$et->Warn('Invalid string offset');
last;
}
# parse language-tag record (in format 1 Naming table only) (ref 2)
my %langTag;
if (Get16u(\$buff, 0) == 1 and $recEnd + 2 <= $size) {
my $langTags = Get16u(\$buff, $recEnd);
if ($langTags and $recEnd + 2 + $langTags * 4 < $size) {
for ($i=0; $i<$langTags; ++$i) {
my $pt = $recEnd + 2 + $i * 4;
my $langLen = Get16u(\$buff, $pt);
# make sure the language string length is reasonable (UTF-16BE)
last if $langLen == 0 or $langLen & 0x01 or $langLen > 40;
my $langPt = Get16u(\$buff, $pt + 2) + $strStart;
last if $langPt + $langLen > $size;
my $lang = substr($buff, $langPt, $langLen);
$lang = $et->Decode($lang,'UCS2','MM','UTF8');
$lang =~ tr/-_a-zA-Z0-9//dc; # remove naughty characters
$langTag{$i + 0x8000} = $lang;
}
}
}
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Name');
$$et{INDENT} .= '| ';
$et->VerboseDir('Name', $entries) if $verbose;
for ($i=0; $i<$entries; ++$i) {
my $pt = 6 + $i * 12;
my $platform = Get16u(\$buff, $pt);
my $encoding = Get16u(\$buff, $pt + 2);
my $langID = Get16u(\$buff, $pt + 4);
my $nameID = Get16u(\$buff, $pt + 6);
my $strLen = Get16u(\$buff, $pt + 8);
my $strPt = Get16u(\$buff, $pt + 10) + $strStart;
if ($strPt + $strLen <= $size) {
my $val = substr($buff, $strPt, $strLen);
my ($lang, $charset, $extra);
my $sys = $ttPlatform{$platform};
# translate from specified encoding
if ($sys) {
$lang = $ttLang{$sys}{$langID} || $langTag{$langID};
$charset = $ttCharset{$sys}{$encoding};
if (not $charset) {
if (not defined $charset and not $$et{FontWarn}) {
$et->Warn("Unknown $sys character set ($encoding)");
$$et{FontWarn} = 1;
}
} else {
# translate to ExifTool character set
$val = $et->Decode($val, $charset);
}
} else {
$et->Warn("Unknown platform ($platform) for name $nameID");
}
# get the tagInfo for our specific language (use 'en' for default)
my $tagInfo = $et->GetTagInfo($tagTablePtr, $nameID);
if ($tagInfo and $lang and $lang ne 'en') {
my $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
$tagInfo = $langInfo if $langInfo;
}
if ($verbose) {
$langID > 0x400 and $langID = sprintf('0x%x', $langID);
$extra = ", Plat=$platform/" . ($sys || 'Unknown') . ', ' .
"Enc=$encoding/" . ($charset || 'Unknown') . ', ' .
"Lang=$langID/" . ($lang || 'Unknown');
}
$et->HandleTag($tagTablePtr, $nameID, $val,
TagInfo => $tagInfo,
DataPt => \$buff,
DataPos => $offset,
Start => $strPt,
Size => $strLen,
Index => $i,
Extra => $extra,
);
}
}
$$et{INDENT} = $oldIndent . '| ';
last unless $verbose;
}
$$et{INDENT} = $oldIndent;
return 1;
}
#------------------------------------------------------------------------------
# Read information from an Adobe Font Metrics file (AFM, ACFM, AMFM) (ref 6)
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a recognized AFM-type file
sub ProcessAFM($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $comment);
require Image::ExifTool::PostScript;
local $/ = Image::ExifTool::PostScript::GetInputRecordSeparator($raf);
$raf->ReadLine($buff);
return 0 unless $buff =~ /^Start(Comp|Master)?FontMetrics\s+\d+/;
my $ftyp = $1 ? ($1 eq 'Comp' ? 'ACFM' : 'AMFM') : 'AFM';
$et->SetFileType($ftyp, 'application/x-font-afm');
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::AFM');
for (;;) {
$raf->ReadLine($buff) or last;
if (defined $comment and $buff !~ /^Comment\s/) {
$et->FoundTag('Comment', $comment);
undef $comment;
}
$buff =~ /^(\w+)\s+(.*?)[\x0d\x0a]/ or next;
my ($tag, $val) = ($1, $2);
if ($tag eq 'Comment' and $val =~ /^(Creation Date):\s+(.*)/) {
($tag, $val) = ($1, $2);
}
$val =~ s/^\((.*)\)$/$1/; # (some values may be in brackets)
if ($tag eq 'Comment') {
# concatinate all comments into a single value
$comment = defined($comment) ? "$comment\n$val" : $val;
next;
}
unless ($et->HandleTag($tagTablePtr, $tag, $val)) {
# end parsing if we start any subsection
last if $tag =~ /^Start/ and $tag ne 'StartDirection';
}
}
return 1;
}
#------------------------------------------------------------------------------
# Read information from various format font files
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a recognized Font file
sub ProcessFont($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $buf2, $rtnVal);
return 0 unless $raf->Read($buff, 24) and $raf->Seek(0,0);
if ($buff =~ /^(\0\x01\0\0|OTTO|true|typ1)[\0\x01]/) { # OTF, TTF
$rtnVal = ProcessOTF($et, $dirInfo);
} elsif ($buff =~ /^ttcf\0[\x01\x02]\0\0/) { # TTC
$rtnVal = ProcessTTC($et, $dirInfo);
} elsif ($buff =~ /^Start(Comp|Master)?FontMetrics\s+\d+/s) { # AFM
$rtnVal = ProcessAFM($et, $dirInfo);
} elsif ($buff =~ /^(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)/s) {# PFA, PFB
$raf->Seek(6,0) and $et->SetFileType('PFB') if $1;
require Image::ExifTool::PostScript;
$rtnVal = Image::ExifTool::PostScript::ProcessPS($et, $dirInfo);
} elsif ($buff =~ /^\0[\x01\x02]/ and $raf->Seek(0, 2) and # PFM
# validate file size
$raf->Tell() > 117 and $raf->Tell() == unpack('x2V',$buff) and
# read PFM header
$raf->Seek(0,0) and $raf->Read($buff,117) == 117 and
# validate "DeviceType" string (must be "PostScript\0")
SetByteOrder('II') and $raf->Seek(Get32u(\$buff, 101), 0) and
# the DeviceType should be "PostScript\0", but FontForge
# incorrectly writes "Postscript\0", so ignore case
$raf->Read($buf2, 11) == 11 and lc($buf2) eq "postscript\0")
{
$et->SetFileType('PFM');
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
SetByteOrder('II');
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
# process the PFM header
$et->HandleTag($tagTablePtr, 'PFM', $buff);
# extract the font names
my $nameOff = Get32u(\$buff, 105);
if ($raf->Seek($nameOff, 0) and $raf->Read($buff, 256) and
$buff =~ /^([\x20-\xff]+)\0([\x20-\xff]+)\0/)
{
$et->HandleTag($tagTablePtr, 'fontname', $1);
$et->HandleTag($tagTablePtr, 'postfont', $2);
}
$rtnVal = 1;
} else {
$rtnVal = 0;
}
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Font - Read meta information from font files
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains the routines required by Image::ExifTool to read meta
information from various format font files. Currently recognized font file
types are OTF, TTF, TTC, DFONT, PFA, PFB, PFM, AFM, ACFM and AMFM.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html>
=item L<http://www.microsoft.com/typography/otspec/otff.htm>
=item L<http://partners.adobe.com/public/developer/opentype/index_font_file.html>
=item L<http://partners.adobe.com/public/developer/en/font/5178.PFM.pdf>
=item L<http://opensource.adobe.com/svn/opensource/flex/sdk/trunk/modules/compiler/src/java/flex2/compiler/util/MimeMappings.java>
=item L<http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/Font Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,261 @@
#------------------------------------------------------------------------------
# File: FotoStation.pm
#
# Description: Read/write FotoWare FotoStation trailer
#
# Revisions: 10/28/2006 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::FotoStation;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.04';
sub ProcessFotoStation($$);
%Image::ExifTool::FotoStation::Main = (
PROCESS_PROC => \&ProcessFotoStation,
WRITE_PROC => \&ProcessFotoStation,
GROUPS => { 2 => 'Image' },
NOTES => q{
The following tables define information found in the FotoWare FotoStation
trailer.
},
0x01 => {
Name => 'IPTC',
SubDirectory => {
TagTable => 'Image::ExifTool::IPTC::Main',
},
},
0x02 => {
Name => 'SoftEdit',
SubDirectory => {
TagTable => 'Image::ExifTool::FotoStation::SoftEdit',
},
},
0x03 => {
Name => 'ThumbnailImage',
Groups => { 2 => 'Preview' },
Writable => 1,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
0x04 => {
Name => 'PreviewImage',
Groups => { 2 => 'Preview' },
Writable => 1,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
);
# crop coordinate conversions
my %cropConv = (
ValueConv => '$val / 1000',
ValueConvInv => '$val * 1000',
PrintConv => '"$val%"',
PrintConvInv => '$val=~tr/ %//d; $val',
);
# soft crop record
%Image::ExifTool::FotoStation::SoftEdit = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'int32s',
FIRST_ENTRY => 0,
GROUPS => { 2 => 'Image' },
0 => {
Name => 'OriginalImageWidth',
},
1 => 'OriginalImageHeight',
2 => 'ColorPlanes',
3 => {
Name => 'XYResolution',
ValueConv => '$val / 1000',
ValueConvInv => '$val * 1000',
},
4 => {
Name => 'Rotation',
Notes => q{
rotations are stored as degrees CCW * 100, but converted to degrees CW by
ExifTool
},
# raw value is 0, 9000, 18000 or 27000
ValueConv => '$val ? 360 - $val / 100 : 0',
ValueConvInv => '$val ? (360 - $val) * 100 : 0',
},
# 5 Validity Check (0x11222211)
6 => {
Name => 'CropLeft',
%cropConv,
},
7 => {
Name => 'CropTop',
%cropConv,
},
8 => {
Name => 'CropRight',
%cropConv,
},
9 => {
Name => 'CropBottom',
%cropConv,
},
11 => {
Name => 'CropRotation',
# raw value in the range -4500 to 4500
ValueConv => '-$val / 100',
ValueConvInv => '-$val * 100',
},
);
#------------------------------------------------------------------------------
# Read/write FotoStation information in a file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this file didn't contain FotoStation information
# - updates DataPos to point to start of FotoStation information
# - updates DirLen to trailer length
sub ProcessFotoStation($$)
{
my ($et, $dirInfo) = @_;
$et or return 1; # allow dummy access to autoload this package
my ($buff, $footer, $dirBuff, $tagTablePtr);
my $raf = $$dirInfo{RAF};
my $outfile = $$dirInfo{OutFile};
my $offset = $$dirInfo{Offset} || 0;
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
my $rtnVal = 0;
$$dirInfo{DirLen} = 0; # initialize returned trailer length
$raf->Seek(-$offset, 2); # seek to specified offset from end of file
# loop through FotoStation records
for (;;) {
# look for trailer signature
last unless $raf->Seek(-10, 1) and $raf->Read($footer, 10) == 10;
my ($tag, $size, $sig) = unpack('nNN', $footer);
last unless $sig == 0xa1b2c3d4 and $size >= 10 and $raf->Seek(-$size, 1);
$size -= 10; # size of data only
last unless $raf->Read($buff, $size) == $size;
$raf->Seek(-$size, 1);
# set variables returned in dirInfo hash
$$dirInfo{DataPos} = $raf->Tell();
$$dirInfo{DirLen} += $size + 10;
unless ($tagTablePtr) {
$tagTablePtr = GetTagTable('Image::ExifTool::FotoStation::Main');
SetByteOrder('MM'); # necessary for the binary data
$rtnVal = 1; # we found a valid FotoStation trailer
}
unless ($outfile) {
# print verbose trailer information
if ($verbose or $$et{HTML_DUMP}) {
$et->DumpTrailer({
RAF => $raf,
DataPos => $$dirInfo{DataPos},
DirLen => $size + 10,
DirName => "FotoStation_$tag",
});
}
# extract information for this tag
$et->HandleTag($tagTablePtr, $tag, $buff,
DataPt => \$buff,
Start => 0,
Size => $size,
DataPos => $$dirInfo{DataPos},
);
next;
}
if ($$et{DEL_GROUP}{FotoStation}) {
$verbose and print $out " Deleting FotoStation trailer\n";
$verbose = 0; # no more verbose messages after this
++$$et{CHANGED};
next;
}
# rewrite this information
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
if ($tagInfo) {
my $newVal;
my $tagName = $$tagInfo{Name};
if ($$tagInfo{SubDirectory}) {
my %subdirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => $size,
DataPos => $$dirInfo{DataPos},
DirName => $tagName,
Parent => 'FotoStation',
);
my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
$newVal = $et->WriteDirectory(\%subdirInfo, $subTable);
} else {
my $nvHash = $et->GetNewValueHash($tagInfo);
if ($et->IsOverwriting($nvHash) > 0) {
$newVal = $et->GetNewValue($nvHash);
$newVal = '' unless defined $newVal;
if ($verbose > 1) {
my $n = length $newVal;
print $out " - FotoStation:$tagName ($size bytes)\n" if $size;
print $out " + FotoStation:$tagName ($n bytes)\n" if $n;
}
++$$et{CHANGED};
}
}
if (defined $newVal) {
# note: length may be 0 here, but we write the empty record anyway
$buff = $newVal;
$size = length($newVal) + 10;
$footer = pack('nNN', $tag, $size, $sig);
}
}
if (defined $dirBuff) {
# maintain original record order
$dirBuff = $buff . $footer . $dirBuff;
} else {
$dirBuff = $buff . $footer;
}
}
# write the modified FotoStation trailer
Write($outfile, $dirBuff) or $rtnVal = -1 if $dirBuff;
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::FotoStation - Read/write FotoWare FotoStation trailer
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read and
write information from the FotoWare FotoStation trailer.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 ACKNOWLEDGEMENTS
Thanks to Mark Tate for information about the FotoStation data format.
=head1 SEE ALSO
L<Image::ExifTool::TagNames/FotoStation Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,81 @@
#------------------------------------------------------------------------------
# File: GE.pm
#
# Description: General Imaging maker notes tags
#
# Revisions: 2010-12-14 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::GE;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::Exif;
$VERSION = '1.00';
sub ProcessGE2($$$);
# GE type 1 maker notes (ref PH)
# (similar to Kodak::Type11 and Ricoh::Type2)
%Image::ExifTool::GE::Main = (
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
WRITABLE => 1,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => q{
This table lists tags found in the maker notes of some General Imaging
camera models.
},
# 0x0104 - int32u
# 0x0200 - int32u[3] (with invalid offset of 0)
0x0202 => {
Name => 'Macro',
Writable => 'int16u',
PrintConv => { 0 => 'Off', 1 => 'On' },
},
# 0x0203 - int16u: 0
# 0x0204 - rational64u: 10/10
# 0x0205 - rational64u: 7.249,7.34,9.47 (changes with camera model)
# 0x0206 - int16u[6] (with invalid offset of 0)
0x0207 => {
Name => 'GEModel',
Format => 'string',
},
0x0300 => {
Name => 'GEMake',
Format => 'string',
},
# 0x0500 - int16u: 0
# 0x0600 - int32u: 0
);
__END__
=head1 NAME
Image::ExifTool::GE - General Imaging maker notes tags
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
General Imaging maker notes.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/GE Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,560 @@
#------------------------------------------------------------------------------
# File: GIF.pm
#
# Description: Read and write GIF meta information
#
# Revisions: 10/18/2005 - P. Harvey Separated from ExifTool.pm
# 05/23/2008 - P. Harvey Added ability to read/write XMP
# 10/28/2011 - P. Harvey Added ability to read/write ICC_Profile
#
# References: 1) http://www.w3.org/Graphics/GIF/spec-gif89a.txt
# 2) http://www.adobe.com/devnet/xmp/
# 3) http://graphcomp.com/info/specs/ani_gif.html
# 4) http://www.color.org/icc_specs2.html
# 5) http://www.midiox.com/mmgif.htm
#------------------------------------------------------------------------------
package Image::ExifTool::GIF;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.15';
# road map of directory locations in GIF images
my %gifMap = (
XMP => 'GIF',
ICC_Profile => 'GIF',
);
%Image::ExifTool::GIF::Main = (
GROUPS => { 2 => 'Image' },
VARS => { NO_ID => 1 },
NOTES => q{
This table lists information extracted from GIF images. See
L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt> for the official GIF89a
specification.
},
GIFVersion => { },
FrameCount => { Notes => 'number of animated images' },
Text => { Notes => 'text displayed in image' },
Comment => {
# for documentation only -- flag as writable for the docs, but
# it won't appear in the TagLookup because there is no WRITE_PROC
Writable => 1,
},
Duration => {
Notes => 'duration of a single animation iteration',
PrintConv => 'sprintf("%.2f s",$val)',
},
ScreenDescriptor => {
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Screen' },
},
Extensions => { # (for documentation only)
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Extensions' },
},
);
# GIF89a application extensions:
%Image::ExifTool::GIF::Extensions = (
GROUPS => { 2 => 'Image' },
NOTES => 'Tags extracted from GIF89a application extensions.',
'NETSCAPE/2.0' => { #3
Name => 'Animation',
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Animation' },
},
'XMP Data/XMP' => { #2
Name => 'XMP',
IncludeLengthBytes => 1, # length bytes are included in the data
Writable => 1,
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
},
'ICCRGBG1/012' => { #4
Name => 'ICC_Profile',
Writable => 1,
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
},
'MIDICTRL/Jon' => { #5
Name => 'MIDIControl',
SubDirectory => { TagTable => 'Image::ExifTool::GIF::MIDIControl' },
},
'MIDISONG/Dm7' => { #5
Name => 'MIDISong',
Groups => { 2 => 'Audio' },
Binary => 1,
},
);
# GIF locical screen descriptor
%Image::ExifTool::GIF::Screen = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
NOTES => 'Information extracted from the GIF logical screen descriptor.',
0 => {
Name => 'ImageWidth',
Format => 'int16u',
},
2 => {
Name => 'ImageHeight',
Format => 'int16u',
},
4.1 => {
Name => 'HasColorMap',
Mask => 0x80,
PrintConv => { 0x00 => 'No', 0x80 => 'Yes' },
},
4.2 => {
Name => 'ColorResolutionDepth',
Mask => 0x70,
ValueConv => '($val >> 4) + 1',
},
4.3 => {
Name => 'BitsPerPixel',
Mask => 0x07,
ValueConv => '$val + 1',
},
5 => 'BackgroundColor',
);
# GIF Netscape 2.0 animation extension (ref 3)
%Image::ExifTool::GIF::Animation = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
NOTES => 'Information extracted from the "NETSCAPE2.0" animation extension.',
1 => {
Name => 'AnimationIterations',
Format => 'int16u',
PrintConv => '$val ? $val : "Infinite"',
},
);
# GIF MIDICTRL extension (ref 5)
%Image::ExifTool::GIF::MIDIControl = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Audio' },
NOTES => 'Information extracted from the MIDI control block extension.',
0 => 'MIDIControlVersion',
1 => 'SequenceNumber',
2 => 'MelodicPolyphony',
3 => 'PercussivePolyphony',
4 => {
Name => 'ChannelUsage',
Format => 'int16u',
PrintConv => 'sprintf("0x%.4x", $val)',
},
6 => {
Name => 'DelayTime',
Format => 'int16u',
ValueConv => '$val / 100',
PrintConv => '$val . " s"',
},
);
#------------------------------------------------------------------------------
# Process meta information in GIF image
# Inputs: 0) ExifTool object reference, 1) Directory information ref
# Returns: 1 on success, 0 if this wasn't a valid GIF file, or -1 if
# an output file was specified and a write error occurred
sub ProcessGIF($$)
{
my ($et, $dirInfo) = @_;
my $outfile = $$dirInfo{OutFile};
my $raf = $$dirInfo{RAF};
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
my ($a, $s, $ch, $length, $buff);
my ($err, $newComment, $setComment, $nvComment);
my ($addDirs, %doneDir);
my ($frameCount, $delayTime) = (0, 0);
# verify this is a valid GIF file
return 0 unless $raf->Read($buff, 6) == 6
and $buff =~ /^GIF(8[79]a)$/
and $raf->Read($s, 7) == 7;
my $ver = $1;
my $rtnVal = 0;
my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main');
SetByteOrder('II');
if ($outfile) {
$et->InitWriteDirs(\%gifMap, 'XMP'); # make XMP the preferred group for GIF
$addDirs = $$et{ADD_DIRS};
# determine if we are editing the File:Comment tag
my $delGroup = $$et{DEL_GROUP};
$newComment = $et->GetNewValue('Comment', \$nvComment);
$setComment = 1 if $nvComment or $$delGroup{File};
# change to GIF 89a if adding comment, XMP or ICC_Profile
$buff = 'GIF89a' if $$addDirs{XMP} or $$addDirs{ICC_Profile} or defined $newComment;
Write($outfile, $buff, $s) or $err = 1;
} else {
$et->SetFileType(); # set file type
$et->HandleTag($tagTablePtr, 'GIFVersion', $ver);
$et->HandleTag($tagTablePtr, 'ScreenDescriptor', $s);
}
my $flags = Get8u(\$s, 4);
if ($flags & 0x80) { # does this image contain a color table?
# calculate color table size
$length = 3 * (2 << ($flags & 0x07));
$raf->Read($buff, $length) == $length or return 0; # skip color table
Write($outfile, $buff) or $err = 1 if $outfile;
}
#
# loop through GIF blocks
#
Block:
for (;;) {
last unless $raf->Read($ch, 1);
# write out any new metadata now if this isn't an extension block
if ($outfile and ord($ch) != 0x21) {
# write the comment first if necessary
if (defined $newComment and $$nvComment{IsCreating}) {
# write comment marker
Write($outfile, "\x21\xfe") or $err = 1;
$verbose and print $out " + Comment = $newComment\n";
my $len = length($newComment);
# write out the comment in 255-byte chunks, each
# chunk beginning with a length byte
my $n;
for ($n=0; $n<$len; $n+=255) {
my $size = $len - $n;
$size > 255 and $size = 255;
my $str = substr($newComment,$n,$size);
Write($outfile, pack('C',$size), $str) or $err = 1;
}
Write($outfile, "\0") or $err = 1; # empty chunk as terminator
undef $newComment;
undef $nvComment; # delete any other extraneous comments
++$$et{CHANGED}; # increment file changed flag
}
# add application extension containing XMP block if necessary
# (this will place XMP before the first non-extension block)
if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) {
$doneDir{XMP} = 1;
# write new XMP data
my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main');
my %dirInfo = ( Parent => 'GIF' );
$verbose and print $out "Creating XMP application extension block:\n";
$buff = $et->WriteDirectory(\%dirInfo, $xmpTable);
if (defined $buff and length $buff) {
my $lz = pack('C*',1,reverse(0..255),0);
Write($outfile, "\x21\xff\x0bXMP DataXMP", $buff, $lz) or $err = 1;
++$doneDir{XMP}; # set to 2 to indicate we added XMP
} else {
$verbose and print $out " -> no XMP to add\n";
}
}
# add application extension containing ICC_Profile if necessary
if (exists $$addDirs{ICC_Profile} and not defined $doneDir{ICC_Profile}) {
$doneDir{ICC_Profile} = 1;
# write new ICC_Profile
my $iccTable = GetTagTable('Image::ExifTool::ICC_Profile::Main');
my %dirInfo = ( Parent => 'GIF' );
$verbose and print $out "Creating ICC_Profile application extension block:\n";
$buff = $et->WriteDirectory(\%dirInfo, $iccTable);
if (defined $buff and length $buff) {
my $pos = 0;
Write($outfile, "\x21\xff\x0bICCRGBG1012") or $err = 1;
my $len = length $buff;
while ($pos < $len) {
my $n = $len - $pos;
$n = 255 if $n > 255;
Write($outfile, chr($n), substr($buff, $pos, $n)) or $err = 1;
$pos += $n;
}
Write($outfile, "\0") or $err = 1; # write null terminator
++$doneDir{ICC_Profile}; # set to 2 to indicate we added a new profile
} else {
$verbose and print $out " -> no ICC_Profile to add\n";
}
}
}
if (ord($ch) == 0x2c) {
++$frameCount;
Write($outfile, $ch) or $err = 1 if $outfile;
# image descriptor
last unless $raf->Read($buff, 8) == 8 and $raf->Read($ch, 1);
Write($outfile, $buff, $ch) or $err = 1 if $outfile;
if ($verbose) {
my ($left, $top, $w, $h) = unpack('v*', $buff);
print $out "Image: left=$left top=$top width=$w height=$h\n";
}
if (ord($ch) & 0x80) { # does color table exist?
$length = 3 * (2 << (ord($ch) & 0x07));
# skip the color table
last unless $raf->Read($buff, $length) == $length;
Write($outfile, $buff) or $err = 1 if $outfile;
}
# skip "LZW Minimum Code Size" byte
last unless $raf->Read($buff, 1);
Write($outfile,$buff) or $err = 1 if $outfile;
# skip image blocks
for (;;) {
last unless $raf->Read($ch, 1);
Write($outfile, $ch) or $err = 1 if $outfile;
last unless ord($ch);
last unless $raf->Read($buff, ord($ch));
Write($outfile,$buff) or $err = 1 if $outfile;
}
next; # continue with next field
}
# last if ord($ch) == 0x3b; # normal end of GIF marker
unless (ord($ch) == 0x21) {
if ($outfile) {
Write($outfile, $ch) or $err = 1;
# copy the rest of the file
while ($raf->Read($buff, 65536)) {
Write($outfile, $buff) or $err = 1;
}
}
$rtnVal = 1;
last;
}
# get extension block type/size
last unless $raf->Read($s, 2) == 2;
# get marker and block size
($a,$length) = unpack("C"x2, $s);
if ($a == 0xfe) { # comment extension
my $comment = '';
while ($length) {
last unless $raf->Read($buff, $length) == $length;
$et->VerboseDump(\$buff) unless $outfile;
# add buffer to comment string
$comment .= $buff;
last unless $raf->Read($ch, 1); # read next block header
$length = ord($ch); # get next block size
}
last if $length; # was a read error if length isn't zero
if ($outfile) {
my $isOverwriting;
if ($setComment) {
if ($nvComment) {
$isOverwriting = $et->IsOverwriting($nvComment,$comment);
# get new comment again (may have been shifted)
$newComment = $et->GetNewValue($nvComment) if defined $newComment;
} else {
# group delete, or deleting additional comments after writing one
$isOverwriting = 1;
}
}
if ($isOverwriting) {
++$$et{CHANGED}; # increment file changed flag
$et->VerboseValue('- Comment', $comment);
$comment = $newComment;
$et->VerboseValue('+ Comment', $comment) if defined $comment;
undef $nvComment; # just delete remaining comments
} else {
undef $setComment; # leave remaining comments alone
}
if (defined $comment) {
# write comment marker
Write($outfile, "\x21\xfe") or $err = 1;
my $len = length($comment);
# write out the comment in 255-byte chunks, each
# chunk beginning with a length byte
my $n;
for ($n=0; $n<$len; $n+=255) {
my $size = $len - $n;
$size > 255 and $size = 255;
my $str = substr($comment,$n,$size);
Write($outfile, pack('C',$size), $str) or $err = 1;
}
Write($outfile, "\0") or $err = 1; # empty chunk as terminator
}
undef $newComment; # don't write the new comment again
} else {
$rtnVal = 1;
$et->FoundTag('Comment', $comment) if $comment;
undef $comment;
# assume no more than one comment in FastScan mode
last if $et->Options('FastScan');
}
next;
} elsif ($a == 0xff and $length == 0x0b) { # application extension
last unless $raf->Read($buff, $length) == $length;
my $hdr = "$ch$s$buff";
# add "/" for readability
my $tag = substr($buff, 0, 8) . '/' . substr($buff, 8);
$tag =~ tr/\0-\x1f//d; # remove nulls and control characters
$verbose and print $out "Application Extension: $tag\n";
my $extTable = GetTagTable('Image::ExifTool::GIF::Extensions');
my $extInfo = $$extTable{$tag};
my ($subdir, $inclLen, $justCopy);
if ($extInfo) {
$subdir = $$extInfo{SubDirectory};
$inclLen = $$extInfo{IncludeLengthBytes};
# rewrite as-is unless this is a writable subdirectory
$justCopy = 1 if $outfile and (not $subdir or not $$extInfo{Writable});
} else {
$justCopy = 1 if $outfile;
}
Write($outfile, $hdr) or $err = 1 if $justCopy;
# read the extension data
my $dat = '';
for (;;) {
$raf->Read($ch, 1) or last Block; # read next block header
$length = ord($ch) or last; # get next block size
$raf->Read($buff, $length) == $length or last Block;
Write($outfile, $ch, $buff) or $err = 1 if $justCopy;
$dat .= $inclLen ? $ch . $buff : $buff;
}
Write($outfile, "\0") if $justCopy;
if ($subdir) {
my $dirLen = length $dat;
my $name = $$extInfo{Name};
if ($name eq 'XMP') {
# get length of XMP without landing zone data
# (note that LZ data may not be exactly the same as what we use)
$dirLen = pos($dat) if $dat =~ /<\?xpacket end=['"][wr]['"]\?>/g;
}
my %dirInfo = (
DataPt => \$dat,
DataLen => length $dat,
DirLen => $dirLen,
DirName => $name,
Parent => 'GIF',
);
my $subTable = GetTagTable($$subdir{TagTable});
if (not $outfile) {
$et->ProcessDirectory(\%dirInfo, $subTable);
} elsif ($$extInfo{Writable}) {
if ($doneDir{$name} and $doneDir{$name} > 1) {
$et->Warn("Duplicate $name block created");
}
$buff = $et->WriteDirectory(\%dirInfo, $subTable);
if (defined $buff) {
next unless length $buff; # delete this extension if length is zero
# check for null just to be safe
$et->Error("$name contained NULL character") if $buff =~ /\0/;
$dat = $buff;
# add landing zone (without terminator, which will be added later)
$dat .= pack('C*',1,reverse(0..255)) if $$extInfo{IncludeLengthBytes};
} # (else rewrite original data)
$doneDir{$name} = 1;
if ($$extInfo{IncludeLengthBytes}) {
# write data and landing zone
Write($outfile, $hdr, $dat) or $err = 1;
} else {
# write as sub-blocks
Write($outfile, $hdr) or $err = 1;
my $pos = 0;
my $len = length $dat;
while ($pos < $len) {
my $n = $len - $pos;
$n = 255 if $n > 255;
Write($outfile, chr($n), substr($dat, $pos, $n)) or $err = 1;
$pos += $n;
}
}
Write($outfile, "\0") or $err = 1; # write null terminator
}
} elsif (not $outfile) {
$et->HandleTag($extTable, $tag, $dat);
}
next;
} elsif ($a == 0xf9 and $length == 4) { # graphic control extension
last unless $raf->Read($buff, $length) == $length;
# sum the indivual delay times
my $delay = Get16u(\$buff, 1);
$delayTime += $delay;
$verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100;
$raf->Seek(-$length, 1) or last;
} elsif ($a == 0x01 and $length == 12) { # plain text extension
last unless $raf->Read($buff, $length) == $length;
Write($outfile, $ch, $s, $buff) or $err = 1 if $outfile;
if ($verbose) {
my ($left, $top, $w, $h) = unpack('v4', $buff);
print $out "Text: left=$left top=$top width=$w height=$h\n";
}
my $text = '';
for (;;) {
last unless $raf->Read($ch, 1);
$length = ord($ch) or last;
last unless $raf->Read($buff, $length) == $length;
Write($outfile, $ch, $buff) or $err = 1 if $outfile; # write block
$text .= $buff;
}
Write($outfile, "\0") or $err = 1 if $outfile; # write terminator block
$et->HandleTag($tagTablePtr, 'Text', $text);
next;
}
Write($outfile, $ch, $s) or $err = 1 if $outfile;
# skip the block
while ($length) {
last unless $raf->Read($buff, $length) == $length;
Write($outfile, $buff) or $err = 1 if $outfile;
last unless $raf->Read($ch, 1); # read next block header
Write($outfile, $ch) or $err = 1 if $outfile;
$length = ord($ch); # get next block size
}
}
unless ($outfile) {
$et->HandleTag($tagTablePtr, 'FrameCount', $frameCount) if $frameCount > 1;
$et->HandleTag($tagTablePtr, 'Duration', $delayTime/100) if $delayTime;
}
# set return value to -1 if we only had a write error
$rtnVal = -1 if $rtnVal and $err;
return $rtnVal;
}
1; #end
__END__
=head1 NAME
Image::ExifTool::GIF - Read and write GIF meta information
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read and
write GIF meta information.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt>
=item L<http://www.adobe.com/devnet/xmp/>
=item L<http://graphcomp.com/info/specs/ani_gif.html>
=item L<http://www.color.org/icc_specs2.html>
=item L<http://www.midiox.com/mmgif.htm>
=back
=head1 SEE ALSO
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,258 @@
#------------------------------------------------------------------------------
# File: GIMP.pm
#
# Description: Read meta information from GIMP XCF images
#
# Revisions: 2010/10/05 - P. Harvey Created
#
# References: 1) GIMP source code
# 2) http://svn.gnome.org/viewvc/gimp/trunk/devel-docs/xcf.txt?view=markup
#------------------------------------------------------------------------------
package Image::ExifTool::GIMP;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.02';
sub ProcessParasites($$$);
# GIMP XCF properties (ref 2)
%Image::ExifTool::GIMP::Main = (
GROUPS => { 2 => 'Image' },
VARS => { ALPHA_FIRST => 1 },
NOTES => q{
The GNU Image Manipulation Program (GIMP) writes these tags in its native
XCF (eXperimental Computing Facilty) images.
},
header => { SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Header' } },
17 => {
Name => 'Compression',
Format => 'int8u',
PrintConv => {
0 => 'None',
1 => 'RLE Encoding',
2 => 'Zlib',
3 => 'Fractal',
},
},
19 => {
Name => 'Resolution',
SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Resolution' },
},
21 => {
Name => 'Parasites',
SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Parasite' },
},
);
# information extracted from the XCF file header (ref 2)
%Image::ExifTool::GIMP::Header = (
GROUPS => { 2 => 'Image' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
9 => {
Name => 'XCFVersion',
Format => 'string[5]',
PrintConv => {
'file' => '0',
'v001' => '1',
'v002' => '2',
},
},
14 => { Name => 'ImageWidth', Format => 'int32u' },
18 => { Name => 'ImageHeight', Format => 'int32u' },
22 => {
Name => 'ColorMode',
Format => 'int32u',
PrintConv => {
0 => 'RGB Color',
1 => 'Grayscale',
2 => 'Indexed Color',
},
},
);
# XCF resolution data (property type 19) (ref 2)
%Image::ExifTool::GIMP::Resolution = (
GROUPS => { 2 => 'Image' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
FORMAT => 'float',
0 => 'XResolution',
1 => 'YResolution',
);
# XCF "Parasite" data (property type 21) (ref 1/PH)
%Image::ExifTool::GIMP::Parasite = (
GROUPS => { 2 => 'Image' },
PROCESS_PROC => \&ProcessParasites,
'gimp-comment' => {
Name => 'Comment',
Format => 'string',
},
'exif-data' => {
Name => 'ExifData',
SubDirectory => {
TagTable => 'Image::ExifTool::Exif::Main',
ProcessProc => \&Image::ExifTool::ProcessTIFF,
Start => 6, # starts after "Exif\0\0" header
},
},
'jpeg-exif-data' => { # (deprecated, untested)
Name => 'JPEGExifData',
SubDirectory => {
TagTable => 'Image::ExifTool::Exif::Main',
ProcessProc => \&Image::ExifTool::ProcessTIFF,
Start => 6,
},
},
'iptc-data' => { # (untested)
Name => 'IPTCData',
SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main' },
},
'icc-profile' => {
Name => 'ICC_Profile',
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
},
'icc-profile-name' => {
Name => 'ICCProfileName',
Format => 'string',
},
'gimp-metadata' => {
Name => 'XMP',
SubDirectory => {
TagTable => 'Image::ExifTool::XMP::Main',
Start => 10, # starts after "GIMP_XMP_1" header
},
},
);
#------------------------------------------------------------------------------
# Read information in a GIMP XCF parasite data (ref PH)
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessParasites($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $unknown = $et->Options('Unknown') || $et->Options('Verbose');
my $dataPt = $$dirInfo{DataPt};
my $pos = $$dirInfo{DirStart} || 0;
my $end = length $$dataPt;
$et->VerboseDir('Parasites', undef, $end);
for (;;) {
last if $pos + 4 > $end;
my $size = Get32u($dataPt, $pos); # length of tag string
$pos += 4;
last if $pos + $size + 8 > $end;
my $tag = substr($$dataPt, $pos, $size);
$pos += $size;
$tag =~ s/\0.*//s; # trim at null terminator
# my $flags = Get32u($dataPt, $pos); (ignore flags)
$size = Get32u($dataPt, $pos + 4); # length of data
$pos += 8;
last if $pos + $size > $end;
if (not $$tagTablePtr{$tag} and $unknown) {
my $name = $tag;
$name =~ tr/-_A-Za-z0-9//dc;
$name =~ s/^gimp-//;
next unless length $name;
$name = ucfirst $name;
$name =~ s/([a-z])-([a-z])/$1\u$2/g;
$name = "GIMP-$name" unless length($name) > 1;
AddTagToTable($tagTablePtr, $tag, { Name => $name, Unknown => 1 });
}
$et->HandleTag($tagTablePtr, $tag, undef,
DataPt => $dataPt,
Start => $pos,
Size => $size,
);
$pos += $size;
}
return 1;
}
#------------------------------------------------------------------------------
# Read information in a GIMP XCF document
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid XCF file
sub ProcessXCF($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $buff;
return 0 unless $raf->Read($buff, 26) == 26;
return 0 unless $buff =~ /^gimp xcf /;
my $tagTablePtr = GetTagTable('Image::ExifTool::GIMP::Main');
my $verbose = $et->Options('Verbose');
$et->SetFileType();
SetByteOrder('MM');
# process the XCF header
$et->HandleTag($tagTablePtr, 'header', $buff);
# loop through image properties
for (;;) {
$raf->Read($buff, 8) == 8 or last;
my $tag = Get32u(\$buff, 0) or last;
my $size = Get32u(\$buff, 4);
$verbose and $et->VPrint(0, "XCF property $tag ($size bytes):\n");
unless ($$tagTablePtr{$tag}) {
$raf->Seek($size, 1);
next;
}
$raf->Read($buff, $size) == $size or last;
$et->HandleTag($tagTablePtr, $tag, undef,
DataPt => \$buff,
DataPos => $raf->Tell() - $size,
Size => $size,
);
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::GIMP - Read meta information from GIMP XCF images
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read meta
information from GIMP (GNU Image Manipulation Program) XCF (eXperimental
Computing Facility) images. This is the native image format used by the
GIMP software.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<GIMP source code>
=item L<http://svn.gnome.org/viewvc/gimp/trunk/devel-docs/xcf.txt?view=markup>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/GIMP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,578 @@
#------------------------------------------------------------------------------
# File: GPS.pm
#
# Description: EXIF GPS meta information tags
#
# Revisions: 12/09/2003 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::GPS;
use strict;
use vars qw($VERSION);
use Image::ExifTool::Exif;
$VERSION = '1.49';
my %coordConv = (
ValueConv => 'Image::ExifTool::GPS::ToDegrees($val)',
ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val)',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1)',
PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val)',
);
%Image::ExifTool::GPS::Main = (
GROUPS => { 0 => 'EXIF', 1 => 'GPS', 2 => 'Location' },
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
WRITABLE => 1,
WRITE_GROUP => 'GPS',
0x0000 => {
Name => 'GPSVersionID',
Writable => 'int8u',
Mandatory => 1,
Count => 4,
PrintConv => '$val =~ tr/ /./; $val',
PrintConvInv => '$val =~ tr/./ /; $val',
},
0x0001 => {
Name => 'GPSLatitudeRef',
Writable => 'string',
Notes => q{
tags 0x0001-0x0006 used for camera location according to MWG 2.0. ExifTool
will also accept a number when writing GPSLatitudeRef, positive for north
latitudes or negative for south, or a string ending in N or S
},
Count => 2,
PrintConv => {
# extract N/S if written from Composite:GPSLatitude
# (also allow writing from a signed number)
OTHER => sub {
my ($val, $inv) = @_;
return undef unless $inv;
return uc $1 if $val =~ /\b([NS])$/i;
return $1 eq '-' ? 'S' : 'N' if $val =~ /^([-+]?)\d+(\.\d*)?$/;
return undef;
},
N => 'North',
S => 'South',
},
},
0x0002 => {
Name => 'GPSLatitude',
Writable => 'rational64u',
Count => 3,
%coordConv,
},
0x0003 => {
Name => 'GPSLongitudeRef',
Writable => 'string',
Count => 2,
Notes => q{
ExifTool will also accept a number when writing this tag, positive for east
longitudes or negative for west, or a string ending in E or W
},
PrintConv => {
# extract E/W if written from Composite:GPSLongitude
# (also allow writing from a signed number)
OTHER => sub {
my ($val, $inv) = @_;
return undef unless $inv;
return uc $1 if $val =~ /\b([EW])$/i;
return $1 eq '-' ? 'W' : 'E' if $val =~ /^([-+]?)\d+(\.\d*)?$/;
return undef;
},
E => 'East',
W => 'West',
},
},
0x0004 => {
Name => 'GPSLongitude',
Writable => 'rational64u',
Count => 3,
%coordConv,
},
0x0005 => {
Name => 'GPSAltitudeRef',
Writable => 'int8u',
Notes => q{
ExifTool will also accept a signed number when writing this tag, beginning
with "+" for above sea level, or "-" for below
},
PrintConv => {
OTHER => sub {
my ($val, $inv) = @_;
return undef unless $inv and $val =~ /^([-+])/;
return($1 eq '-' ? 1 : 0);
},
0 => 'Above Sea Level',
1 => 'Below Sea Level',
},
},
0x0006 => {
Name => 'GPSAltitude',
Writable => 'rational64u',
# extricate unsigned decimal number from string
ValueConvInv => '$val=~/((?=\d|\.\d)\d*(?:\.\d*)?)/ ? $1 : undef',
PrintConv => '$val =~ /^(inf|undef)$/ ? $val : "$val m"',
PrintConvInv => '$val=~s/\s*m$//;$val',
},
0x0007 => {
Name => 'GPSTimeStamp',
Groups => { 2 => 'Time' },
Writable => 'rational64u',
Count => 3,
Shift => 'Time',
Notes => q{
UTC time of GPS fix. When writing, date is stripped off if present, and
time is adjusted to UTC if it includes a timezone
},
ValueConv => 'Image::ExifTool::GPS::ConvertTimeStamp($val)',
ValueConvInv => '$val=~tr/:/ /;$val',
PrintConv => 'Image::ExifTool::GPS::PrintTimeStamp($val)',
# pull time out of any format date/time string
# (converting to UTC if a timezone is given)
PrintConvInv => sub {
my ($v, $et) = @_;
$v = $et->TimeNow() if lc($v) eq 'now';
my @tz;
if ($v =~ s/([-+])(.*)//s) { # remove timezone
my $s = $1 eq '-' ? 1 : -1; # opposite sign to convert back to UTC
my $t = $2;
@tz = ($s*$1, $s*$2) if $t =~ /^(\d{2}):?(\d{2})\s*$/;
}
my @a = ($v =~ /((?=\d|\.\d)\d*(?:\.\d*)?)/g);
push @a, '00' while @a < 3;
if (@tz) {
# adjust to UTC
$a[-2] += $tz[1];
$a[-3] += $tz[0];
while ($a[-2] >= 60) { $a[-2] -= 60; ++$a[-3] }
while ($a[-2] < 0) { $a[-2] += 60; --$a[-3] }
$a[-3] = ($a[-3] + 24) % 24;
}
return "$a[-3]:$a[-2]:$a[-1]";
},
},
0x0008 => {
Name => 'GPSSatellites',
Writable => 'string',
},
0x0009 => {
Name => 'GPSStatus',
Writable => 'string',
Count => 2,
PrintConv => {
A => 'Measurement Active', # Exif2.2 "Measurement in progress"
V => 'Measurement Void', # Exif2.2 "Measurement Interoperability" (WTF?)
# (meaning for 'V' taken from status code in NMEA GLL and RMC sentences)
},
},
0x000a => {
Name => 'GPSMeasureMode',
Writable => 'string',
Count => 2,
PrintConv => {
2 => '2-Dimensional Measurement',
3 => '3-Dimensional Measurement',
},
},
0x000b => {
Name => 'GPSDOP',
Description => 'GPS Dilution Of Precision',
Writable => 'rational64u',
},
0x000c => {
Name => 'GPSSpeedRef',
Writable => 'string',
Count => 2,
PrintConv => {
K => 'km/h',
M => 'mph',
N => 'knots',
},
},
0x000d => {
Name => 'GPSSpeed',
Writable => 'rational64u',
},
0x000e => {
Name => 'GPSTrackRef',
Writable => 'string',
Count => 2,
PrintConv => {
M => 'Magnetic North',
T => 'True North',
},
},
0x000f => {
Name => 'GPSTrack',
Writable => 'rational64u',
},
0x0010 => {
Name => 'GPSImgDirectionRef',
Writable => 'string',
Count => 2,
PrintConv => {
M => 'Magnetic North',
T => 'True North',
},
},
0x0011 => {
Name => 'GPSImgDirection',
Writable => 'rational64u',
},
0x0012 => {
Name => 'GPSMapDatum',
Writable => 'string',
},
0x0013 => {
Name => 'GPSDestLatitudeRef',
Writable => 'string',
Notes => 'tags 0x0013-0x001a used for subject location according to MWG 2.0',
Count => 2,
PrintConv => { N => 'North', S => 'South' },
},
0x0014 => {
Name => 'GPSDestLatitude',
Writable => 'rational64u',
Count => 3,
%coordConv,
},
0x0015 => {
Name => 'GPSDestLongitudeRef',
Writable => 'string',
Count => 2,
PrintConv => { E => 'East', W => 'West' },
},
0x0016 => {
Name => 'GPSDestLongitude',
Writable => 'rational64u',
Count => 3,
%coordConv,
},
0x0017 => {
Name => 'GPSDestBearingRef',
Writable => 'string',
Count => 2,
PrintConv => {
M => 'Magnetic North',
T => 'True North',
},
},
0x0018 => {
Name => 'GPSDestBearing',
Writable => 'rational64u',
},
0x0019 => {
Name => 'GPSDestDistanceRef',
Writable => 'string',
Count => 2,
PrintConv => {
K => 'Kilometers',
M => 'Miles',
N => 'Nautical Miles',
},
},
0x001a => {
Name => 'GPSDestDistance',
Writable => 'rational64u',
},
0x001b => {
Name => 'GPSProcessingMethod',
Writable => 'undef',
Notes => 'values of "GPS", "CELLID", "WLAN" or "MANUAL" by the EXIF spec.',
RawConv => 'Image::ExifTool::Exif::ConvertExifText($self,$val,1,$tag)',
RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)',
},
0x001c => {
Name => 'GPSAreaInformation',
Writable => 'undef',
RawConv => 'Image::ExifTool::Exif::ConvertExifText($self,$val,1,$tag)',
RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)',
},
0x001d => {
Name => 'GPSDateStamp',
Groups => { 2 => 'Time' },
Writable => 'string',
Format => 'undef', # (Casio EX-H20G uses "\0" instead of ":" as a separator)
Count => 11,
Shift => 'Time',
Notes => q{
when writing, time is stripped off if present, after adjusting date/time to
UTC if time includes a timezone. Format is YYYY:mm:dd
},
RawConv => '$val =~ s/\0+$//; $val',
ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
ValueConvInv => '$val',
# pull date out of any format date/time string
# (and adjust to UTC if this is a full date/time/timezone value)
PrintConvInv => q{
my $secs;
$val = $self->TimeNow() if lc($val) eq 'now';
if ($val =~ /[-+]/ and ($secs = Image::ExifTool::GetUnixTime($val, 1))) {
$val = Image::ExifTool::ConvertUnixTime($secs);
}
return $val =~ /(\d{4}).*?(\d{2}).*?(\d{2})/ ? "$1:$2:$3" : undef;
},
},
0x001e => {
Name => 'GPSDifferential',
Writable => 'int16u',
PrintConv => {
0 => 'No Correction',
1 => 'Differential Corrected',
},
},
0x001f => {
Name => 'GPSHPositioningError',
Description => 'GPS Horizontal Positioning Error',
PrintConv => '"$val m"',
PrintConvInv => '$val=~s/\s*m$//; $val',
Writable => 'rational64u',
},
# 0xea1c - Nokia Lumina 1020, Samsung GT-I8750, and other Windows 8
# phones write this (padding) in GPS IFD - PH
);
# Composite GPS tags
%Image::ExifTool::GPS::Composite = (
GROUPS => { 2 => 'Location' },
GPSDateTime => {
Description => 'GPS Date/Time',
Groups => { 2 => 'Time' },
SubDoc => 1, # generate for all sub-documents
Require => {
0 => 'GPS:GPSDateStamp',
1 => 'GPS:GPSTimeStamp',
},
ValueConv => '"$val[0] $val[1]Z"',
PrintConv => '$self->ConvertDateTime($val)',
},
# Note: The following tags are used by other modules
# which must therefore require this module as necessary
GPSLatitude => {
SubDoc => 1, # generate for all sub-documents
Require => {
0 => 'GPS:GPSLatitude',
1 => 'GPS:GPSLatitudeRef',
},
ValueConv => '$val[1] =~ /^S/i ? -$val[0] : $val[0]',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
GPSLongitude => {
SubDoc => 1, # generate for all sub-documents
Require => {
0 => 'GPS:GPSLongitude',
1 => 'GPS:GPSLongitudeRef',
},
ValueConv => '$val[1] =~ /^W/i ? -$val[0] : $val[0]',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
GPSAltitude => {
SubDoc => [1,3], # generate for sub-documents if Desire 1 or 3 has a chance to exist
Desire => {
0 => 'GPS:GPSAltitude',
1 => 'GPS:GPSAltitudeRef',
2 => 'XMP:GPSAltitude',
3 => 'XMP:GPSAltitudeRef',
},
# Require either GPS:GPSAltitudeRef or XMP:GPSAltitudeRef
RawConv => '(defined $val[1] or defined $val[3]) ? $val : undef',
ValueConv => q{
my $alt = $val[0];
$alt = $val[2] unless defined $alt;
return undef unless defined $alt and IsFloat($alt);
return ($val[1] || $val[3]) ? -$alt : $alt;
},
PrintConv => q{
$val = int($val * 10) / 10;
return ($val =~ s/^-// ? "$val m Below" : "$val m Above") . " Sea Level";
},
},
GPSDestLatitude => {
Require => {
0 => 'GPS:GPSDestLatitude',
1 => 'GPS:GPSDestLatitudeRef',
},
ValueConv => '$val[1] =~ /^S/i ? -$val[0] : $val[0]',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
GPSDestLongitude => {
SubDoc => 1, # generate for all sub-documents
Require => {
0 => 'GPS:GPSDestLongitude',
1 => 'GPS:GPSDestLongitudeRef',
},
ValueConv => '$val[1] =~ /^W/i ? -$val[0] : $val[0]',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::GPS');
#------------------------------------------------------------------------------
# Convert GPS timestamp value
# Inputs: 0) raw timestamp value string
# Returns: EXIF-formatted time string
sub ConvertTimeStamp($)
{
my $val = shift;
my ($h,$m,$s) = split ' ', $val;
my $f = (($h || 0) * 60 + ($m || 0)) * 60 + ($s || 0);
$h = int($f / 3600); $f -= $h * 3600;
$m = int($f / 60); $f -= $m * 60;
$s = int($f); $f -= $s;
$f = int($f * 1000000000 + 0.5);
if ($f) {
($f = sprintf(".%.9d", $f)) =~ s/0+$//;
} else {
$f = ''
}
return sprintf("%.2d:%.2d:%.2d%s",$h,$m,$s,$f);
}
#------------------------------------------------------------------------------
# Print GPS timestamp
# Inputs: 0) EXIF-formatted time string
# Returns: time rounded to the nearest microsecond
sub PrintTimeStamp($)
{
my $val = shift;
return $val unless $val =~ s/:(\d{2}\.\d+)$//;
my $s = int($1 * 1000000 + 0.5) / 1000000;
$s = "0$s" if $s < 10;
return "${val}:$s";
}
#------------------------------------------------------------------------------
# Convert degrees to DMS, or whatever the current settings are
# Inputs: 0) ExifTool reference, 1) Value in degrees,
# 2) format code (0=no format, 1=CoordFormat, 2=XMP format)
# 3) 'N' or 'E' if sign is significant and N/S/E/W should be added
# Returns: DMS string
sub ToDMS($$;$$)
{
my ($et, $val, $doPrintConv, $ref) = @_;
my ($fmt, @fmt, $num, $sign);
unless (length $val) {
# don't convert an empty value
return $val if $doPrintConv and $doPrintConv eq 1; # avoid hiding existing tag when extracting
return undef; # avoid writing empty value
}
if ($ref) {
if ($val < 0) {
$val = -$val;
$ref = {N => 'S', E => 'W'}->{$ref};
$sign = '-';
} else {
$sign = '+';
}
$ref = " $ref" unless $doPrintConv and $doPrintConv eq '2';
} else {
$val = abs($val);
$ref = '';
}
if ($doPrintConv) {
if ($doPrintConv eq '1') {
$fmt = $et->Options('CoordFormat');
if (not $fmt) {
$fmt = q{%d deg %d' %.2f"} . $ref;
} elsif ($ref) {
# use signed value instead of reference direction if specified
$fmt =~ s/%\+/$sign%/g or $fmt .= $ref;
} else {
$fmt =~ s/%\+/%/g; # don't know sign, so don't print it
}
} else {
$fmt = "%d,%.6f$ref"; # use XMP standard format
}
# count (and capture) the format specifiers (max 3)
while ($fmt =~ /(%(%|[^%]*?[diouxXDOUeEfFgGcs]))/g) {
next if $1 eq '%%';
push @fmt, $1;
last if @fmt >= 3;
}
$num = scalar @fmt;
} else {
$num = 3;
}
my @c; # coordinates (D) or (D,M) or (D,M,S)
$c[0] = $val;
if ($num > 1) {
$c[0] = int($c[0]);
$c[1] = ($val - $c[0]) * 60;
if ($num > 2) {
$c[1] = int($c[1]);
$c[2] = ($val - $c[0] - $c[1] / 60) * 3600;
}
# handle round-off errors to ensure minutes and seconds are
# less than 60 (eg. convert "72 59 60.00" to "73 0 0.00")
$c[-1] = $doPrintConv ? sprintf($fmt[-1], $c[-1]) : ($c[-1] . '');
if ($c[-1] >= 60) {
$c[-1] -= 60;
($c[-2] += 1) >= 60 and $num > 2 and $c[-2] -= 60, $c[-3] += 1;
}
}
return $doPrintConv ? sprintf($fmt, @c) : "@c$ref";
}
#------------------------------------------------------------------------------
# Convert to decimal degrees
# Inputs: 0) a string containing 1-3 decimal numbers and any amount of other garbage
# 1) true if value should be negative if coordinate ends in 'S' or 'W'
# Returns: Coordinate in degrees
sub ToDegrees($;$)
{
my ($val, $doSign) = @_;
# extract decimal or floating point values out of any other garbage
my ($d, $m, $s) = ($val =~ /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee][+-]\d+)?)/g);
return '' unless defined $d;
my $deg = $d + (($m || 0) + ($s || 0)/60) / 60;
# make negative if S or W coordinate
$deg = -$deg if $doSign ? $val =~ /[^A-Z](S|W)$/i : $deg < 0;
return $deg;
}
1; #end
__END__
=head1 NAME
Image::ExifTool::GPS - EXIF GPS meta information tags
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
GPS (Global Positioning System) meta information in EXIF data.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<Image::Info|Image::Info>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/GPS Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>,
L<Image::Info(3pm)|Image::Info>
=cut

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,709 @@
#------------------------------------------------------------------------------
# File: GoPro.pm
#
# Description: Read information from GoPro videos
#
# Revisions: 2018/01/12 - P. Harvey Created
#
# References: 1) https://github.com/gopro/gpmf-parser
# 2) https://github.com/stilldavid/gopro-utils
#------------------------------------------------------------------------------
package Image::ExifTool::GoPro;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::QuickTime;
$VERSION = '1.02';
sub ProcessGoPro($$$);
sub ProcessString($$$);
sub ScaleValues($$);
sub AddUnits($$$);
sub ConvertSystemTime($$);
# GoPro data types that have ExifTool equivalents (ref 1)
my %goProFmt = ( # format codes
# 0x00 - container (subdirectory)
0x62 => 'int8s', # 'b'
0x42 => 'int8u', # 'B'
0x63 => 'string', # 'c' (possibly null terminated)
0x73 => 'int16s', # 's'
0x53 => 'int16u', # 'S'
0x6c => 'int32s', # 'l'
0x4c => 'int32u', # 'L'
0x66 => 'float', # 'f'
0x64 => 'double', # 'd'
0x46 => 'undef', # 'F' (4-char ID)
0x47 => 'undef', # 'G' (16-byte uuid)
0x6a => 'int64s', # 'j'
0x4a => 'int64u', # 'J'
0x71 => 'fixed32s', # 'q'
0x51 => 'fixed64s', # 'Q'
0x55 => 'undef', # 'U' (16-byte date)
0x3f => 'undef', # '?' (complex structure)
);
# sizes of format codes if different than what FormatSize() would return
my %goProSize = (
0x46 => 4,
0x47 => 16,
0x55 => 16,
);
# tagInfo elements to add units to PrintConv value
my %addUnits = (
AddUnits => 1,
PrintConv => 'Image::ExifTool::GoPro::AddUnits($self, $val, $tag)',
);
# Tags found in the GPMF box of Hero6 mp4 videos (ref PH), and
# the gpmd-format timed metadata of Hero5 and Hero6 videos (ref 1)
%Image::ExifTool::GoPro::GPMF = (
PROCESS_PROC => \&ProcessGoPro,
GROUPS => { 2 => 'Camera' },
NOTES => q{
Tags extracted from the GPMF box of GoPro MP4 videos, the APP6 "GoPro" segment
of JPEG files, and from the "gpmd" timed metadata if the ExtractEmbedded option
is enabled. Many more tags exist, but are currently unknown and extracted only
with the -u option. Please let me know if you discover the meaning of any of
these unknown tags. See L<https://github.com/gopro/gpmf-parser> for details
about this format.
},
ACCL => { #2 (gpmd)
Name => 'Accelerometer',
Notes => 'accelerator readings in m/s',
Binary => 1,
},
ALLD => 'AutoLowLightDuration', #1 (gpmd) (untested)
# APTO (GPMF) - seen: 'RAW' (fmt c)
ATTD => { #PH (Karma)
Name => 'Attitude',
# UNIT=s,rad,rad,rad,rad/s,rad/s,rad/s,
# TYPE=LffffffB
# SCAL=1000 1 1 1 1 1 1 1
Binary => 1,
},
ATTR => { #PH (Karma)
Name => 'AttitudeTarget',
# UNIT=s,rad,rad,rad,
# TYPE=Jffff
# SCAL=1000 1 1 1 1
Binary => 1,
},
AUDO => 'AudioSetting', #PH (GPMF - seen: 'WIND', fmt c)
# AUPT (GPMF) - seen: 'N' (fmt c)
BPOS => { #PH (Karma)
Name => 'Controller',
Unknown => 1,
# UNIT=deg,deg,m,deg,deg,m,m,m
# TYPE=lllfffff
# SCAL=10000000 10000000 1000 1 1 1 1 1
%addUnits,
},
# BRID (GPMF) - seen: 0 (fmt B)
# BROD (GPMF) - seen: 'ASK' (fmt c)
CASN => 'CameraSerialNumber', #PH (GPMF - seen: 'C3221324545448', fmt c)
# CINF (GPMF) - seen: 0x67376be7709bc8876a8baf3940908618 (fmt B)
# CMOD (GPMF) - seen: 12,13,17 [13 time-laps video, 17 JPEG] (fmt B)
CYTS => { #PH (Karma)
Name => 'CoyoteStatus',
# UNIT=s,,,,,rad,rad,rad,,
# TYPE=LLLLLfffBB
# SCAL=1000 1 1 1 1 1 1 1 1 1
Binary => 1,
},
CSEN => { #PH (Karma)
Name => 'CoyoteSense',
# UNIT=s,rad/s,rad/s,rad/s,g,g,g,,,,
# TYPE=LffffffLLLL
# SCAL=1000 1 1 1 1 1 1 1 1 1 1
Binary => 1,
},
DEVC => { #PH (gpmd,GPMF, fmt \0)
Name => 'DeviceContainer',
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
},
# DVID (GPMF) - DeviceID; seen: 1 (fmt L), HLMT (fmt F)
DVID => { Name => 'DeviceID', Unknown => 1 }, #2 (gpmd)
# DVNM (GPMF) seen: 'Video Global Settings' (fmt c), 'Highlights' (fmt c)
# DVNM (gpmd) seen: 'Camera' (Hero5), 'Hero6 Black' (Hero6), 'GoPro Karma v1.0' (Karma)
DVNM => 'DeviceName', #PH
DZOM => { #PH (GPMF - seen: 'Y', fmt c)
Name => 'DigitalZoom',
PrintConv => { N => 'No', Y => 'Yes' },
},
# DZST (GPMF) - seen: 0 (fmt L) (something to do with digital zoom maybe?)
# EISA (GPMF) - seen: 'Y','N' [N was for a time-lapse video] (fmt c)
# EISE (GPMF) - seen: 'Y' (fmt c)
EMPT => { Name => 'Empty', Unknown => 1 }, #2 (gpmd)
ESCS => { #PH (Karma)
Name => 'EscapeStatus',
# UNIT=s,rpm,rpm,rpm,rpm,rpm,rpm,rpm,rpm,degC,degC,degC,degC,V,V,V,V,A,A,A,A,,,,,,,,,
# TYPE=JSSSSSSSSssssSSSSSSSSSSSSSSSSB
# (no SCAL!)
Unknown => 1,
%addUnits,
},
# EXPT (GPMF) - seen: '' (fmt c)
FACE => 'FaceDetected', #PH (gpmd)
FCNM => 'FaceNumbers', #PH (gpmd) (faces counted per frame, ref 1)
FMWR => 'FirmwareVersion', #PH (GPMF - seen: HD6.01.01.51.00, fmt c)
FWVS => 'OtherFirmware', #PH (NC) (gpmd - seen: '1.1.11.0', Karma)
GLPI => { #PH (gpmd, Karma)
Name => 'GPSPos',
# UNIT=s,deg,deg,m,m,m/s,m/s,m/s,deg
# TYPE=LllllsssS
# SCAL=1000 10000000 10000000 1000 1000 100 100 100 100
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GLPI' },
},
GPRI => { #PH (gpmd, Karma)
Name => 'GPSRaw',
# UNIT=s,deg,deg,m,m,m,m/s,deg,,
# TYPE=JlllSSSSBB
# SCAL=1000000,10000000,10000000,1000,100,100,100,100,1,1
Unknown => 1,
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPRI' },
},
GPS5 => { #2 (gpmd)
Name => 'GPSInfo',
# SCAL=10000000,10000000,1000,1000,100
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPS5' },
},
GPSF => { #2 (gpmd)
Name => 'GPSMeasureMode',
PrintConv => {
2 => '2-Dimensional Measurement',
3 => '3-Dimensional Measurement',
},
},
GPSP => { #2 (gpmd)
Name => 'GPSHPositioningError',
Description => 'GPS Horizontal Positioning Error',
ValueConv => '$val / 100', # convert from cm to m
},
GPSU => { #2 (gpmd)
Name => 'GPSDateTime',
Groups => { 2 => 'Time' },
# (HERO5 writes this in 'c' format, HERO6 writes 'U')
ValueConv => '$val =~ s/^(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/20$1:$2:$3 $4:$5:/; $val',
PrintConv => '$self->ConvertDateTime($val)',
},
GYRO => { #2 (gpmd)
Name => 'Gyroscope',
Notes => 'gyroscope readings in rad/s',
Binary => 1,
},
# HFLG (APP6) - seen: 0
ISOE => 'ISOSpeeds', #PH (gpmd)
ISOG => { #2 (gpmd)
Name => 'ImageSensorGain',
Binary => 1,
},
KBAT => { #PH (gpmd) (Karma)
Name => 'BatteryStatus',
# UNIT=A,Ah,J,degC,V,V,V,V,s,%,,,,,%
# TYPE=lLlsSSSSSSSBBBb
# SCAL=1000,1000,0.00999999977648258,100,1000,1000,1000,1000,0.0166666675359011,1,1,1,1,1,1
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::KBAT' },
},
# LINF (GPMF) - seen: LAJ7061916601668 (fmt c)
LNED => { #PH (Karma)
Name => 'LocalPositionNED',
# UNIT=s,m,m,m,m/s,m/s,m/s
# TYPE=Lffffff
# SCAL=1000 1 1 1 1 1 1
Binary => 1,
},
MAGN => 'Magnetometer', #1 (gpmd) (units of uT)
MINF => { #PH (GPMF - seen: HERO6 Black, fmt c)
Name => 'Model',
Groups => { 2 => 'Camera' },
Description => 'Camera Model Name',
},
# MTYP (GPMF) - seen: 0,1,11 [1 for time-lapse video, 11 for JPEG] (fmt B)
# MUID (GPMF) - seen: 3882563431 2278071152 967805802 411471936 0 0 0 0 (fmt L)
OREN => { #PH (GPMF - seen: 'U', fmt c)
Name => 'AutoRotation',
PrintConv => {
U => 'Up',
D => 'Down', # (NC)
A => 'Auto', # (NC)
},
},
# (most of the "P" tags are ProTune settings - PH)
PHDR => 'HDRSetting', #PH (APP6 - seen: 0)
PIMN => 'AutoISOMin', #PH (GPMF - seen: 100, fmt L)
PIMX => 'AutoISOMax', #PH (GPMF - seen: 1600, fmt L)
# PRAW (APP6) - seen: 0
PRES => 'PhotoResolution', #PH (APP6 - seen: '12MP_W')
PRTN => { #PH (GPMF - seen: 'N', fmt c)
Name => 'ProTune',
PrintConv => {
N => 'Off',
Y => 'On', # (NC)
},
},
PTCL => 'ColorMode', #PH (GPMF - seen: 'GOPRO', fmt c' APP6: 'FLAT')
PTEV => 'ExposureCompensation', #PH (GPMF - seen: '0.0', fmt c)
PTSH => 'Sharpness', #PH (GPMF - seen: 'HIGH', fmt c)
PTWB => 'WhiteBalance', #PH (GPMF - seen: 'AUTO', fmt c)
RATE => 'Rate', #PH (GPMF - seen: '0_5SEC', fmt c; APP6 - seen: '4_1SEC')
RMRK => { #2 (gpmd)
Name => 'Comments',
ValueConv => '$self->Decode($val, "Latin")',
},
SCAL => { #2 (gpmd) scale factor for subsequent data
Name => 'ScaleFactor',
Unknown => 1,
},
SCPR => { #PH (Karma) [stream was empty]
Name => 'ScaledPressure',
# UNIT=s,Pa,Pa,degC
# TYPE=Lffs
# SCAL=1000 0.00999999977648258 0.00999999977648258 100
%addUnits,
},
SHUT => { #2 (gpmd)
Name => 'ExposureTimes',
PrintConv => q{
my @a = split ' ', $val;
$_ = Image::ExifTool::Exif::PrintExposureTime($_) foreach @a;
return join ' ', @a;
},
},
SIMU => { #PH (Karma)
Name => 'ScaledIMU',
# UNIT=s,g,g,g,rad/s,rad/s,rad/s,T,T,T
# TYPE=Lsssssssss
# SCAL=1000 1000 1000 1000 1000 1000 1000 1000 1000 1000
%addUnits,
},
SIUN => { #2 (gpmd - seen : 'm/s2','rad/s')
Name => 'SIUnits',
Unknown => 1,
ValueConv => '$self->Decode($val, "Latin")',
},
# SMTR (GPMF) - seen: 'N' (fmt c)
STMP => { #1 (gpmd)
Name => 'TimeStamp',
ValueConv => '$val / 1e6',
},
STRM => { #2 (gpmd,GPMF, fmt \0)
Name => 'NestedSignalStream',
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
},
STNM => { #2 (gpmd)
Name => 'StreamName',
Unknown => 1,
ValueConv => '$self->Decode($val, "Latin")',
},
SYST => { #PH (Karma)
Name => 'SystemTime',
# UNIT=s,s
# TYPE=JJ
# SCAL=1000000 1000
# save system time calibrations for later
RawConv => q{
my @v = split ' ', $val;
if (@v == 2) {
my $s = $$self{SystemTimeList};
$s or $s = $$self{SystemTimeList} = [ ];
push @$s, \@v;
}
return $val;
},
},
# TICK => { Name => 'InTime', Unknown => 1, ValueConv => '$val/1000' }, #1 (gpmd)
TMPC => { #2 (gpmd)
Name => 'CameraTemperature',
PrintConv => '"$val C"',
},
# TOCK => { Name => 'OutTime', Unknown => 1, ValueConv => '$val/1000' }, #1 (gpmd)
TSMP => { Name => 'TotalSamples', Unknown => 1 }, #2 (gpmd)
TYPE => { Name => 'StructureType', Unknown => 1 }, #2 (gpmd,GPMF - eg 'LLLllfFff', fmt c)
UNIT => { #2 (gpmd) alternative units
Name => 'Units',
Unknown => 1,
ValueConv => '$self->Decode($val, "Latin")',
},
VFOV => { #PH (GPMF - seen: 'W', fmt c)
Name => 'FieldOfView',
PrintConv => {
W => 'Wide',
S => 'Super View', # (NC, not seen)
L => 'Linear', # (NC, not seen)
},
},
# VLTA (GPMF) - seen: 78 ('N') (fmt B -- wrong format?)
VFRH => { #PH (Karma)
Name => 'VisualFlightRulesHUD',
BinaryData => 1,
# UNIT=m/s,m/s,m,m/s,deg,%
# TYPE=ffffsS
},
# VLTE (GPMF) - seen: 'Y' (fmt c)
WBAL => 'ColorTemperatures', #PH (gpmd)
WRGB => { #PH (gpmd)
Name => 'WhiteBalanceRGB',
Binary => 1,
},
);
# GoPro GPS5 tags (ref 2) (Hero5,Hero6)
%Image::ExifTool::GoPro::GPS5 = (
PROCESS_PROC => \&ProcessString,
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
0 => { # (unit='deg')
Name => 'GPSLatitude',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
1 => { # (unit='deg')
Name => 'GPSLongitude',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
2 => { # (unit='m')
Name => 'GPSAltitude',
PrintConv => '"$val m"',
},
3 => 'GPSSpeed', # (unit='m/s')
4 => 'GPSSpeed3D', # (unit='m/s')
);
# GoPro GPRI tags (ref PH) (Karma)
%Image::ExifTool::GoPro::GPRI = (
PROCESS_PROC => \&ProcessString,
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
0 => { # (unit='s')
Name => 'GPSDateTimeRaw',
Groups => { 2 => 'Time' },
ValueConv => \&ConvertSystemTime, # convert to date/time based on SystemTime clock
PrintConv => '$self->ConvertDateTime($val)',
},
1 => { # (unit='deg')
Name => 'GPSLatitudeRaw',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
2 => { # (unit='deg')
Name => 'GPSLongitudeRaw',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
3 => {
Name => 'GPSAltitudeRaw', # (NC)
PrintConv => '"$val m"',
},
# (unknown tags must be defined so that ProcessString() will iterate through all values)
4 => { Name => 'GPRI_Unknown4', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
5 => { Name => 'GPRI_Unknown5', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
6 => 'GPSSpeedRaw', # (NC) # (unit='m/s' -- should convert to other units?)
7 => 'GPSTrackRaw', # (NC) # (unit='deg')
8 => { Name => 'GPRI_Unknown8', Unknown => 1, Hidden => 1 }, # (no units)
9 => { Name => 'GPRI_Unknown9', Unknown => 1, Hidden => 1 }, # (no units)
);
# GoPro GLPI tags (ref PH) (Karma)
%Image::ExifTool::GoPro::GLPI = (
PROCESS_PROC => \&ProcessString,
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
0 => { # (unit='s')
Name => 'GPSDateTime',
Groups => { 2 => 'Time' },
ValueConv => \&ConvertSystemTime, # convert to date/time based on SystemTime clock
PrintConv => '$self->ConvertDateTime($val)',
},
1 => { # (unit='deg')
Name => 'GPSLatitude',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
2 => { # (unit='deg')
Name => 'GPSLongitude',
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
3 => { # (unit='m')
Name => 'GPSAltitude', # (NC)
PrintConv => '"$val m"',
},
# (unknown tags must be defined so that ProcessString() will iterate through all values)
4 => { Name => 'GLPI_Unknown4', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
5 => { Name => 'GPSSpeedX', PrintConv => '"$val m/s"' }, # (NC)
6 => { Name => 'GPSSpeedY', PrintConv => '"$val m/s"' }, # (NC)
7 => { Name => 'GPSSpeedZ', PrintConv => '"$val m/s"' }, # (NC)
8 => { Name => 'GPSTrack' }, # (unit='deg')
);
# GoPro KBAT tags (ref PH)
%Image::ExifTool::GoPro::KBAT = (
PROCESS_PROC => \&ProcessString,
GROUPS => { 1 => 'GoPro', 2 => 'Camera' },
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
NOTES => 'Battery status information found in GoPro Karma videos.',
0 => { Name => 'BatteryCurrent', PrintConv => '"$val A"' },
1 => { Name => 'BatteryCapacity', PrintConv => '"$val Ah"' },
2 => { Name => 'KBAT_Unknown2', PrintConv => '"$val J"', Unknown => 1, Hidden => 1 },
3 => { Name => 'BatteryTemperature', PrintConv => '"$val C"' },
4 => { Name => 'BatteryVoltage1', PrintConv => '"$val V"' },
5 => { Name => 'BatteryVoltage2', PrintConv => '"$val V"' },
6 => { Name => 'BatteryVoltage3', PrintConv => '"$val V"' },
7 => { Name => 'BatteryVoltage4', PrintConv => '"$val V"' },
8 => { Name => 'BatteryTime', PrintConv => 'ConvertDuration(int($val + 0.5))' }, # (NC)
9 => { Name => 'KBAT_Unknown9', PrintConv => '"$val %"', Unknown => 1, Hidden => 1, },
10 => { Name => 'KBAT_Unknown10', Unknown => 1, Hidden => 1 }, # (no units)
11 => { Name => 'KBAT_Unknown11', Unknown => 1, Hidden => 1 }, # (no units)
12 => { Name => 'KBAT_Unknown12', Unknown => 1, Hidden => 1 }, # (no units)
13 => { Name => 'KBAT_Unknown13', Unknown => 1, Hidden => 1 }, # (no units)
14 => { Name => 'BatteryLevel', PrintConv => '"$val %"' },
);
# GoPro fdsc tags written by the Hero5 and Hero6 (ref PH)
%Image::ExifTool::GoPro::fdsc = (
GROUPS => { 2 => 'Camera' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
NOTES => q{
Tags extracted from the MP4 "fdsc" timed metadata when the ExtractEmbedded
option is used.
},
0x08 => { Name => 'FirmwareVersion', Format => 'string[15]' },
0x17 => { Name => 'SerialNumber', Format => 'string[16]' },
0x57 => { Name => 'OtherSerialNumber', Format => 'string[15]' }, # (NC)
0x66 => {
Name => 'Model',
Description => 'Camera Model Name',
Format => 'string[16]',
},
# ...
# after this there are lots of interesting values also found in the GPMF box,
# but this block is lacking tag ID's and any directory structure, so the
# value offsets are therefore presumably firmware dependent :(
);
#------------------------------------------------------------------------------
# Convert system time to date/time string
# Inputs: 0) system time value, 1) ExifTool ref
# Returns: EXIF-format date/time string with milliseconds
sub ConvertSystemTime($$)
{
my ($val, $et) = @_;
my $s = $$et{SystemTimeList} or return '<uncalibrated>';
unless ($$et{SystemTimeListSorted}) {
$s = $$et{SystemTimeList} = [ sort { $$a[0] <=> $$b[0] } @$s ];
$$et{SystemTimeListSorted} = 1;
}
my ($i, $j) = (0, $#$s);
# perform binary search to find this system time value
while ($j - $i > 1) {
my $t = int(($i + $j) / 2);
($val < $$s[$t][0] ? $j : $i) = $t;
}
if ($i == $j or $$s[$j][0] == $$s[$i][0]) {
$val = $$s[$i][1];
} else {
# interpolate between values
$val = $$s[$i][1] + ($$s[$j][1] - $$s[$i][1]) * ($val - $$s[$i][0]) / ($$s[$j][0] - $$s[$i][0]);
}
# (a bit tricky to remove fractional seconds then add them back again after
# the date/time conversion while avoiding round-off errors which could
# put the seconds out by 1...)
my ($t, $f) = ("$val" =~ /^(\d+)(\.\d+)/);
return Image::ExifTool::ConvertUnixTime($t, $$et{OPTIONS}{QuickTimeUTC}) . $f;
}
#------------------------------------------------------------------------------
# Scale values by last 'SCAL' constants
# Inputs: 0) value or list of values, 1) string of scale factors
# Returns: nothing, but updates values
sub ScaleValues($$)
{
my ($val, $scl) = @_;
return unless $val and $scl;
my @scl = split ' ', $scl or return;
my @scaled;
my $v = (ref $val eq 'ARRAY') ? $val : [ $val ];
foreach $val (@$v) {
my @a = split ' ', $val;
$a[$_] /= $scl[$_ % @scl] foreach 0..$#a;
push @scaled, join(' ', @a);
}
$_[0] = @scaled > 1 ? \@scaled : $scaled[0];
}
#------------------------------------------------------------------------------
# Add units to values for human-readable output
# Inputs: 0) ExifTool ref, 1) value, 2) tag key
# Returns: converted value
sub AddUnits($$$)
{
my ($et, $val, $tag) = @_;
if ($et and $$et{TAG_EXTRA}{$tag} and $$et{TAG_EXTRA}{$tag}{Units}) {
my $u = $$et{TAG_EXTRA}{$tag}{Units};
$u = [ $u ] unless ref $u eq 'ARRAY';
my @a = split ' ', $val;
if (@$u == @a) {
my $i;
for ($i=0; $i<@a; ++$i) {
$a[$i] .= ' ' . $$u[$i] if $$u[$i];
}
$val = join ' ', @a;
}
}
return $val;
}
#------------------------------------------------------------------------------
# Process string of values (or array of strings) to extract as separate tags
# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref
# Returns: 1 on success
sub ProcessString($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my @list = ref $$dataPt eq 'ARRAY' ? @{$$dataPt} : ( $$dataPt );
my ($string, $val);
$et->VerboseDir('GoPro structure');
foreach $string (@list) {
my @val = split ' ', $string;
my $i = 0;
foreach $val (@val) {
$et->HandleTag($tagTablePtr, $i, $val);
$$tagTablePtr{++$i} or $i = 0;
}
}
return 1;
}
#------------------------------------------------------------------------------
# Process GoPro metadata (gpmd samples, GPMF box, or APP6) (ref PH/1/2)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessGoPro($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $base = $$dirInfo{Base};
my $pos = $$dirInfo{DirStart} || 0;
my $dirEnd = $pos + ($$dirInfo{DirLen} || (length($$dataPt) - $pos));
my $verbose = $et->Options('Verbose');
my $unknown = $verbose || $et->Options('Unknown');
my ($size, $type, $unit, $scal, $setGroup0);
$et->VerboseDir($$dirInfo{DirName} || 'GPMF', undef, $dirEnd-$pos) if $verbose;
if ($pos) {
my $parent = $$dirInfo{Parent};
$setGroup0 = $$et{SET_GROUP0} = 'APP6' if $parent and $parent eq 'APP6';
} else {
# set group0 to "QuickTime" unless group1 is being changed (to Track#)
$setGroup0 = $$et{SET_GROUP0} = 'QuickTime' unless $$et{SET_GROUP1};
}
for (; $pos+8<=$dirEnd; $pos+=($size+3)&0xfffffffc) {
my ($tag,$fmt,$len,$count) = unpack("x${pos}a4CCn", $$dataPt);
$size = $len * $count;
$pos += 8;
last if $pos + $size > $dirEnd;
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
last if $tag eq "\0\0\0\0"; # stop at null tag
next unless $size or $verbose; # don't save empty values unless verbose
my $format = $goProFmt{$fmt} || 'undef';
my ($val, $i, $j, $p, @v);
if ($fmt eq 0x3f and defined $type) {
# decode structure with format given by previous 'TYPE'
for ($i=0; $i<$count; ++$i) {
my (@s, $l);
for ($j=0, $p=0; $j<length($type); ++$j, $p+=$l) {
my $b = Get8u(\$type, $j);
my $f = $goProFmt{$b} or last;
$l = $goProSize{$b} || Image::ExifTool::FormatSize($f) or last;
last if $p + $l > $len;
my $s = ReadValue($dataPt, $pos+$i*$len+$p, $f, undef, $l);
last unless defined $s;
push @s, $s;
}
push @v, join ' ', @s if @s;
}
$val = @v > 1 ? \@v : $v[0];
} elsif (($format eq 'undef' or $format eq 'string') and $count > 1 and $len > 1) {
# unpack multiple undef/string values as a list
my $a = $format eq 'undef' ? 'a' : 'A';
$val = [ unpack("x${pos}".("$a$len" x $count), $$dataPt) ];
} else {
$val = ReadValue($dataPt, $pos, $format, undef, $size);
}
# save TYPE, UNIT/SIUN and SCAL values for later
$type = $val if $tag eq 'TYPE';
$unit = $val if $tag eq 'UNIT' or $tag eq 'SIUN';
$scal = $val if $tag eq 'SCAL';
unless ($tagInfo) {
next unless $unknown;
my $name = Image::ExifTool::QuickTime::PrintableTagID($tag);
$tagInfo = { Name => "GoPro_$name", Description => "GoPro $name", Unknown => 1 };
$$tagInfo{SubDirectory} = { TagTable => 'Image::ExifTool::GoPro::GPMF' } if not $fmt;
AddTagToTable($tagTablePtr, $tag, $tagInfo);
}
# apply scaling if available to last tag in this container
ScaleValues($val, $scal) if $scal and $tag ne 'SCAL' and $pos+$size+3>=$dirEnd;
my $key = $et->HandleTag($tagTablePtr, $tag, $val,
DataPt => $dataPt,
Base => $base,
Start => $pos,
Size => $size,
TagInfo => $tagInfo,
Format => $format,
Extra => $verbose ? ", type='".($fmt ? chr($fmt) : '\0')."' size=$len count=$count" : undef,
);
# save units for adding in print conversion if specified
$$et{TAG_EXTRA}{$key}{Units} = $unit if $$tagInfo{AddUnits} and $key;
}
delete $$et{SET_GROUP0} if $setGroup0;
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::GoPro - Read information from GoPro videos
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to decode
metadata from GoPro MP4 videos.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<https://github.com/gopro/gpmf-parser>
=item L<https://github.com/stilldavid/gopro-utils>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/GoPro Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,263 @@
#------------------------------------------------------------------------------
# File: HP.pm
#
# Description: Hewlett-Packard maker notes tags
#
# Revisions: 2007-05-03 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::HP;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.04';
sub ProcessHP($$$);
sub ProcessTDHD($$$);
# HP EXIF-format maker notes (or is it Vivitar?)
%Image::ExifTool::HP::Main = (
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => q{
These tables list tags found in the maker notes of some Hewlett-Packard
camera models.
The first table lists tags found in the EXIF-format maker notes of the
PhotoSmart 720 (also used by the Vivitar ViviCam 3705, 3705B and 3715).
},
0x0e00 => {
Name => 'PrintIM',
Description => 'Print Image Matching',
SubDirectory => {
TagTable => 'Image::ExifTool::PrintIM::Main',
},
},
);
# other types of HP maker notes
%Image::ExifTool::HP::Type2 = (
PROCESS_PROC => \&ProcessHP,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => 'These tags are used by the PhotoSmart E427.',
'PreviewImage' => {
Name => 'PreviewImage',
Groups => { 2 => 'Preview' },
RawConv => '$self->ValidateImage(\$val,$tag)',
},
'Serial Number' => 'SerialNumber',
'Lens Shading' => 'LensShading',
);
%Image::ExifTool::HP::Type4 = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => 'These tags are used by the PhotoSmart M627.',
0x0c => {
Name => 'MaxAperture',
Format => 'int16u',
ValueConv => '$val / 10',
},
0x10 => {
Name => 'ExposureTime',
Format => 'int32u',
ValueConv => '$val / 1e6',
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
},
0x14 => {
Name => 'CameraDateTime',
Groups => { 2 => 'Time' },
Format => 'string[20]',
},
0x34 => {
Name => 'ISO',
Format => 'int16u',
},
0x5c => {
Name => 'SerialNumber',
Format => 'string[26]',
RawConv => '$val =~ s/^SERIAL NUMBER:// ? $val : undef',
},
);
%Image::ExifTool::HP::Type6 = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => 'These tags are used by the PhotoSmart M425, M525 and M527.',
0x0c => {
Name => 'FNumber',
Format => 'int16u',
ValueConv => '$val / 10',
},
0x10 => {
Name => 'ExposureTime',
Format => 'int32u',
ValueConv => '$val / 1e6',
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
},
0x14 => {
Name => 'CameraDateTime',
Groups => { 2 => 'Time' },
Format => 'string[20]',
},
0x34 => {
Name => 'ISO',
Format => 'int16u',
},
0x58 => {
Name => 'SerialNumber',
Format => 'string[26]',
RawConv => '$val =~ s/^SERIAL NUMBER:// ? $val : undef',
},
);
# proprietary format TDHD data written by Photosmart R837 (ref PH)
%Image::ExifTool::HP::TDHD = (
PROCESS_PROC => \&ProcessTDHD,
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
NOTES => q{
These tags are extracted from the APP6 "TDHD" segment of Photosmart R837
JPEG images. Many other unknown tags exist in is data, and can be seen with
the Unknown (-u) option.
},
# (all subdirectories except TDHD and LSLV are automatically recognized
# by their "type" word of 0x10001)
TDHD => {
Name => 'TDHD',
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
},
LSLV => {
Name => 'LSLV',
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
},
FWRV => 'FirmwareVersion',
CMSN => 'SerialNumber', # (unverified)
# LTEM - some temperature?
);
#------------------------------------------------------------------------------
# Process HP APP6 TDHD metadata (ref PH)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessTDHD($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $pos = $$dirInfo{DirStart};
my $dirEnd = $pos + $$dirInfo{DirLen};
my $unknown = $et->Options('Unknown') || $et->Options('Verbose');
$et->VerboseDir('TDHD', undef, $$dirInfo{DirLen});
SetByteOrder('II');
while ($pos + 12 < $dirEnd) {
my $tag = substr($$dataPt, $pos, 4);
my $type = Get32u($dataPt, $pos + 4);
my $size = Get32u($dataPt, $pos + 8);
$pos += 12;
last if $size < 0 or $pos + $size > $dirEnd;
if ($type == 0x10001) {
# this is a subdirectory containing more tags
my %dirInfo = (
DataPt => $dataPt,
DataPos => $dataPos,
DirStart => $pos,
DirLen => $size,
);
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
} else {
if (not $$tagTablePtr{$tag} and $unknown) {
my $name = $tag;
$name =~ tr/-_A-Za-z0-9//dc; # remove invalid characters
my %tagInfo = (
Name => "HP_TDHD_$name",
Unknown => 1,
);
# guess format based on data size
if ($size == 1) {
$tagInfo{Format} = 'int8u';
} elsif ($size == 2) {
$tagInfo{Format} = 'int16u';
} elsif ($size == 4) {
$tagInfo{Format} = 'int32s';
} elsif ($size > 80) {
$tagInfo{Binary} = 1;
}
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
}
$et->HandleTag($tagTablePtr, $tag, undef,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $pos,
Size => $size,
);
}
$pos += $size;
}
return 1;
}
#------------------------------------------------------------------------------
# Process HP maker notes
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success, otherwise returns 0 and sets a Warning
sub ProcessHP($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataLen = $$dirInfo{DataLen};
my $dirStart = $$dirInfo{DirStart} || 0;
my $dirLen = $$dirInfo{DirLen} || $dataLen - $dirStart;
# look for known text-type tags
if ($dirStart or $dirLen != length($$dataPt)) {
my $buff = substr($$dataPt, $dirStart, $dirLen);
$dataPt = \$buff;
}
my $tagID;
# brute-force scan for PreviewImage
if ($$tagTablePtr{PreviewImage} and $$dataPt =~ /(\xff\xd8\xff\xdb.*\xff\xd9)/gs) {
$et->HandleTag($tagTablePtr, 'PreviewImage', $1);
# truncate preview to speed subsequent tag scans
my $buff = substr($$dataPt, 0, pos($$dataPt)-length($1));
$dataPt = \$buff;
}
# scan for other tag ID's
foreach $tagID (sort(TagTableKeys($tagTablePtr))) {
next if $tagID eq 'PreviewImage';
next unless $$dataPt =~ /$tagID:\s*([\x20-\x7f]+)/i;
$et->HandleTag($tagTablePtr, $tagID, $1);
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::HP - Hewlett-Packard maker notes tags
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to interpret
Hewlett-Packard maker notes.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/HP Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,576 @@
#------------------------------------------------------------------------------
# File: HTML.pm
#
# Description: Read HTML meta information
#
# Revisions: 01/30/2007 - P. Harvey Created
#
# References: 1) http://www.w3.org/TR/html4/
# 2) http://www.daisy.org/publications/specifications/daisy_202.html
# 3) http://vancouver-webpages.com/META/metatags.detail.html
# 4) http://www.html-reference.com/META.htm
#------------------------------------------------------------------------------
package Image::ExifTool::HTML;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::PostScript;
use Image::ExifTool::XMP qw(EscapeXML UnescapeXML);
require Exporter;
$VERSION = '1.15';
@ISA = qw(Exporter);
@EXPORT_OK = qw(EscapeHTML UnescapeHTML);
sub SetHTMLCharset($$);
# convert HTML charset (lower case) to ExifTool Charset name
my %htmlCharset = (
macintosh => 'MacRoman',
'iso-8859-1' => 'Latin',
'utf-8' => 'UTF8',
'windows-1252' => 'Latin',
);
# HTML 4 character entity references
my %entityNum = (
'quot' => 34, 'eth' => 240, 'lsquo' => 8216,
'amp' => 38, 'ntilde' => 241, 'rsquo' => 8217,
'apos' => 39, 'ograve' => 242, 'sbquo' => 8218,
'lt' => 60, 'oacute' => 243, 'ldquo' => 8220,
'gt' => 62, 'ocirc' => 244, 'rdquo' => 8221,
'nbsp' => 160, 'otilde' => 245, 'bdquo' => 8222,
'iexcl' => 161, 'ouml' => 246, 'dagger' => 8224,
'cent' => 162, 'divide' => 247, 'Dagger' => 8225,
'pound' => 163, 'oslash' => 248, 'bull' => 8226,
'curren' => 164, 'ugrave' => 249, 'hellip' => 8230,
'yen' => 165, 'uacute' => 250, 'permil' => 8240,
'brvbar' => 166, 'ucirc' => 251, 'prime' => 8242,
'sect' => 167, 'uuml' => 252, 'Prime' => 8243,
'uml' => 168, 'yacute' => 253, 'lsaquo' => 8249,
'copy' => 169, 'thorn' => 254, 'rsaquo' => 8250,
'ordf' => 170, 'yuml' => 255, 'oline' => 8254,
'laquo' => 171, 'OElig' => 338, 'frasl' => 8260,
'not' => 172, 'oelig' => 339, 'euro' => 8364,
'shy' => 173, 'Scaron' => 352, 'image' => 8465,
'reg' => 174, 'scaron' => 353, 'weierp' => 8472,
'macr' => 175, 'Yuml' => 376, 'real' => 8476,
'deg' => 176, 'fnof' => 402, 'trade' => 8482,
'plusmn' => 177, 'circ' => 710, 'alefsym'=> 8501,
'sup2' => 178, 'tilde' => 732, 'larr' => 8592,
'sup3' => 179, 'Alpha' => 913, 'uarr' => 8593,
'acute' => 180, 'Beta' => 914, 'rarr' => 8594,
'micro' => 181, 'Gamma' => 915, 'darr' => 8595,
'para' => 182, 'Delta' => 916, 'harr' => 8596,
'middot' => 183, 'Epsilon'=> 917, 'crarr' => 8629,
'cedil' => 184, 'Zeta' => 918, 'lArr' => 8656,
'sup1' => 185, 'Eta' => 919, 'uArr' => 8657,
'ordm' => 186, 'Theta' => 920, 'rArr' => 8658,
'raquo' => 187, 'Iota' => 921, 'dArr' => 8659,
'frac14' => 188, 'Kappa' => 922, 'hArr' => 8660,
'frac12' => 189, 'Lambda' => 923, 'forall' => 8704,
'frac34' => 190, 'Mu' => 924, 'part' => 8706,
'iquest' => 191, 'Nu' => 925, 'exist' => 8707,
'Agrave' => 192, 'Xi' => 926, 'empty' => 8709,
'Aacute' => 193, 'Omicron'=> 927, 'nabla' => 8711,
'Acirc' => 194, 'Pi' => 928, 'isin' => 8712,
'Atilde' => 195, 'Rho' => 929, 'notin' => 8713,
'Auml' => 196, 'Sigma' => 931, 'ni' => 8715,
'Aring' => 197, 'Tau' => 932, 'prod' => 8719,
'AElig' => 198, 'Upsilon'=> 933, 'sum' => 8721,
'Ccedil' => 199, 'Phi' => 934, 'minus' => 8722,
'Egrave' => 200, 'Chi' => 935, 'lowast' => 8727,
'Eacute' => 201, 'Psi' => 936, 'radic' => 8730,
'Ecirc' => 202, 'Omega' => 937, 'prop' => 8733,
'Euml' => 203, 'alpha' => 945, 'infin' => 8734,
'Igrave' => 204, 'beta' => 946, 'ang' => 8736,
'Iacute' => 205, 'gamma' => 947, 'and' => 8743,
'Icirc' => 206, 'delta' => 948, 'or' => 8744,
'Iuml' => 207, 'epsilon'=> 949, 'cap' => 8745,
'ETH' => 208, 'zeta' => 950, 'cup' => 8746,
'Ntilde' => 209, 'eta' => 951, 'int' => 8747,
'Ograve' => 210, 'theta' => 952, 'there4' => 8756,
'Oacute' => 211, 'iota' => 953, 'sim' => 8764,
'Ocirc' => 212, 'kappa' => 954, 'cong' => 8773,
'Otilde' => 213, 'lambda' => 955, 'asymp' => 8776,
'Ouml' => 214, 'mu' => 956, 'ne' => 8800,
'times' => 215, 'nu' => 957, 'equiv' => 8801,
'Oslash' => 216, 'xi' => 958, 'le' => 8804,
'Ugrave' => 217, 'omicron'=> 959, 'ge' => 8805,
'Uacute' => 218, 'pi' => 960, 'sub' => 8834,
'Ucirc' => 219, 'rho' => 961, 'sup' => 8835,
'Uuml' => 220, 'sigmaf' => 962, 'nsub' => 8836,
'Yacute' => 221, 'sigma' => 963, 'sube' => 8838,
'THORN' => 222, 'tau' => 964, 'supe' => 8839,
'szlig' => 223, 'upsilon'=> 965, 'oplus' => 8853,
'agrave' => 224, 'phi' => 966, 'otimes' => 8855,
'aacute' => 225, 'chi' => 967, 'perp' => 8869,
'acirc' => 226, 'psi' => 968, 'sdot' => 8901,
'atilde' => 227, 'omega' => 969, 'lceil' => 8968,
'auml' => 228, 'thetasym'=>977, 'rceil' => 8969,
'aring' => 229, 'upsih' => 978, 'lfloor' => 8970,
'aelig' => 230, 'piv' => 982, 'rfloor' => 8971,
'ccedil' => 231, 'ensp' => 8194, 'lang' => 9001,
'egrave' => 232, 'emsp' => 8195, 'rang' => 9002,
'eacute' => 233, 'thinsp' => 8201, 'loz' => 9674,
'ecirc' => 234, 'zwnj' => 8204, 'spades' => 9824,
'euml' => 235, 'zwj' => 8205, 'clubs' => 9827,
'igrave' => 236, 'lrm' => 8206, 'hearts' => 9829,
'iacute' => 237, 'rlm' => 8207, 'diams' => 9830,
'icirc' => 238, 'ndash' => 8211,
'iuml' => 239, 'mdash' => 8212,
);
my %entityName; # look up entity names by number (built as necessary)
# HTML info
# (tag ID's are case insensitive and must be all lower case in tables)
%Image::ExifTool::HTML::Main = (
GROUPS => { 2 => 'Document' },
NOTES => q{
Meta information extracted from the header of HTML and XHTML files. This is
a mix of information found in the C<META> elements, C<XML> element, and the
C<TITLE> element.
},
dc => {
Name => 'DC',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::dc' },
},
ncc => {
Name => 'NCC',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::ncc' },
},
prod => {
Name => 'Prod',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::prod' },
},
vw96 => {
Name => 'VW96',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::vw96' },
},
'http-equiv' => {
Name => 'HTTP-equiv',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::equiv' },
},
o => {
Name => 'Office',
SubDirectory => { TagTable => 'Image::ExifTool::HTML::Office' },
},
abstract => { },
author => { },
classification => { },
'content-language'=>{ Name => 'ContentLanguage' },
copyright => { },
description => { },
distribution => { },
'doc-class' => { Name => 'DocClass' },
'doc-rights' => { Name => 'DocRights' },
'doc-type' => { Name => 'DocType' },
formatter => { },
generator => { },
generatorversion=> { Name => 'GeneratorVersion' },
googlebot => { Name => 'GoogleBot' },
keywords => { List => 1 },
mssmarttagspreventparsing => { Name => 'NoMSSmartTags' },
originator => { },
owner => { },
progid => { Name => 'ProgID' },
rating => { },
refresh => { },
'resource-type' => { Name => 'ResourceType' },
'revisit-after' => { Name => 'RevisitAfter' },
robots => { List => 1 },
title => { Notes => "the only extracted tag which isn't from an HTML META element" },
);
# ref 2
%Image::ExifTool::HTML::dc = (
GROUPS => { 1 => 'HTML-dc', 2 => 'Document' },
NOTES => 'Dublin Core schema tags (also used in XMP).',
contributor => { Groups => { 2 => 'Author' }, List => 'Bag' },
coverage => { },
creator => { Groups => { 2 => 'Author' }, List => 'Seq' },
date => {
Groups => { 2 => 'Time' },
List => 'Seq',
PrintConv => '$self->ConvertDateTime($val)',
},
description => { },
'format' => { },
identifier => { },
language => { List => 'Bag' },
publisher => { Groups => { 2 => 'Author' }, List => 'Bag' },
relation => { List => 'Bag' },
rights => { Groups => { 2 => 'Author' } },
source => { Groups => { 2 => 'Author' } },
subject => { List => 'Bag' },
title => { },
type => { List => 'Bag' },
);
# ref 2
%Image::ExifTool::HTML::ncc = (
GROUPS => { 1 => 'HTML-ncc', 2 => 'Document' },
charset => { Name => 'CharacterSet' }, # name changed to avoid conflict with -charset option
depth => { },
files => { },
footnotes => { },
generator => { },
kbytesize => { Name => 'KByteSize' },
maxpagenormal => { Name => 'MaxPageNormal' },
multimediatype => { Name => 'MultimediaType' },
narrator => { },
pagefront => { Name => 'PageFront' },
pagenormal => { Name => 'PageNormal' },
pagespecial => { Name => 'PageSpecial' },
prodnotes => { Name => 'ProdNotes' },
producer => { },
produceddate => { Name => 'ProducedDate', Groups => { 2 => 'Time' } }, # YYYY-mm-dd
revision => { },
revisiondate => { Name => 'RevisionDate', Groups => { 2 => 'Time' } },
setinfo => { Name => 'SetInfo' },
sidebars => { },
sourcedate => { Name => 'SourceDate', Groups => { 2 => 'Time' } },
sourceedition => { Name => 'SourceEdition' },
sourcepublisher => { Name => 'SourcePublisher' },
sourcerights => { Name => 'SourceRights' },
sourcetitle => { Name => 'SourceTitle' },
tocitems => { Name => 'TOCItems' },
totaltime => { Name => 'Duration' }, # HH:MM:SS
);
# ref 3
%Image::ExifTool::HTML::vw96 = (
GROUPS => { 1 => 'HTML-vw96', 2 => 'Document' },
objecttype => { Name => 'ObjectType' },
);
# ref 2
%Image::ExifTool::HTML::prod = (
GROUPS => { 1 => 'HTML-prod', 2 => 'Document' },
reclocation => { Name => 'RecLocation' },
recengineer => { Name => 'RecEngineer' },
);
# ref 3/4
%Image::ExifTool::HTML::equiv = (
GROUPS => { 1 => 'HTTP-equiv', 2 => 'Document' },
NOTES => 'These tags have a family 1 group name of "HTTP-equiv".',
'cache-control' => { Name => 'CacheControl' },
'content-disposition' => { Name => 'ContentDisposition' },
'content-language' => { Name => 'ContentLanguage' },
'content-script-type' => { Name => 'ContentScriptType' },
'content-style-type' => { Name => 'ContentStyleType' },
# note: setting the HTMLCharset like this will miss any tags which come earlier
'content-type' => { Name => 'ContentType', RawConv => \&SetHTMLCharset },
'default-style' => { Name => 'DefaultStyle' },
expires => { },
'ext-cache' => { Name => 'ExtCache' },
imagetoolbar => { Name => 'ImageToolbar' },
lotus => { },
'page-enter' => { Name => 'PageEnter' },
'page-exit' => { Name => 'PageExit' },
'pics-label' => { Name => 'PicsLabel' },
pragma => { },
refresh => { },
'reply-to' => { Name => 'ReplyTo' },
'set-cookie' => { Name => 'SetCookie' },
'site-enter' => { Name => 'SiteEnter' },
'site-exit' => { Name => 'SiteExit' },
vary => { },
'window-target' => { Name => 'WindowTarget' },
);
# MS Office namespace (ref PH)
%Image::ExifTool::HTML::Office = (
GROUPS => { 1 => 'HTML-office', 2 => 'Document' },
NOTES => 'Tags written by Microsoft Office applications.',
Subject => { },
Author => { Groups => { 2 => 'Author' } },
Keywords => { },
Description => { },
Template => { },
LastAuthor => { Groups => { 2 => 'Author' } },
Revision => { Name => 'RevisionNumber' },
TotalTime => { Name => 'TotalEditTime', PrintConv => 'ConvertTimeSpan($val, 60)' },
Created => {
Name => 'CreateDate',
Groups => { 2 => 'Time' },
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
LastSaved => {
Name => 'ModifyDate',
Groups => { 2 => 'Time' },
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
LastSaved => {
Name => 'ModifyDate',
Groups => { 2 => 'Time' },
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
LastPrinted => {
Name => 'LastPrinted',
Groups => { 2 => 'Time' },
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
PrintConv => '$self->ConvertDateTime($val)',
},
Pages => { },
Words => { },
Characters => { },
Category => { },
Manager => { },
Company => { },
Lines => { },
Paragraphs => { },
CharactersWithSpaces => { },
Version => { Name => 'RevisionNumber' },
);
#------------------------------------------------------------------------------
# Set HTMLCharset member based on content type
# Inputs: 0) content type string, 1) ExifTool ref
# Returns: original string
sub SetHTMLCharset($$)
{
my ($val, $et) = @_;
$$et{HTMLCharset} = $htmlCharset{lc $1} if $val =~ /charset=['"]?([-\w]+)/;
return $val;
}
#------------------------------------------------------------------------------
# Convert single UTF-8 character to HTML character reference
# Inputs: 0) UTF-8 character sequence
# Returns: HTML character reference (eg. "&quot;");
# Note: Must be called via EscapeHTML to load name lookup
sub EscapeChar($)
{
my $ch = shift;
my $val;
if ($] < 5.006001) {
($val) = Image::ExifTool::UnpackUTF8($ch);
} else {
# the meaning of "U0" is reversed as of Perl 5.10.0!
($val) = unpack($] < 5.010000 ? 'U0U' : 'C0U', $ch);
}
return '?' unless defined $val;
return "&$entityName{$val};" if $entityName{$val};
return sprintf('&#x%x;',$val);
}
#------------------------------------------------------------------------------
# Escape any special characters for HTML
# Inputs: 0) UTF-8 string to be escaped
# Returns: escaped string
sub EscapeHTML($)
{
my $str = shift;
# escape XML characters
$str = EscapeXML($str);
# escape other special characters if they exist
if ($str =~ /[\x80-\xff]/) {
# generate entity name lookup if necessary
unless (%entityName) {
local $_;
foreach (keys %entityNum) {
$entityName{$entityNum{$_}} = $_;
}
delete $entityName{39}; # 'apos' is not valid HTML
}
# suppress warnings
local $SIG{'__WARN__'} = sub { 1 };
# escape any non-ascii characters for HTML
$str =~ s/([\xc2-\xf7][\x80-\xbf]+)/EscapeChar($1)/sge;
}
return $str;
}
#------------------------------------------------------------------------------
# Unescape all HTML character references
# Inputs: 0) string to be unescaped
# Returns: unescaped string
sub UnescapeHTML($)
{
return UnescapeXML(shift, \%entityNum);
}
#------------------------------------------------------------------------------
# Extract information from a HTML file
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid HTML file
sub ProcessHTML($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $buff;
# validate HTML or XHTML file
$raf->Read($buff, 256) or return 0;
$buff =~ /^(\xef\xbb\xbf)?\s*<(!DOCTYPE\s+HTML|HTML|\?xml)/i or return 0;
$buff =~ /<(!DOCTYPE\s+)?HTML/i or return 0 if $2 eq '?xml';
$et->SetFileType();
$raf->Seek(0,0) or $et->Warn('Seek error'), return 1;
local $/ = Image::ExifTool::PostScript::GetInputRecordSeparator($raf);
$/ or $et->Warn('Invalid HTML data'), return 1;
# extract header information
my $doc;
while ($raf->ReadLine($buff)) {
if (not defined $doc) {
# look for 'head' element
next unless $buff =~ /<head\b/ig;
$doc = substr($buff, pos($buff));
next;
}
$doc .= $buff;
last if $buff =~ m{</head>}i;
}
return 1 unless defined $doc;
# process all elements in header
my $tagTablePtr = GetTagTable('Image::ExifTool::HTML::Main');
for (;;) {
last unless $doc =~ m{<([\w:.-]+)(.*?)>}sg;
my ($tagName, $attrs) = ($1, $2);
my $tag = lc($tagName);
my ($val, $grp);
if ($attrs =~ m{/$}) { # self-contained XHTML tags end in '/>'
$val = '';
} else {
# look for element close
my $pos = pos($doc);
my $close = "</$tagName>";
# the following doesn't work on Solaris Perl 5.6.1 due to Perl bug:
# if ($doc =~ m{(.*?)</$tagName>}sg) {
# $val = $1;
if ($doc =~ m{$close}sg) {
$val = substr($doc, $pos, pos($doc)-$pos-length($close));
} else {
pos($doc) = $pos;
next unless $tag eq 'meta'; # META tags don't need to be closed
$val = '';
}
}
my $table = $tagTablePtr;
if ($tag eq 'meta') {
# parse HTML META element
undef $tag;
# tag name is in NAME or HTTP-EQUIV attribute
if ($attrs =~ /\bname\s*=\s*['"]?([\w:.-]+)/si) {
$tagName = $1;
} elsif ($attrs =~ /\bhttp-equiv\s*=\s*['"]?([\w:.-]+)/si) {
$tagName = "HTTP-equiv.$1";
} else {
next; # no name
}
$tag = lc($tagName) or next;
# tag value is in CONTENT attribute
if ($attrs =~ /\bcontent\s*=\s*(['"])(.*?)\1/si or
$attrs =~ /\bcontent\s*=\s*(['"]?)([\w:.-]+)/si)
{
$val = $2;
} else {
next unless length $val;
}
# isolate group name (separator is '.' in HTML, but ':' in ref 2)
if ($tag =~ /^([\w-]+)[:.]([\w-]+)/) {
($grp, $tag) = ($1, $2);
my $tagInfo = $et->GetTagInfo($tagTablePtr, $grp);
if ($tagInfo and $$tagInfo{SubDirectory}) {
$table = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
} else {
$tag = "$grp.$tag";
}
}
} elsif ($tag eq 'xml') {
$et->VPrint(0, "Parsing XML\n");
# parse XML tags (quick-and-dirty)
my $xml = $val;
while ($xml =~ /<([\w-]+):([\w-]+)(\s.*?)?>([^<]*?)<\/\1:\2>/g) {
($grp, $tag, $val) = ($1, $2, $4);
my $tagInfo = $et->GetTagInfo($tagTablePtr, $grp);
next unless $tagInfo and $$tagInfo{SubDirectory};
$table = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
unless ($$table{$tag}) {
my $name = ucfirst $tag;
$name =~ s/_x([0-9a-f]{4})_/chr(hex($1))/gie; # convert hex codes
$name =~ s/\s(.)/\U$1/g; # capitalize all words in tag name
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters (also hex code wide chars)
AddTagToTable($table, $tag, { Name => $name });
$et->VPrint(0, " [adding $tag '${name}']\n");
}
$val = $et->Decode($val, $$et{HTMLCharset}) if $$et{HTMLCharset};
$et->HandleTag($table, $tag, UnescapeXML($val));
}
next;
} else {
# the only other element we process is TITLE
next unless $tag eq 'title';
}
unless ($$table{$tag}) {
my $name = $tagName;
$name =~ s/\W+(\w)/\u$1/sg;
my $info = { Name => $name, Groups => { 0 => 'HTML' } };
$info->{Groups}->{1} = ($grp eq 'http-equiv' ? 'HTTP-equiv' : "HTML-$grp") if $grp;
AddTagToTable($table, $tag, $info);
$et->VPrint(0, " [adding $tag '${tagName}']\n");
}
# recode if necessary
$val = $et->Decode($val, $$et{HTMLCharset}) if $$et{HTMLCharset};
$val =~ s{\s*$/\s*}{ }sg; # replace linefeeds and indenting spaces
$val = UnescapeHTML($val); # unescape HTML character references
$et->HandleTag($table, $tag, $val);
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::HTML - Read HTML meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to extract
meta information from HTML documents.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.w3.org/TR/html4/>
=item L<http://www.daisy.org/publications/specifications/daisy_202.html>
=item L<http://vancouver-webpages.com/META/metatags.detail.html>
=item L<http://www.html-reference.com/META.htm>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/HTML Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,898 @@
#------------------------------------------------------------------------------
# File: HtmlDump.pm
#
# Description: Dump information in hex to HTML page
#
# Revisions: 12/05/2005 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::HtmlDump;
use strict;
use vars qw($VERSION);
use Image::ExifTool; # only for FinishTiffDump()
use Image::ExifTool::HTML qw(EscapeHTML);
$VERSION = '1.34';
sub DumpTable($$$;$$$$$);
sub Open($$$;@);
sub Write($@);
my ($bkgStart, $bkgEnd, @bkgSpan);
my $htmlHeader1 = <<_END_PART_1_;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
"http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
<html>
<head>
<title>
_END_PART_1_
# Note: Don't change font-weight style because it can affect line height
my $htmlHeader2 = <<_END_PART_2_;
</title>
<style type="text/css">
<!--
/* character style ID's */
.D { color: #000000 } /* default color */
.V { color: #ff0000 } /* duplicate block 1 */
.W { color: #004400 } /* normal block 1 */
.X { color: #ff4488 } /* duplicate block 2 */
.Y { color: #448844 } /* normal block 2 */
.U { color: #cc8844 } /* unused data block */
.H { color: #0000ff } /* highlighted tag name */
.F { color: #aa00dd } /* actual offset differs */
.M { text-decoration: underline } /* maker notes data */
.tt { /* tooltip text */
visibility: hidden;
position: absolute;
white-space: nowrap;
top: 0;
left: 0;
font-family: Verdana, sans-serif;
font-size: .7em;
padding: 2px 4px;
border: 1px solid gray;
z-index: 3;
}
.tb { /* tooltip background */
visibility: hidden;
position: absolute;
background: #ffffdd;
zoom: 1;
-moz-opacity: 0.8;
-khtml-opacity: 0.8;
-ms-filter: 'progid:DXImageTransform.Microsoft.Alpha(Opacity=80)';
filter: alpha(opacity=80);
opacity: 0.8;
z-index: 2;
}
/* table styles */
table.dump {
border-top: 1px solid gray;
border-bottom: 1px solid gray;
}
table.dump td { padding: .2em .3em }
td.c2 {
border-left: 1px solid gray;
border-right: 1px solid gray;
}
pre { margin: 0 }
table { font-size: .9em }
body { color: black; background: white }
-->
</style>
<script language="JavaScript" type="text/JavaScript">
<!-- Begin
// tooltip positioning constants
var TMAR = 4; // top/left margins
var BMAR = 16; // bottom/right margins (scrollbars may overhang inner dimensions)
var XOFF = 10; // x offset from cursor
var YOFF = 40; // y offset
var YMIN = 10; // minimum y offset
var YTOP = 20; // y offset when above cursor
// common variables
var safari1 = navigator.userAgent.indexOf("Safari/312.6") >= 0;
var ie6 = navigator.userAgent.toLowerCase().indexOf('msie 6') >= 0;
var mspan = new Array;
var hlist, tt, tb;
function GetElementsByClass(classname, tagname) {
var found = new Array();
var list = document.getElementsByTagName(tagname);
var len = list.length;
for (var i=0, j=0; i<len; ++i) {
var classes = list[i].className.split(' ');
for (var k=0; k<classes.length; ++k) {
if (classes[k] == classname) {
found[j++] = list[i];
break;
}
}
}
delete list;
return found;
}
// move tooltip
function move(e)
{
if (!tt) return;
if (ie6 && (tt.style.top == '' || tt.style.top == 0) &&
(tt.style.left == '' || tt.style.left == 0))
{
tt.style.width = tt.offsetWidth + 'px';
tt.style.height = tt.offsetHeight + 'px';
}
var w, h;
// browser inconsistencies make getting window size more complex than it should be,
// and even then we don't know if it is smaller due to scrollbar width
if (typeof(window.innerWidth) == 'number') {
w = window.innerWidth;
h = window.innerHeight;
} else if (document.documentElement && document.documentElement.clientWidth) {
w = document.documentElement.clientWidth;
h = document.documentElement.clientHeight;
} else {
w = document.body.clientWidth;
h = document.body.clientHeight;
}
var x = e.clientX + XOFF;
var y = e.clientY + YOFF;
if (safari1) { // patch for people still using OS X 10.3.9
x -= document.body.scrollLeft + document.documentElement.scrollLeft;
y -= document.body.scrollTop + document.documentElement.scrollTop;
}
var mx = w - BMAR - tt.offsetWidth;
var my = h - BMAR - tt.offsetHeight;
if (y > my + YOFF - YMIN) y = e.clientY - YTOP - tt.offsetHeight;
if (x > mx) x = mx;
if (y > my) y = my;
if (x < TMAR) x = TMAR;
if (y < TMAR) y = TMAR;
x += document.body.scrollLeft + document.documentElement.scrollLeft;
y += document.body.scrollTop + document.documentElement.scrollTop;
tb.style.width = tt.offsetWidth + 'px';
tb.style.height = tt.offsetHeight + 'px';
tt.style.top = tb.style.top = y + 'px';
tt.style.left = tb.style.left = x + 'px';
tt.style.visibility = tb.style.visibility = 'visible';
}
// highlight/unhighlight text
function high(e,on) {
var targ;
if (e.target) targ = e.target;
else if (e.srcElement) targ = e.srcElement;
if (targ.nodeType == 3) targ = targ.parentNode; // defeat Safari bug
if (!targ.name) targ = targ.parentNode; // go up another level if necessary
if (targ.name && document.getElementsByName) {
// un-highlight current objects
if (hlist) {
for (var i=0; i<hlist.length; ++i) {
hlist[i].style.background = 'transparent';
}
hlist = null;
}
if (tt) {
// hide old tooltip
tt.style.visibility = tb.style.visibility = 'hidden';
tt = null;
}
if (on) {
if (targ.name.substring(0,1) == 't') {
// show our tooltip (ID is different than name to avoid confusing IE)
tt = document.getElementById('p' + targ.name.substring(1));
if (tt) {
tb = document.getElementById('tb');
move(e);
}
}
// highlight anchor elements with the same name
hlist = document.getElementsByName(targ.name);
// use class name to highlight span elements if necessary
for (var i=0; i<mspan.length; ++i) {
if (mspan[i] != targ.name) continue;
var slist = GetElementsByClass(targ.name, 'span');
// add elements from hlist collection to our array
for (var j=0; j<hlist.length; ++j) {
slist[slist.length] = hlist[j];
}
hlist = slist;
break;
}
for (var j=0; j<hlist.length; ++j) {
hlist[j].style.background = '#ffcc99';
}
}
}
}
_END_PART_2_
my $htmlHeader3 = q[
// End --->
</script></head>
<body><noscript><b class=V>--&gt;
Enable JavaScript for active highlighting and information tool tips!
</b></noscript>
<table class=dump cellspacing=0 cellpadding=2>
<tr><td valign='top'><pre>];
my $preMouse = q(<pre onmouseover="high(event,1)" onmouseout="high(event,0)" onmousemove="move(event)">);
#------------------------------------------------------------------------------
# New - create new HtmlDump object
# Inputs: 0) reference to HtmlDump object or HtmlDump class name
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::HtmlDump';
return bless { Block => {}, TipNum => 0 }, $class;
}
#------------------------------------------------------------------------------
# Add information to dump
# Inputs: 0) HTML dump hash ref, 1) absolute offset in file, 2) data size,
# 3) comment string, 4) tool tip (or SAME to use previous tip),
# 5) bit flags (see below)
# Bits: 0x01 - print at start of line
# 0x02 - print red address
# 0x04 - maker notes data ('M'-class span)
# 0x08 - limit block length
# 0x10 - allow double references
# 0x100 - (reserved)
# Notes: Block will be shown in 'unused' color if comment string begins with '['
sub Add($$$$;$)
{
my ($self, $start, $size, $msg, $tip, $flag) = @_;
my $block = $$self{Block};
$$block{$start} or $$block{$start} = [ ];
my $htip;
if ($tip and $tip eq 'SAME') {
$htip = '';
} else {
# use message as first line of tip, and make bold unless in brackets
$htip = ($msg =~ /^[[(]/) ? $msg : "<b>$msg</b>";
if (defined $tip) {
($tip = EscapeHTML($tip)) =~ s/\n/<br>/g; # HTML-ize tooltip text
$htip .= '<br>' . $tip;
}
# add size if not already done
$htip .= "<br>($size bytes)" unless $htip =~ /<br>Size:/;
++$self->{TipNum};
}
push @{$$block{$start}}, [ $size, $msg, $htip, $flag, $self->{TipNum} ];
}
#------------------------------------------------------------------------------
# Print dump information to HTML page
# Inputs: 0) Dump information hash reference, 1) source file RAF reference,
# 2) data pointer, 3) data position, 4) output file or scalar reference,
# 5) limit level (1-3), 6) title
# Returns: non-zero if useful output was generated,
# or -1 on error loading data and "ERROR" is set to offending data name
# Note: The "Error" member may be set externally to print a specific error
# message instead of doing the dump.
sub Print($$;$$$$$)
{
local $_;
my ($self, $raf, $dataPt, $dataPos, $outfile, $level, $title) = @_;
my ($i, $buff, $rtnVal, $limit, $err);
my $block = $$self{Block};
$dataPos = 0 unless $dataPos;
$outfile = \*STDOUT unless ref $outfile;
$title = 'HtmlDump' unless $title;
$level or $level = 0;
my $tell = $raf->Tell();
my $pos = 0;
my $dataEnd = $dataPos + ($dataPt ? length($$dataPt) : 0);
# initialize member variables
$$self{Open} = [];
$$self{Closed} = [];
$$self{TipList} = [];
$$self{MSpanList} = [];
$$self{Cols} = [ '', '', '', '' ]; # text columns
# set dump size limits (limits are 4x smaller if bit 0x08 set in flags)
if ($level <= 1) {
$limit = 1024;
} elsif ($level <= 2) {
$limit = 16384;
} else {
$limit = 256 * 1024 * 1024; # never dump bigger than 256 MB
}
$$self{Limit} = $limit;
# pre-initialize open/closed hashes for all columns
for ($i=0; $i<4; ++$i) {
$self->{Open}->[$i] = { ID => [ ], Element => { } };
$self->{Closed}->[$i] = { ID => [ ], Element => { } };
}
$bkgStart = $bkgEnd = 0;
undef @bkgSpan;
my $index = 0; # initialize tooltip index
my (@names, $wasUnused, @starts);
# only do dump if we didn't have a serious error
@starts = sort { $a <=> $b } keys %$block unless $$self{Error};
for ($i=0; $i<=@starts; ++$i) {
my $start = $starts[$i];
my $parmList;
if (defined $start) {
$parmList = $$block{$start};
} elsif ($bkgEnd and $pos < $bkgEnd and not defined $wasUnused) {
$start = $bkgEnd; # finish last bkg block
} else {
last;
}
my $len = $start - $pos;
if ($len > 0 and not $wasUnused) {
# we have a unused bytes before this data block
--$i; # dump the data block next time around
# split unused data into 2 blocks if it spans end of a bkg block
my ($nextBkgEnd, $bkg);
if (not defined $wasUnused and $bkgEnd) {
foreach $bkg (@bkgSpan) {
next if $pos >= $$bkg{End} + $dataPos or $pos + $len <= $$bkg{End} + $dataPos;
$nextBkgEnd = $$bkg{End} unless $nextBkgEnd and $nextBkgEnd < $$bkg{End};
}
}
if ($nextBkgEnd) {
$start = $pos;
$len = $nextBkgEnd + $dataPos - $pos;
$wasUnused = 0;
} else {
$start = $pos; # dump the unused bytes now
$wasUnused = 1; # avoid re-dumping unused bytes if we get a read error
}
my $str = ($len > 1) ? "unused $len bytes" : 'pad byte';
$parmList = [ [ $len, "[$str]", undef, 0x108 ] ];
} else {
undef $wasUnused;
}
my $parms;
foreach $parms (@$parmList) {
my ($len, $msg, $tip, $flag, $tipNum) = @$parms;
next unless $len > 0;
$flag = 0 unless defined $flag;
# generate same name for all blocks indexed by this tooltip
my $name;
$name = $names[$tipNum] if defined $tipNum;
my $idx = $index;
if ($name) {
# get index from existing ID
$idx = substr($name, 1);
} else {
$name = "t$index";
$names[$tipNum] = $name if defined $tipNum;
++$index;
}
if ($flag & 0x14) {
my %bkg = (
Class => $flag & 0x04 ? "$name M" : $name,
Start => $start - $dataPos,
End => $start - $dataPos + $len,
);
push @bkgSpan, \%bkg;
$bkgStart = $bkg{Start} unless $bkgStart and $bkgStart < $bkg{Start};
$bkgEnd = $bkg{End} unless $bkgEnd and $bkgEnd > $bkg{End};
push @{$self->{MSpanList}}, $name;
next;
}
# loop until we read the value properly
my ($end, $try);
for ($try=0; $try<2; ++$try) {
$end = $start + $len;
# only load as much of the block as we are going to dump
# (read 32 more bytes than necessary just in case there
# is only one skipped line that we decide to print)
my $size = ($len > $limit + 32) ? $limit / 2 + 16 : $len;
if ($start >= $dataPos and $end <= $dataEnd) {
$buff = substr($$dataPt, $start-$dataPos, $size);
if ($len != $size) {
$buff .= substr($$dataPt, $start-$dataPos+$len-$size, $size);
}
} else {
$buff = '';
if ($raf->Seek($start, 0) and $raf->Read($buff, $size) == $size) {
# read end of block
if ($len != $size) {
my $buf2 = '';
unless ($raf->Seek($start+$len-$size, 0) and
$raf->Read($buf2, $size) == $size)
{
$err = $msg;
# reset $len to the actual length of available data
$raf->Seek(0, 2);
$len = $raf->Tell() - $start;
$tip .= "<br>Error: Only $len bytes available!" if $tip;
next;
}
$buff .= $buf2;
undef $buf2;
}
} else {
$err = $msg;
$len = length $buff;
$tip .= "<br>Error: Only $len bytes available!" if $tip;
}
}
last;
}
$tip and $self->{TipList}->[$idx] = $tip;
next unless length $buff;
# set flag to continue this line if next block is contiguous
if ($i+1 < @starts and $parms eq $$parmList[-1] and
($end == $starts[$i+1] or ($end < $starts[$i+1] and $end >= $pos)))
{
my $nextFlag = $block->{$starts[$i+1]}->[0]->[3] || 0;
$flag |= 0x100 unless $flag & 0x01 or $nextFlag & 0x01;
}
$self->DumpTable($start-$dataPos, \$buff, $msg, $name,
$flag, $len, $pos-$dataPos);
undef $buff;
$pos = $end if $pos < $end;
}
}
$self->Open('',''); # close all open elements
$raf->Seek($tell,0);
# write output HTML file
Write($outfile, $htmlHeader1, $title);
if ($self->{Cols}->[0]) {
Write($outfile, $htmlHeader2);
my $mspan = \@{$$self{MSpanList}};
for ($i=0; $i<@$mspan; ++$i) {
Write($outfile, qq(mspan[$i] = "$$mspan[$i]";\n));
}
Write($outfile, $htmlHeader3, $self->{Cols}->[0]);
Write($outfile, '</pre></td><td valign="top">',
$preMouse, $self->{Cols}->[1]);
Write($outfile, '</pre></td><td class=c2 valign="top">',
$preMouse, $self->{Cols}->[2]);
Write($outfile, '</pre></td><td valign="top">',
$preMouse, $self->{Cols}->[3]);
Write($outfile, "</pre></td></tr></table>\n<div id=tb class=tb> </div>\n");
my $tips = \@{$$self{TipList}};
for ($i=0; $i<@$tips; ++$i) {
my $tip = $$tips[$i];
Write($outfile, "<div id=p$i class=tt>$tip</div>\n") if defined $tip;
}
delete $$self{TipList};
$rtnVal = 1;
} else {
my $err = $$self{Error} || 'No EXIF or TIFF information found in image';
Write($outfile, "$title</title></head><body>\n$err\n");
$rtnVal = 0;
}
Write($outfile, "</body></html>\n");
for ($i=0; $i<4; ++$i) {
$self->{Cols}->[$i] = ''; # free memory
}
if ($err) {
$err =~ tr/()//d;
$$self{ERROR} = $err;
return -1;
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Open or close a specified html element
# Inputs: 0) HtmlDump object ref, 1) element id, 2) element string,
# 3-N) list of column numbers (empty for all columns)
# - element id may be '' to close all elements
# - element string may be '' to close element by ID (or 0 to close without reopening)
# - element id and string may both be 1 to reopen temporarily closed elements
sub Open($$$;@)
{
my ($self, $id, $element, @colNums) = @_;
# loop through specified columns
@colNums or @colNums = (0 .. $#{$self->{Open}});
my $col;
foreach $col (@colNums) {
# get information about open elements in this column
my $opHash = $self->{Open}->[$col];
my $opElem = $$opHash{Element};
if ($element) {
# next if already open
next if $$opElem{$id} and $$opElem{$id} eq $element;
} elsif ($id and not $$opElem{$id}) {
# next if already closed and nothing to reopen
next unless $element eq '' and @{$self->{Closed}->[$col]->{ID}};
}
my $opID = $$opHash{ID};
my $clHash = $self->{Closed}->[$col];
my $clID = $$clHash{ID};
my $clElem = $$clHash{Element};
# get reference to output column list (use temp list if available)
my $cols = $$self{TmpCols} || $$self{Cols};
# close everything down to this element if necessary
if ($$opElem{$id} or not $id) {
while (@$opID) {
my $tid = pop @$opID;
my $e = $$opElem{$tid};
$e =~ s/^<(\S+).*/<\/$1>/s;
$$cols[$col] .= $e;
if ($id eq $tid or not $id) {
delete $$opElem{$tid};
last if $id;
next;
}
# add this to the temporarily closed list
# (because we really didn't want to close it)
push @$clID, $tid;
$$clElem{$tid} = $$opElem{$tid};
delete $$opElem{$tid};
}
unless ($id) {
# forget all temporarily closed elements
$clID = $$clHash{ID} = [ ];
$clElem = $$clHash{Element} = { };
}
} elsif ($$clElem{$id}) {
# delete from the list of temporarily closed elements
delete $$clElem{$id};
@$clID = grep !/^$id$/, @$clID;
}
next if $element eq '0'; # 0 = don't reopen temporarily closed elements
# re-open temporarily closed elements
while (@$clID) {
my $tid = pop @$clID;
$$cols[$col] .= $$clElem{$tid};
push @$opID, $tid;
$$opElem{$tid} = $$clElem{$tid};
delete $$clElem{$tid};
}
# open specified element
if ($element and $element ne '1') {
$$cols[$col] .= $element;
push @$opID, $id;
$$opElem{$id} = $element;
}
}
}
#------------------------------------------------------------------------------
# Dump a block of data in HTML table form
# Inputs: 0) HtmlDump object ref, 1) data position, 2) block pointer,
# 3) message, 4) object name, 5) flag, 6) full block length (actual
# data may be shorter), 7) data end position
sub DumpTable($$$;$$$$$)
{
my ($self, $pos, $blockPt, $msg, $name, $flag, $len, $endPos) = @_;
$len = length $$blockPt unless defined $len;
$endPos = 0 unless $endPos;
my ($f0, $dblRef, $id);
my $skipped = 0;
if (($endPos and $pos < $endPos) or $flag & 0x02) {
# display double-reference addresses in red
$f0 = "<span class=V>";
$dblRef = 1 if $endPos and $pos < $endPos;
} else {
$f0 = '';
}
my @c = ('','','','');
$$self{TmpCols} = \@c;
if ($name) {
if ($msg and $msg =~ /^\[/) {
$id = 'U';
} else {
if ($$self{A}) {
$id = 'X';
$$self{A} = 0;
} else {
$id = 'V';
$$self{A} = 1;
}
++$id unless $dblRef;
}
$name = "<a name=$name class=$id>";
$msg and $msg = "$name$msg</a>";
} else {
$name = '';
}
# use base-relative offsets from now on
my $cols = 0;
my $p = $pos;
if ($$self{Cont}) {
$cols = $pos & 0x0f;
$c[1] .= ($cols == 8) ? ' ' : ' ';
} else {
my $addr = $pos < 0 ? sprintf("-%.4x",-$pos) : sprintf("%5.4x",$pos);
$self->Open('fgd', $f0, 0);
$self->Open('fgd', '', 3);
$c[0] .= "$addr";
$p -= $pos & 0x0f unless $flag & 0x01;
if ($p < $pos) {
$self->Open('bkg', '', 1, 2); # don't underline white space
$cols = $pos - $p;
my $n = 3 * $cols;
++$n if $cols > 7;
$c[1] .= ' ' x $n;
$c[2] .= ' ' x $cols;
$p = $pos;
}
}
# loop through each column of hex numbers
for (;;) {
my (@spanClass, @spanCont, $spanClose, $bkg);
if ($p >= $bkgStart and $p < $bkgEnd) {
foreach $bkg (@bkgSpan) {
next unless $p >= $$bkg{Start} and $p < $$bkg{End};
push @spanClass, $$bkg{Class};
if ($p + 1 == $$bkg{End}) {
$spanClose = 1;
} else {
push @spanCont, $$bkg{Class}; # this span continues
}
}
$self->Open('bkg', @spanClass ? "<span class='@spanClass'>" : '', 1, 2);
} else {
$self->Open('bkg', '', 1, 2);
}
$self->Open('a', $name, 1, 2);
my $ch = substr($$blockPt,$p-$pos-$skipped,1);
$c[1] .= sprintf("%.2x", ord($ch));
# make the character HTML-friendly
$ch =~ tr/\x00-\x1f\x7f-\xff/./;
$ch =~ s/&/&amp;/g;
$ch =~ s/>/&gt;/g;
$ch =~ s/</&lt;/g;
$c[2] .= $ch;
++$p;
++$cols;
# close necessary elements
if ($spanClose) {
my $spanCont = @spanCont ? "<span class='@spanCont'>" : '';
# close without reopening if closing anchor later
my $arg = ($p - $pos >= $len) ? 0 : $spanCont;
$self->Open('bkg', $arg, 1, 2);
}
if ($dblRef and $p >= $endPos) {
$dblRef = 0;
++$id;
$name =~ s/class=\w\b/class=$id/;
$f0 = '';
$self->Open('fgd', $f0, 0);
}
if ($p - $pos >= $len) {
$self->Open('a', '', 1, 2); # close our anchor
last;
}
if ($cols < 16) {
$c[1] .= ($cols == 8 ? ' ' : ' ');
next;
} elsif ($flag & 0x01 and $cols < $len) {
$c[1] .= ' ';
next; # put it all on one line
}
unless ($$self{Msg}) {
$c[3] .= $msg;
$msg = '';
}
$_ .= "\n" foreach @c; # add CR to all lines
$$self{Msg} = 0;
# limit data length if specified
if ($$self{Limit}) {
my $div = ($flag & 0x08) ? 4 : 1;
my $lim = $$self{Limit} / (2 * $div) - 16;
if ($p - $pos > $lim and $len - $p + $pos > $lim) {
my $n = ($len - $p + $pos - $lim) & ~0x0f;
if ($n > 16) { # (no use just cutting out one line)
$self->Open('bkg', '', 1, 2); # no underline
my $note = sprintf "[snip %d lines]", $n / 16;
$note = (' ' x (24-length($note)/2)) . $note;
$c[0] .= " ...\n";
$c[1] .= $note . (' ' x (48-length($note))) . "\n";
$c[2] .= " [snip] \n";
$c[3] .= "\n";
$p += $n;
$skipped += $len - length $$blockPt;
}
}
}
$c[0] .= ($p < 0 ? sprintf("-%.4x",-$p) : sprintf("%5.4x",$p));
$cols = 0;
}
if ($msg) {
$msg = " $msg" if $$self{Msg};
$c[3] .= $msg;
}
if ($flag & 0x100 and $cols < 16) { # continue on same line?
$$self{Cont} = 1;
$$self{Msg} = 1 if $msg;
} else {
$_ .= "\n" foreach @c;
$$self{Msg} = 0;
$$self{Cont} = 0;
}
# add temporary column data to our real columns
my $i;
for ($i=0; $i<4; ++$i) {
$self->{Cols}->[$i] .= $c[$i];
}
delete $$self{TmpCols};
}
#------------------------------------------------------------------------------
# Finish dumping of TIFF image data
# Inputs: 0) HtmlDump object ref, 1) ExifTool object ref, 2) length of file
# (this really belongs in Image::ExifTool::Exif, but is placed here so it
# is only compiled when needed)
sub FinishTiffDump($$$)
{
my ($self, $et, $size) = @_;
my ($tag, $key, $start, $blockInfo, $i);
# list of all indirectly referenced TIFF data tags
my %offsetPair = (
StripOffsets => 'StripByteCounts',
TileOffsets => 'TileByteCounts',
FreeOffsets => 'FreeByteCounts',
ThumbnailOffset => 'ThumbnailLength',
PreviewImageStart => 'PreviewImageLength',
JpgFromRawStart => 'JpgFromRawLength',
OtherImageStart => 'OtherImageLength',
ImageOffset => 'ImageByteCount',
AlphaOffset => 'AlphaByteCount',
MPImageStart => 'MPImageLength',
IDCPreviewStart => 'IDCPreviewLength',
SamsungRawPointersOffset => 'SamsungRawPointersLength',
);
# add TIFF data to html dump
foreach $tag (keys %offsetPair) {
my $info = $et->GetInfo($tag);
next unless %$info;
# Panasonic hack: StripOffsets is not valid for Panasonic RW2 files,
# and StripRowBytes is not valid for some RAW images
if ($tag eq 'StripOffsets' and $$et{TAG_INFO}{$tag}{PanasonicHack}) {
# use RawDataOffset instead if available since it is valid in RW2
my $info2 = $et->GetInfo('RawDataOffset');
$info2 = $info unless %$info2;
my @keys = keys %$info2;
my $offset = $$info2{$keys[0]};
my $raf = $$et{RAF};
# ignore StripByteCounts and assume raw data runs to the end of file
if (@keys == 1 and $offset =~ /^\d+$/ and $raf) {
my $pos = $raf->Tell();
$raf->Seek(0, 2); # seek to end
my $len = $raf->Tell() - $offset;
$raf->Seek($pos, 0);
if ($len > 0) {
$self->Add($offset, $len, "(Panasonic raw data)", "Size: $len bytes", 0x08);
next;
}
}
}
# loop through all offsets tags
foreach $key (keys %$info) {
my $name = Image::ExifTool::GetTagName($key);
my $grp1 = $et->GetGroup($key, 1);
my $info2 = $et->GetInfo($offsetPair{$tag}, { Group1 => $grp1 });
my $key2 = $offsetPair{$tag};
$key2 .= $1 if $key =~ /( .*)/; # use same instance number as $tag
next unless $$info2{$key2};
my $offsets = $$info{$key};
my $byteCounts = $$info2{$key2};
# ignore primary MPImage (this is the whole JPEG)
next if $tag eq 'MPImageStart' and $offsets eq '0';
# (long lists may be SCALAR references)
my @offsets = split ' ', (ref $offsets ? $$offsets : $offsets);
my @byteCounts = split ' ', (ref $byteCounts ? $$byteCounts : $byteCounts);
my $num = scalar @offsets;
my $li = 0;
my $padBytes = 0;
for ($i=0; @offsets and @byteCounts; ++$i) {
my $offset = shift @offsets;
my $byteCount = shift @byteCounts;
my $end = $offset + $byteCount;
if (@offsets and @byteCounts) {
# show data as contiguous if only normal pad bytes between blocks
if ($end & 0x01 and $end + 1 == $offsets[0]) {
$end += 1;
++$padBytes; # count them
}
if ($end == $offsets[0]) {
# combine these two blocks
$byteCounts[0] += $offsets[0] - $offset;
$offsets[0] = $offset;
next;
}
}
my $msg = $et->GetGroup($key, 1) . ':' . $tag;
$msg =~ s/(Offsets?|Start)$/ /;
if ($num > 1) {
$msg .= "$li-" if $li != $i;
$msg .= "$i ";
$li = $i + 1;
}
$msg .= "data";
my $tip = "Size: $byteCount bytes";
$tip .= ", incl. $padBytes pad bytes" if $padBytes;
$self->Add($offset, $byteCount, "($msg)", $tip, 0x08);
}
}
}
# find offset of last dumped information, and dump any unknown trailer
my $last = 0;
my $block = $$self{Block};
foreach $start (keys %$block) {
foreach $blockInfo (@{$$block{$start}}) {
my $end = $start + $$blockInfo[0];
$last = $end if $last < $end;
}
}
my $diff = $size - $last;
if ($diff > 0 and ($last or $et->Options('Unknown'))) {
if ($diff > 1 or $size & 0x01) {
$self->Add($last, $diff, "[unknown data]", "Size: $diff bytes", 0x08);
} else {
$self->Add($last, $diff, "[trailing pad byte]", undef, 0x08);
}
}
}
#------------------------------------------------------------------------------
# utility routine to write to file or memory
# Inputs: 0) file or scalar reference, 1-N) list of stuff to write
# Returns: true on success
sub Write($@)
{
my $outfile = shift;
if (UNIVERSAL::isa($outfile,'GLOB')) {
return print $outfile @_;
} elsif (ref $outfile eq 'SCALAR') {
$$outfile .= join('', @_);
return 1;
}
return 0;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::HtmlDump - Dump information in hex to HTML page
=head1 SYNOPSIS
use Image::ExifTool::HtmlDump;
my $dump = new Image::ExifTool::HtmlDump;
$dump->Add($start, $size, $comment);
$dump->Print($dumpInfo, $raf, $dataPt, $dataPos, $outfile);
=head1 DESCRIPTION
This module contains code used to generate an HTML-based hex dump of
information for debugging purposes. This is code is called when the
ExifTool 'HtmlDump' option is used.
Currently, only EXIF/TIFF and JPEG information is dumped.
=head1 BUGS
Due to a memory allocation bug in ActivePerl 5.8.x for Windows, this code
may run extremely slowly when processing large files with this version of
Perl.
An HTML 4 compliant browser is needed to properly display the generated HTML
page.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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(3pm)|Image::ExifTool>
=cut

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,206 @@
#------------------------------------------------------------------------------
# File: ISO.pm
#
# Description: Read information from ISO 9660 disk images
#
# Revisions: 2016-04-07 - P. Harvey created
#
# References: 1) http://wiki.osdev.org/ISO_9660
#------------------------------------------------------------------------------
package Image::ExifTool::ISO;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.01';
# trim trailing spaces and ignore tag if empty
my %rawStr = (
RawConv => sub {
my $val = shift;
$val =~ s/ +$//;
return length($val) ? $val : undef;
},
);
# tag info for date/time tags
my %dateInfo = (
Format => 'undef[17]',
Groups => { 2 => 'Time' },
ValueConv => q{
return undef if $val !~ /[^0\0 ]/; # ignore if empty
if ($val =~ s/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(.)/$1:$2:$3 $4:$5:$6.$7/s) {
$val .= TimeZoneString(unpack('c', $8) * 15);
}
return $val;
},
PrintConv => '$self->ConvertDateTime($val)',
);
# lookup for volume descriptor types
my %volumeDescriptorType = (
0 => 'Boot Record',
1 => 'Primary Volume',
2 => 'Supplementary Volume',
3 => 'Volume Partition',
255 => 'Terminator',
);
# ISO tags
%Image::ExifTool::ISO::Main = (
GROUPS => { 2 => 'Other' },
NOTES => 'Tags extracted from ISO 9660 disk images.',
0 => {
Name => 'BootRecord',
SubDirectory => { TagTable => 'Image::ExifTool::ISO::BootRecord' },
},
1 => {
Name => 'PrimaryVolume',
SubDirectory => { TagTable => 'Image::ExifTool::ISO::PrimaryVolume' },
},
);
%Image::ExifTool::ISO::BootRecord = (
GROUPS => { 2 => 'Other' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
# 0 => { Name => 'VolumeType', PrintConv => \%volumeDescriptorType }, # (0 for boot record)
# 1 => { Name => 'Identifier', Format => 'undef[5]' }, # (always "CD001")
# 6 => 'VolumeDesriptorVersion', # (always 1)
# always extract BootSystem, even if empty, as an indication that this is bootable
7 => { Name => 'BootSystem', Format => 'string[32]', ValueConv => '$val=~s/ +$//; $val' },
39 => { Name => 'BootIdentifier', Format => 'string[32]', %rawStr },
);
%Image::ExifTool::ISO::PrimaryVolume = (
GROUPS => { 2 => 'Other' },
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
# 0 => { Name => 'VolumeType', PrintConv => \%volumeDescriptorType }, # (1 for primary volume)
# 1 => { Name => 'Identifier', Format => 'undef[5]' }, # (always "CD001")
# 6 => 'VolumeDesriptorVersion', # (always 1)
8 => { Name => 'System', Format => 'string[32]', %rawStr },
40 => { Name => 'VolumeName', Format => 'string[32]', %rawStr },
80 => { Name => 'VolumeBlockCount', Format => 'int32u' },
120 => { Name => 'VolumeSetDiskCount', Format => 'int16u', Unknown => 1 },
124 => { Name => 'VolumeSetDiskNumber', Format => 'int16u', Unknown => 1 },
128 => { Name => 'VolumeBlockSize', Format => 'int16u' },
132 => { Name => 'PathTableSize', Format => 'int32u', Unknown => 1 },
140 => { Name => 'PathTableLocation', Format => 'int32u', Unknown => 1 },
174 => {
Name => 'RootDirectoryCreateDate',
Format => 'undef[7]',
Groups => { 2 => 'Time' },
ValueConv => q{
my @a = unpack('C6c', $val);
$a[0] += 1900;
$a[6] = TimeZoneString($a[6] * 15);
return sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d%s', @a);
},
PrintConv => '$self->ConvertDateTime($val)',
},
190 => { Name => 'VolumeSetName', Format => 'string[128]', %rawStr },
318 => { Name => 'Publisher', Format => 'string[128]', %rawStr },
446 => { Name => 'DataPreparer', Format => 'string[128]', %rawStr },
574 => { Name => 'Software', Format => 'string[128]', %rawStr },
702 => { Name => 'CopyrightFileName', Format => 'string[38]', %rawStr },
740 => { Name => 'AbstractFileName', Format => 'string[36]', %rawStr },
776 => { Name => 'BibligraphicFileName',Format => 'string[37]', %rawStr },
813 => { Name => 'VolumeCreateDate', %dateInfo },
830 => { Name => 'VolumeModifyDate', %dateInfo },
847 => { Name => 'VolumeExpirationDate',%dateInfo },
864 => { Name => 'VolumeEffectiveDate', %dateInfo },
#881 => 'FileStructureVersion', # (always 1)
);
# ISO Composite tags
%Image::ExifTool::ISO::Composite = (
GROUPS => { 2 => 'Other' },
VolumeSize => {
Require => {
0 => 'ISO:VolumeBlockCount',
1 => 'ISO:VolumeBlockSize',
},
ValueConv => '$val[0] * $val[1]',
PrintConv => \&Image::ExifTool::ConvertFileSize,
},
);
# add our composite tags
Image::ExifTool::AddCompositeTags('Image::ExifTool::ISO');
#------------------------------------------------------------------------------
# Extract information from an ISO 9660 disk image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid ISO 9660 image
sub ProcessISO($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my ($buff, $tagTablePtr);
# verify this is a valid ISO file
return 0 unless $raf->Seek(32768, 0);
while ($raf->Read($buff, 2048) == 2048) {
last unless $buff =~ /^[\0-\x03\xff]CD001/;
unless ($tagTablePtr) {
$et->SetFileType(); # set the FileType tag
SetByteOrder('II'); # read little-endian values only
$tagTablePtr = GetTagTable('Image::ExifTool::ISO::Main');
}
my $type = unpack('C', $buff);
$et->VPrint(0, "Volume descriptor type $type ($volumeDescriptorType{$type})\n");
last if $type == 255; # stop at terminator
next unless $$tagTablePtr{$type};
my $subTablePtr = GetTagTable($$tagTablePtr{$type}{SubDirectory}{TagTable});
my %dirInfo = (
DataPt => \$buff,
DataPos => $raf->Tell() - 2048,
DirStart => 0,
DirLen => length($buff),
);
$et->ProcessDirectory(\%dirInfo, $subTablePtr);
}
return $tagTablePtr ? 1 : 0;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::ISO - Read information from ISO 9660 disk images
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read
information from ISO 9660 disk images.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://wiki.osdev.org/ISO_9660>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/ISO Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,215 @@
#------------------------------------------------------------------------------
# File: ITC.pm
#
# Description: Read iTunes Cover Flow meta information
#
# Revisions: 01/12/2008 - P. Harvey Created
#
# References: 1) http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx
# 2) http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/
#------------------------------------------------------------------------------
package Image::ExifTool::ITC;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.02';
sub ProcessITC($$);
# tags used in ITC files
%Image::ExifTool::ITC::Main = (
NOTES => 'This information is found in iTunes Cover Flow data files.',
itch => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Header' } },
item => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Item' } },
data => {
Name => 'ImageData',
Notes => 'embedded JPEG or PNG image, depending on ImageType',
},
);
# ITC header information
%Image::ExifTool::ITC::Header = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
0x10 => {
Name => 'DataType',
Format => 'undef[4]',
PrintConv => { artw => 'Artwork' },
},
);
# ITC item information
%Image::ExifTool::ITC::Item = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 2 => 'Image' },
FORMAT => 'int32u',
FIRST_ENTRY => 0,
0 => {
Name => 'LibraryID',
Format => 'undef[8]',
ValueConv => 'uc unpack "H*", $val',
},
2 => {
Name => 'TrackID',
Format => 'undef[8]',
ValueConv => 'uc unpack "H*", $val',
},
4 => {
Name => 'DataLocation',
Format => 'undef[4]',
PrintConv => {
down => 'Downloaded Separately',
locl => 'Local Music File',
},
},
5 => {
Name => 'ImageType',
Format => 'undef[4]',
ValueConv => { # (not PrintConv because the unconverted JPEG value is nasty)
'PNGf' => 'PNG',
"\0\0\0\x0d" => 'JPEG',
},
},
7 => 'ImageWidth',
8 => 'ImageHeight',
);
#------------------------------------------------------------------------------
# Process an iTunes Cover Flow (ITC) file
# Inputs: 0) ExifTool object reference, 1) Directory information reference
# Returns: 1 on success, 0 if this wasn't a valid ITC file
sub ProcessITC($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $rtnVal = 0;
my ($buff, $err, $pos, $tagTablePtr, %dirInfo);
# loop through all blocks in this image
for (;;) {
# read the block header
my $n = $raf->Read($buff, 8);
unless ($n == 8) {
# no error if we reached the EOF normally
undef $err unless $n;
last;
}
my ($size, $tag) = unpack('Na4', $buff);
if ($rtnVal) {
last unless $size >= 8 and $size < 0x80000000;
} else {
# check to be sure this is a valid ITC image
# (first block must be 'itch')
last unless $tag eq 'itch';
last unless $size >= 0x1c and $size < 0x10000;
$et->SetFileType();
SetByteOrder('MM');
$rtnVal = 1; # this is an ITC file
$err = 1; # format error unless we read to EOF
}
if ($tag eq 'itch') {
$pos = $raf->Tell();
$size -= 8; # size of remaining data in block
$raf->Read($buff,$size) == $size or last;
# extract header information
%dirInfo = (
DirName => 'ITC Header',
DataPt => \$buff,
DataPos => $pos,
);
my $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Header');
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
} elsif ($tag eq 'item') {
# don't want to read the entire item data (includes image)
$size > 12 or last;
$raf->Read($buff, 4) == 4 or last;
my $len = unpack('N', $buff);
$len >= 0xd0 and $len <= $size or last;
$size -= $len; # size of data after item header
$len -= 12; # length of remaining item header
# read in 4-byte blocks until we find the null terminator
# (this is just a guess about how to parse this variable-length part)
while ($len >= 4) {
$raf->Read($buff, 4) == 4 or last;
$len -= 4;
last if $buff eq "\0\0\0\0";
}
last if $len < 4;
$pos = $raf->Tell();
$raf->Read($buff, $len) == $len or last;
unless ($len >= 0xb4 and substr($buff, 0xb0, 4) eq 'data') {
$et->Warn('Parsing error. Please submit this ITC file for testing');
last;
}
%dirInfo = (
DirName => 'ITC Item',
DataPt => \$buff,
DataPos => $pos,
);
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Item');
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
# extract embedded image
$pos += $len;
if ($size > 0) {
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Main');
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'data');
my $image = $et->ExtractBinary($pos, $size, $$tagInfo{Name});
$et->FoundTag($tagInfo, \$image);
# skip the rest of the block if necessary
$raf->Seek($pos+$size, 0) or last
} elsif ($size < 0) {
last;
}
} else {
$et->VPrint(0, "Unknown $tag block ($size bytes)\n");
$raf->Seek($size-8, 1) or last;
}
}
$err and $et->Warn('ITC file format error');
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::ITC - Read iTunes Cover Flow meta information
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains the routines required by Image::ExifTool to read meta
information (including artwork images) from iTunes Cover Flow files.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx>
=item L<http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/ITC Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,357 @@
#------------------------------------------------------------------------------
# File: Import.pm
#
# Description: Import CSV and JSON database files
#
# Revisions: 2011-03-05 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::Import;
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = '1.09';
@ISA = qw(Exporter);
@EXPORT_OK = qw(ReadCSV ReadJSON);
sub ReadJSONObject($;$);
my %unescapeJSON = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r" );
my $charset;
#------------------------------------------------------------------------------
# Read CSV file
# Inputs: 0) CSV file name, file ref or RAF ref, 1) database hash ref, 2) missing tag value
# Returns: undef on success, or error string
# Notes: There are various flavours of CSV, but here we assume that only
# double quotes are escaped, and they are escaped by doubling them
sub ReadCSV($$;$)
{
local ($_, $/);
my ($file, $database, $missingValue) = @_;
my ($buff, @tags, $found, $err, $raf, $openedFile);
if (UNIVERSAL::isa($file, 'File::RandomAccess')) {
$raf = $file;
$file = 'CSV file';
} elsif (ref $file eq 'GLOB') {
$raf = new File::RandomAccess($file);
$file = 'CSV file';
} else {
open CSVFILE, $file or return "Error opening CSV file '${file}'";
binmode CSVFILE;
$openedFile = 1;
$raf = new File::RandomAccess(\*CSVFILE);
}
# set input record separator by first newline found in the file
# (safe because first line should contain only tag names)
while ($raf->Read($buff, 65536)) {
$buff =~ /(\x0d\x0a|\x0d|\x0a)/ and $/ = $1, last;
}
$raf->Seek(0,0);
while ($raf->ReadLine($buff)) {
my (@vals, $v, $i, %fileInfo);
my @toks = split ',', $buff;
while (@toks) {
($v = shift @toks) =~ s/^ +//; # remove leading spaces
if ($v =~ s/^"//) {
# quoted value must end in an odd number of quotes
while ($v !~ /("+)\s*$/ or not length($1) & 1) {
if (@toks) {
$v .= ',' . shift @toks;
} else {
# read another line from the file
$raf->ReadLine($buff) or last;
@toks = split ',', $buff;
last unless @toks;
$v .= shift @toks;
}
}
$v =~ s/"\s*$//; # remove trailing quote and whitespace
$v =~ s/""/"/g; # un-escape quotes
} else {
$v =~ s/[ \n\r]+$//;# remove trailing spaces/newlines
}
push @vals, $v;
}
if (@tags) {
# save values for each tag
for ($i=0; $i<@vals and $i<@tags; ++$i) {
# ignore empty entries unless missingValue is empty too
next unless length $vals[$i] or defined $missingValue and $missingValue eq '';
# delete tag (set value to undef) if value is same as missing tag
$fileInfo{$tags[$i]} =
(defined $missingValue and $vals[$i] eq $missingValue) ? undef : $vals[$i];
}
# figure out the file name to use
if ($fileInfo{SourceFile}) {
$$database{$fileInfo{SourceFile}} = \%fileInfo;
$found = 1;
}
} else {
# the first row should be the tag names
foreach (@vals) {
# terminate at first blank tag name (eg. extra comma at end of line)
last unless length $_;
@tags or s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
/^[-\w]+(:[-\w+]+)?#?$/ or $err = "Invalid tag name '${_}'", last;
push(@tags, $_);
}
last if $err;
@tags or $err = 'No tags found', last;
# fix "SourceFile" case if necessary
$tags[0] = 'SourceFile' if lc $tags[0] eq 'sourcefile';
}
}
close CSVFILE if $openedFile;
undef $raf;
$err = 'No SourceFile column' unless $found or $err;
return $err ? "$err in $file" : undef;
}
#------------------------------------------------------------------------------
# Convert unicode code point to UTF-8
# Inputs: 0) integer Unicode character
# Returns: UTF-8 bytes
sub ToUTF8($)
{
require Image::ExifTool::Charset;
return Image::ExifTool::Charset::Recompose(undef, [$_[0]], $charset);
}
#------------------------------------------------------------------------------
# Read JSON object from file
# Inputs: 0) RAF reference or undef, 1) optional scalar reference for data
# to read before reading from file (ie. the file read buffer)
# Returns: JSON object (scalar, hash ref, or array ref), or undef on EOF or
# empty object or array (and sets $$buffPt to empty string on EOF)
# Notes: position in buffer is significant
sub ReadJSONObject($;$)
{
my ($raf, $buffPt) = @_;
# initialize buffer if necessary
my ($pos, $readMore, $rtnVal, $tok, $key, $didBOM);
if ($buffPt) {
$pos = pos $$buffPt;
$pos = pos($$buffPt) = 0 unless defined $pos;
} else {
my $buff = '';
$buffPt = \$buff;
$pos = 0;
}
Tok: for (;;) {
# (didn't spend the time to understand how $pos could be undef, but
# put a test here to be safe because one user reported this problem)
last unless defined $pos;
if ($pos >= length $$buffPt or $readMore) {
last unless defined $raf;
# read another 64kB and add to unparsed data
my $offset = length($$buffPt) - $pos;
if ($offset) {
my $buff;
$raf->Read($buff, 65536) or $$buffPt = '', last;
$$buffPt = substr($$buffPt, $pos) . $buff;
} else {
$raf->Read($$buffPt, 65536) or $$buffPt = '', last;
}
unless ($didBOM) {
$$buffPt =~ s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
$didBOM = 1;
}
$pos = pos($$buffPt) = 0;
$readMore = 0;
}
unless ($tok) {
# skip white space and find next character
$$buffPt =~ /(\S)/g or $pos = length($$buffPt), next;
$tok = $1;
$pos = pos $$buffPt;
}
# see what type of object this is
if ($tok eq '{') { # object (hash)
$rtnVal = { } unless defined $rtnVal;
for (;;) {
# read "KEY":"VALUE" pairs
unless (defined $key) {
$key = ReadJSONObject($raf, $buffPt);
$pos = pos $$buffPt;
}
# ($key may be undef for empty JSON object)
if (defined $key) {
# scan to delimiting ':'
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
$1 eq ':' or return undef; # error if not a colon
my $val = ReadJSONObject($raf, $buffPt);
$pos = pos $$buffPt;
return undef unless defined $val;
$$rtnVal{$key} = $val;
undef $key;
}
# scan to delimiting ',' or bounding '}'
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
last if $1 eq '}'; # check for end of object
$1 eq ',' or return undef; # error if not a comma
}
} elsif ($tok eq '[') { # array
$rtnVal = [ ] unless defined $rtnVal;
for (;;) {
my $item = ReadJSONObject($raf, $buffPt);
$pos = pos $$buffPt;
# ($item may be undef for empty array)
push @$rtnVal, $item if defined $item;
# scan to delimiting ',' or bounding ']'
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
last if $1 eq ']'; # check for end of array
$1 eq ',' or return undef; # error if not a comma
}
} elsif ($tok eq '"') { # quoted string
for (;;) {
$$buffPt =~ /(\\*)"/g or $readMore = 1, next Tok;
last unless length($1) & 1; # check for escaped quote
}
$rtnVal = substr($$buffPt, $pos, pos($$buffPt)-$pos-1);
# unescape characters
$rtnVal =~ s/\\u([0-9a-f]{4})/ToUTF8(hex $1)/ige;
$rtnVal =~ s/\\(.)/$unescapeJSON{$1}||$1/sge;
# decode base64 (binary data) values
if ($rtnVal =~ /^base64:[A-Za-z0-9+\/]*={0,2}$/ and length($rtnVal) % 4 == 3) {
require Image::ExifTool::XMP;
$rtnVal = ${Image::ExifTool::XMP::DecodeBase64(substr($rtnVal,7))};
}
} elsif ($tok eq ']' or $tok eq '}' or $tok eq ',') {
# return undef for empty object, array, or list item
# (empty list item actually not valid JSON)
pos($$buffPt) = pos($$buffPt) - 1;
} else { # number, 'true', 'false', 'null'
$$buffPt =~ /([\s:,\}\]])/g or $readMore = 1, next;
pos($$buffPt) = pos($$buffPt) - 1;
$rtnVal = $tok . substr($$buffPt, $pos, pos($$buffPt)-$pos);
}
last;
}
return $rtnVal;
}
#------------------------------------------------------------------------------
# Read JSON file
# Inputs: 0) JSON file name, file ref or RAF ref, 1) database hash ref,
# 2) flag to delete "-" tags, 3) character set
# Returns: undef on success, or error string
sub ReadJSON($$;$$)
{
local $_;
my ($file, $database, $missingValue, $chset) = @_;
my ($raf, $openedFile);
# initialize character set for converting "\uHHHH" chars
$charset = $chset || 'UTF8';
if (UNIVERSAL::isa($file, 'File::RandomAccess')) {
$raf = $file;
$file = 'JSON file';
} elsif (ref $file eq 'GLOB') {
$raf = new File::RandomAccess($file);
$file = 'JSON file';
} else {
open JSONFILE, $file or return "Error opening JSON file '${file}'";
binmode JSONFILE;
$openedFile = 1;
$raf = new File::RandomAccess(\*JSONFILE);
}
my $obj = ReadJSONObject($raf);
close JSONFILE if $openedFile;
unless (ref $obj eq 'ARRAY') {
ref $obj eq 'HASH' or return "Format error in JSON file '${file}'";
$obj = [ $obj ];
}
my ($info, $found);
foreach $info (@$obj) {
next unless ref $info eq 'HASH';
# fix "SourceFile" case, or assume '*' if SourceFile not specified
unless (defined $$info{SourceFile}) {
my ($key) = grep /^SourceFile$/i, keys %$info;
if ($key) {
$$info{SourceFile} = $$info{$key};
delete $$info{$key};
} else {
$$info{SourceFile} = '*';
}
}
if (defined $missingValue) {
$$info{$_} eq $missingValue and $$info{$_} = undef foreach keys %$info;
}
$$database{$$info{SourceFile}} = $info;
$found = 1;
}
return $found ? undef : "No valid JSON objects in '${file}'";
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Import - Import CSV and JSON database files
=head1 SYNOPSIS
use Image::ExifTool::Import qw(ReadCSV ReadJSON);
$err = ReadCSV($csvFile, \%database);
$err = ReadJSON($jsonfile, \%database);
=head1 DESCRIPTION
This module contains routines for importing tag information from CSV (Comma
Separated Value) and JSON (JavaScript Object Notation) database files.
=head1 EXPORTS
Exports nothing by default, but ReadCSV and ReadJSON may be exported.
=head1 METHODS
=head2 ReadCSV / ReadJSON
Read CSV or JSON file into a database hash.
=over 4
=item Inputs:
0) CSV file name or file reference.
1) Hash reference for database object.
2) Optional string used to represent an undefined (missing) tag value.
(Used for deleting tags.)
3) [ReadJSON only] Optional character set for converting Unicode escape
sequences in strings. Defaults to "UTF8". See the ExifTool Charset option
for a list of valid settings.
=item Return Value:
These functions return an error string, or undef on success and populate the
database hash with entries from the CSV or JSON file. Entries are keyed
based on the SourceFile column of the CSV or JSON information, and are
stored as hash lookups of tag name/value for each SourceFile.
=back
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,279 @@
#------------------------------------------------------------------------------
# File: InDesign.pm
#
# Description: Read/write meta information in Adobe InDesign files
#
# Revisions: 2009-06-17 - P. Harvey Created
#
# References: 1) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf
#------------------------------------------------------------------------------
package Image::ExifTool::InDesign;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.06';
# map for writing metadata to InDesign files (currently only write XMP)
my %indMap = (
XMP => 'IND',
);
# GUID's used in InDesign files
my $masterPageGUID = "\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d";
my $objectHeaderGUID = "\xde\x39\x39\x79\x51\x88\x4b\x6c\x8E\x63\xee\xf8\xae\xe0\xdd\x38";
my $objectTrailerGUID = "\xfd\xce\xdb\x70\xf7\x86\x4b\x4f\xa4\xd3\xc7\x28\xb3\x41\x71\x06";
#------------------------------------------------------------------------------
# Read or write meta information in an InDesign file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid InDesign file, or -1 on write error
sub ProcessIND($$)
{
my ($et, $dirInfo) = @_;
my $raf = $$dirInfo{RAF};
my $outfile = $$dirInfo{OutFile};
my ($hdr, $buff, $buf2, $err, $writeLen, $foundXMP);
# validate the InDesign file
return 0 unless $raf->Read($hdr, 16) == 16;
return 0 unless $hdr eq $masterPageGUID;
return 0 unless $raf->Read($buff, 8) == 8;
$et->SetFileType($buff eq 'DOCUMENT' ? 'INDD' : 'IND'); # set the FileType tag
# read the master pages
$raf->Seek(0, 0) or $err = 'Seek error', goto DONE;
unless ($raf->Read($buff, 4096) == 4096 and
$raf->Read($buf2, 4096) == 4096)
{
$err = 'Unexpected end of file';
goto DONE; # (goto's can be our friend)
}
SetByteOrder('II');
unless ($buf2 =~ /^\Q$masterPageGUID/) {
$err = 'Second master page is invalid';
goto DONE;
}
my $seq1 = Get64u(\$buff, 264);
my $seq2 = Get64u(\$buf2, 264);
# take the most current master page
my $curPage = $seq2 > $seq1 ? \$buf2 : \$buff;
# byte order of stream data may be different than headers
my $streamInt32u = Get8u($curPage, 24);
if ($streamInt32u == 1) {
$streamInt32u = 'V'; # little-endian int32u
} elsif ($streamInt32u == 2) {
$streamInt32u = 'N'; # big-endian int32u
} else {
$err = 'Invalid stream byte order';
goto DONE;
}
my $pages = Get32u($curPage, 280);
$pages < 2 and $err = 'Invalid page count', goto DONE;
my $pos = $pages * 4096;
if ($pos > 0x7fffffff and not $et->Options('LargeFileSupport')) {
$err = 'InDesign files larger than 2 GB not supported (LargeFileSupport not set)';
goto DONE;
}
if ($outfile) {
# make XMP the preferred group for writing
$et->InitWriteDirs(\%indMap, 'XMP');
Write($outfile, $buff, $buf2) or $err = 1, goto DONE;
my $result = Image::ExifTool::CopyBlock($raf, $outfile, $pos - 8192);
unless ($result) {
$err = defined $result ? 'Error reading InDesign database' : 1;
goto DONE;
}
$writeLen = 0;
} else {
$raf->Seek($pos, 0) or $err = 'Seek error', goto DONE;
}
# scan through the contiguous objects for XMP
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
for (;;) {
$raf->Read($hdr, 32) or last;
unless (length($hdr) == 32 and $hdr =~ /^\Q$objectHeaderGUID/) {
# this must be null padding or we have an error
$hdr =~ /^\0+$/ or $err = 'Corrupt file or unsupported InDesign version';
last;
}
my $len = Get32u(\$hdr, 24);
if ($verbose) {
printf $out "Contiguous object at offset 0x%x (%d bytes):\n", $raf->Tell(), $len;
if ($verbose > 2) {
my $len2 = $len < 1024000 ? $len : 1024000;
$raf->Seek(-$raf->Read($buff, $len2), 1) or $err = 1;
$et->VerboseDump(\$buff, Addr => $raf->Tell());
}
}
# check for XMP if stream data is long enough
# (56 bytes is just enough for XMP header)
if ($len > 56) {
$raf->Read($buff, 56) == 56 or $err = 'Unexpected end of file', last;
if ($buff =~ /^(....)<\?xpacket begin=(['"])\xef\xbb\xbf\2 id=(['"])W5M0MpCehiHzreSzNTczkc9d\3/s) {
my $lenWord = $1; # save length word for writing later
$len -= 4; # get length of XMP only
$foundXMP = 1;
# I have a sample where the XMP is 107 MB, and ActivePerl may run into
# memory troubles (with its apparent 1 GB limit) if the XMP is larger
# than about 400 MB, so guard against this
if ($len > 300 * 1024 * 1024) {
my $msg = sprintf('Insanely large XMP (%.0f MB)', $len / (1024 * 1024));
if ($outfile) {
$et->Error($msg, 2) and $err = 1, last;
} elsif ($et->Options('IgnoreMinorErrors')) {
$et->Warn($msg);
} else {
$et->Warn("$msg. Ignored.", 1);
$err = 1;
last;
}
}
# load and parse the XMP data
unless ($raf->Seek(-52, 1) and $raf->Read($buff, $len) == $len) {
$err = 'Error reading XMP stream';
last;
}
my %dirInfo = (
DataPt => \$buff,
Parent => 'IND',
NoDelete => 1, # do not allow this to be deleted when writing
);
# validate xmp data length (should be same as length in header - 4)
my $xmpLen = unpack($streamInt32u, $lenWord);
unless ($xmpLen == $len) {
if ($xmpLen < $len) {
$dirInfo{DirLen} = $xmpLen;
} else {
$err = 'Truncated XMP stream (missing ' . ($xmpLen - $len) . ' bytes)';
}
}
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
if ($outfile) {
last if $err;
# make sure that XMP is writable
my $classID = Get32u(\$hdr, 20);
$classID & 0x40000000 or $err = 'XMP stream is not writable', last;
my $xmp = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
if ($xmp and length $xmp) {
# write new xmp with leading length word
$buff = pack($streamInt32u, length $xmp) . $xmp;
# update header with new length and invalid checksum
Set32u(length($buff), \$hdr, 24);
Set32u(0xffffffff, \$hdr, 28);
} else {
$$et{CHANGED} = 0; # didn't change anything
$et->Warn("Can't delete XMP as a block from InDesign file") if defined $xmp;
# put length word back at start of stream
$buff = $lenWord . $buff;
}
} else {
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
}
$len = 0; # we got the full stream (nothing left to read)
} else {
$len -= 56; # we got 56 bytes of the stream
}
} else {
$buff = ''; # must reset this for writing later
}
if ($outfile) {
# write object header and data
Write($outfile, $hdr, $buff) or $err = 1, last;
my $result = Image::ExifTool::CopyBlock($raf, $outfile, $len);
unless ($result) {
$err = defined $result ? 'Truncated stream data' : 1;
last;
}
$writeLen += 32 + length($buff) + $len;
} elsif ($len) {
# skip over remaining stream data
$raf->Seek($len, 1) or $err = 'Seek error', last;
}
$raf->Read($buff, 32) == 32 or $err = 'Unexpected end of file', last;
unless ($buff =~ /^\Q$objectTrailerGUID/) {
$err = 'Invalid object trailer';
last;
}
if ($outfile) {
# make sure object UID and ClassID are the same in the trailer
substr($hdr,16,8) eq substr($buff,16,8) or $err = 'Non-matching object trailer', last;
# write object trailer
Write($outfile, $objectTrailerGUID, substr($hdr,16)) or $err = 1, last;
$writeLen += 32;
}
}
if ($outfile) {
# write null padding if necessary
# (InDesign files must be an even number of 4096-byte blocks)
my $part = $writeLen % 4096;
Write($outfile, "\0" x (4096 - $part)) or $err = 1 if $part;
}
DONE:
if (not $err) {
$et->Warn('No XMP stream to edit') if $outfile and not $foundXMP;
return 1; # success!
} elsif (not $outfile) {
# issue warning on read error
$et->Warn($err) unless $err eq '1';
} elsif ($err ne '1') {
# set error and return success code
$et->Error($err);
} else {
return -1; # write error
}
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::InDesign - Read/write meta information in Adobe InDesign files
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains routines required by Image::ExifTool to read XMP
meta information from Adobe InDesign (.IND, .INDD and .INDT) files.
=head1 LIMITATIONS
1) Only XMP meta information is processed.
2) A new XMP stream may not be created, so XMP tags may only be written to
InDesign files which previously contained XMP.
3) File sizes of greater than 2 GB are supported only if the system supports
them and the LargeFileSupport option is enabled.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf>
=back
=head1 SEE ALSO
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

View File

@@ -0,0 +1,612 @@
#------------------------------------------------------------------------------
# File: JPEG.pm
#
# Description: Definitions for uncommon JPEG segments
#
# Revisions: 10/06/2006 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::JPEG;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.26';
sub ProcessOcad($$$);
sub ProcessJPEG_HDR($$$);
# (this main JPEG table is for documentation purposes only)
%Image::ExifTool::JPEG::Main = (
NOTES => q{
This table lists information extracted by ExifTool from JPEG images. See
L<https://www.w3.org/Graphics/JPEG/jfif3.pdf> for the JPEG specification.
},
APP0 => [{
Name => 'JFIF',
Condition => '$$valPt =~ /^JFIF\0/',
SubDirectory => { TagTable => 'Image::ExifTool::JFIF::Main' },
}, {
Name => 'JFXX',
Condition => '$$valPt =~ /^JFXX\0\x10/',
SubDirectory => { TagTable => 'Image::ExifTool::JFIF::Extension' },
}, {
Name => 'CIFF',
Condition => '$$valPt =~ /^(II|MM).{4}HEAPJPGM/s',
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::Main' },
}, {
Name => 'AVI1',
Condition => '$$valPt =~ /^AVI1/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::AVI1' },
}, {
Name => 'Ocad',
Condition => '$$valPt =~ /^Ocad/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::Ocad' },
}],
APP1 => [{
Name => 'EXIF',
Condition => '$$valPt =~ /^Exif\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main' },
}, {
Name => 'ExtendedXMP',
Condition => '$$valPt =~ m{^http://ns.adobe.com/xmp/extension/\0}',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
}, {
Name => 'XMP',
Condition => '$$valPt =~ /^http/ or $$valPt =~ /<exif:/',
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
}, {
Name => 'QVCI',
Condition => '$$valPt =~ /^QVCI\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Casio::QVCI' },
}, {
Name => 'FLIR',
Condition => '$$valPt =~ /^FLIR\0/',
SubDirectory => { TagTable => 'Image::ExifTool::FLIR::FFF' },
}],
APP2 => [{
Name => 'ICC_Profile',
Condition => '$$valPt =~ /^ICC_PROFILE\0/',
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
}, {
Name => 'FPXR',
Condition => '$$valPt =~ /^FPXR\0/',
SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::Main' },
}, {
Name => 'MPF',
Condition => '$$valPt =~ /^MPF\0/',
SubDirectory => { TagTable => 'Image::ExifTool::MPF::Main' },
}, {
Name => 'PreviewImage',
Condition => '$$valPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff\xdb/',
Notes => 'Samsung APP2 preview image', # (Samsung/GoPro="", BenQ="QVGA\0", Digilife="BGTH")
}],
APP3 => [{
Name => 'Meta',
Condition => '$$valPt =~ /^(Meta|META|Exif)\0\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Kodak::Meta' },
}, {
Name => 'Stim',
Condition => '$$valPt =~ /^Stim\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Stim::Main' },
}, {
Name => 'PreviewImage', # (written by HP R837 and Samsung S1060)
Condition => '$$valPt =~ /^\xff\xd8\xff\xdb/',
Notes => 'Samsung/HP preview image', # (Samsung, HP, BenQ)
}],
APP4 => [{
Name => 'Scalado',
Condition => '$$valPt =~ /^SCALADO\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Scalado::Main' },
}, {
Name => 'FPXR', # (non-standard location written by some HP models)
Condition => '$$valPt =~ /^FPXR\0/',
SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::Main' },
}, {
Name => 'PreviewImage', # (eg. Samsung S1060)
Notes => 'continued from APP3',
}],
APP5 => [{
Name => 'RMETA',
Condition => '$$valPt =~ /^RMETA\0/',
SubDirectory => { TagTable => 'Image::ExifTool::Ricoh::RMETA' },
}, {
Name => 'PreviewImage', # (eg. BenQ DC E1050)
Notes => 'continued from APP4',
}],
APP6 => [{
Name => 'EPPIM',
Condition => '$$valPt =~ /^EPPIM\0/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::EPPIM' },
}, {
Name => 'NITF',
Condition => '$$valPt =~ /^NTIF\0/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::NITF' },
}, {
Name => 'HP_TDHD', # (written by R837)
Condition => '$$valPt =~ /^TDHD\x01\0\0\0/',
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
}, {
Name => 'GoPro',
Condition => '$$valPt =~ /^GoPro\0/',
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
}],
APP7 => [{
Name => 'Pentax',
Condition => '$$valPt =~ /^PENTAX \0/',
SubDirectory => { TagTable => 'Image::ExifTool::Pentax::Main' },
}, {
Name => 'Qualcomm',
Condition => '$$valPt =~ /^\x1aQualcomm Camera Attributes/',
SubDirectory => { TagTable => 'Image::ExifTool::Qualcomm::Main' },
}],
APP8 => {
Name => 'SPIFF',
Condition => '$$valPt =~ /^SPIFF\0/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::SPIFF' },
},
APP9 => {
Name => 'MediaJukebox',
Condition => '$$valPt =~ /^Media Jukebox\0/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::MediaJukebox' },
},
APP10 => {
Name => 'Comment',
Condition => '$$valPt =~ /^UNICODE\0/',
Notes => 'PhotoStudio Unicode comment',
},
APP11 => {
Name => 'JPEG-HDR',
Condition => '$$valPt =~ /^HDR_RI /',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::HDR' },
},
APP12 => [{
Name => 'PictureInfo',
Condition => '$$valPt =~ /(\[picture info\]|Type=)/',
SubDirectory => { TagTable => 'Image::ExifTool::APP12::PictureInfo' },
}, {
Name => 'Ducky',
Condition => '$$valPt =~ /^Ducky/',
SubDirectory => { TagTable => 'Image::ExifTool::APP12::Ducky' },
}],
APP13 => [{
Name => 'Photoshop',
Condition => '$$valPt =~ /^(Photoshop 3.0\0|Adobe_Photoshop2.5)/',
SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Main' },
}, {
Name => 'Adobe_CM',
Condition => '$$valPt =~ /^Adobe_CM/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::AdobeCM' },
}],
APP14 => {
Name => 'Adobe',
Condition => '$$valPt =~ /^Adobe/',
Writable => 1, # (for docs only)
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::Adobe' },
},
APP15 => {
Name => 'GraphicConverter',
Condition => '$$valPt =~ /^Q\s*(\d+)/',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::GraphConv' },
},
# APP15 - Also unknown "TEXT\0" segment stored by Casio/FujiFilm
COM => {
Name => 'Comment',
# note: flag as writable for documentation, but it won't show up
# in the TagLookup as writable because there is no WRITE_PROC
Writable => 1,
},
SOF => {
Name => 'StartOfFrame',
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::SOF' },
},
DQT => {
Name => 'DefineQuantizationTable',
Notes => 'used to calculate the Extra JPEGDigest tag value',
},
Trailer => [{
Name => 'AFCP',
Condition => '$$valPt =~ /AXS(!|\*).{8}$/s',
SubDirectory => { TagTable => 'Image::ExifTool::AFCP::Main' },
}, {
Name => 'CanonVRD',
Condition => '$$valPt =~ /CANON OPTIONAL DATA\0.{44}$/s',
SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Main' },
}, {
Name => 'FotoStation',
Condition => '$$valPt =~ /\xa1\xb2\xc3\xd4$/',
SubDirectory => { TagTable => 'Image::ExifTool::FotoStation::Main' },
}, {
Name => 'PhotoMechanic',
Condition => '$$valPt =~ /cbipcbbl$/',
SubDirectory => { TagTable => 'Image::ExifTool::PhotoMechanic::Main' },
}, {
Name => 'MIE',
Condition => q{
$$valPt =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
$$valPt =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s
},
SubDirectory => { TagTable => 'Image::ExifTool::MIE::Main' },
}, {
Name => 'Samsung',
Condition => '$$valPt =~ /QDIOBS$/',
SubDirectory => { TagTable => 'Image::ExifTool::Samsung::Trailer' },
}, {
Name => 'PreviewImage',
Condition => '$$valPt =~ /^\xff\xd8\xff/',
Writable => 1, # (for docs only)
}],
);
# EPPIM APP6 (Toshiba PrintIM) segment (ref PH, from PDR-M700 samples)
%Image::ExifTool::JPEG::EPPIM = (
GROUPS => { 0 => 'APP6', 1 => 'EPPIM', 2 => 'Image' },
NOTES => q{
APP6 is used in by the Toshiba PDR-M700 to store a TIFF structure containing
PrintIM information.
},
0xc4a5 => {
Name => 'PrintIM',
# must set Writable here so this tag will be saved with MakerNotes option
Writable => 'undef',
Description => 'Print Image Matching',
SubDirectory => {
TagTable => 'Image::ExifTool::PrintIM::Main',
},
},
);
# APP8 SPIFF segment. Refs:
# 1) http://www.fileformat.info/format/spiff/
# 2) http://www.jpeg.org/public/spiff.pdf
%Image::ExifTool::JPEG::SPIFF = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'APP8', 1 => 'SPIFF', 2 => 'Image' },
NOTES => q{
This information is found in APP8 of SPIFF-style JPEG images (the "official"
yet rarely used JPEG file format standard: Still Picture Interchange File
Format). See L<http://www.jpeg.org/public/spiff.pdf> for the official
specification.
},
0 => {
Name => 'SPIFFVersion',
Format => 'int8u[2]',
PrintConv => '$val =~ tr/ /./; $val',
},
2 => {
Name => 'ProfileID',
PrintConv => {
0 => 'Not Specified',
1 => 'Continuous-tone Base',
2 => 'Continuous-tone Progressive',
3 => 'Bi-level Facsimile',
4 => 'Continuous-tone Facsimile',
},
},
3 => 'ColorComponents',
6 => {
Name => 'ImageHeight',
Notes => q{
at index 4 in specification, but there are 2 extra bytes here in my only
SPIFF sample, version 1.2
},
Format => 'int32u',
},
10 => {
Name => 'ImageWidth',
Format => 'int32u',
},
14 => {
Name => 'ColorSpace',
PrintConv => {
0 => 'Bi-level',
1 => 'YCbCr, ITU-R BT 709, video',
2 => 'No color space specified',
3 => 'YCbCr, ITU-R BT 601-1, RGB',
4 => 'YCbCr, ITU-R BT 601-1, video',
8 => 'Gray-scale',
9 => 'PhotoYCC',
10 => 'RGB',
11 => 'CMY',
12 => 'CMYK',
13 => 'YCCK',
14 => 'CIELab',
},
},
15 => 'BitsPerSample',
16 => {
Name => 'Compression',
PrintConv => {
0 => 'Uncompressed, interleaved, 8 bits per sample',
1 => 'Modified Huffman',
2 => 'Modified READ',
3 => 'Modified Modified READ',
4 => 'JBIG',
5 => 'JPEG',
},
},
17 => {
Name => 'ResolutionUnit',
PrintConv => {
0 => 'None',
1 => 'inches',
2 => 'cm',
},
},
18 => {
Name => 'YResolution',
Format => 'int32u',
},
22 => {
Name => 'XResolution',
Format => 'int32u',
},
);
# APP9 Media Jukebox segment (ref PH)
%Image::ExifTool::JPEG::MediaJukebox = (
GROUPS => { 0 => 'XML', 1 => 'MediaJukebox', 2 => 'Image' },
VARS => { NO_ID => 1 },
NOTES => 'Tags found in the XML metadata of the APP9 "Media Jukebox" segment.',
Date => {
Groups => { 2 => 'Time' },
# convert from days since Dec 30, 1899 to seconds since Jan 1, 1970
ValueConv => 'ConvertUnixTime(($val - (70 * 365 + 17 + 2)) * 24 * 3600)',
PrintConv => '$self->ConvertDateTime($val)',
},
Album => { },
Caption => { },
Keywords => { },
Name => { },
People => { },
Places => { },
Tool_Name => { },
Tool_Version => { },
);
# JPEG-HDR APP11 information (ref PH, guessed from http://anyhere.com/gward/papers/cic05.pdf)
%Image::ExifTool::JPEG::HDR = (
GROUPS => { 0 => 'APP11', 1 => 'JPEG-HDR', 2 => 'Image' },
PROCESS_PROC => \&ProcessJPEG_HDR,
TAG_PREFIX => '', # (no prefix for unknown tags)
NOTES => 'Information extracted from APP11 of a JPEG-HDR image.',
ver => 'JPEG-HDRVersion',
# (need names for the next 3 tags)
ln0 => { Description => 'Ln0' },
ln1 => { Description => 'Ln1' },
s2n => { Description => 'S2n' },
alp => { Name => 'Alpha' }, # (Alpha/Beta are saturation parameters)
bet => { Name => 'Beta' },
cor => { Name => 'CorrectionMethod' },
RatioImage => {
Groups => { 2 => 'Preview' },
Notes => 'the embedded JPEG-compressed ratio image',
Binary => 1,
},
);
# AdobeCM APP13 (no references)
%Image::ExifTool::JPEG::AdobeCM = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'APP13', 1 => 'AdobeCM', 2 => 'Image' },
NOTES => q{
The APP13 "Adobe_CM" segment presumably contains color management
information, but the meaning of the data is currently unknown. If anyone
has an idea about what this means, please let me know.
},
FORMAT => 'int16u',
0 => 'AdobeCMType',
);
# Adobe APP14 refs:
# http://partners.adobe.com/public/developer/en/ps/sdk/5116.DCT_Filter.pdf
# http://java.sun.com/j2se/1.5.0/docs/api/javax/imageio/metadata/doc-files/jpeg_metadata.html#color
%Image::ExifTool::JPEG::Adobe = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'APP14', 1 => 'Adobe', 2 => 'Image' },
NOTES => q{
The APP14 "Adobe" segment stores image encoding information for DCT filters.
This segment may be copied or deleted as a block using the Extra "Adobe"
tag, but note that it is not deleted by default when deleting all metadata
because it may affect the appearance of the image.
},
FORMAT => 'int16u',
0 => 'DCTEncodeVersion',
1 => {
Name => 'APP14Flags0',
PrintConv => {
0 => '(none)',
BITMASK => {
15 => 'Encoded with Blend=1 downsampling'
},
},
},
2 => {
Name => 'APP14Flags1',
PrintConv => {
0 => '(none)',
BITMASK => { },
},
},
3 => {
Name => 'ColorTransform',
Format => 'int8u',
PrintConv => {
0 => 'Unknown (RGB or CMYK)',
1 => 'YCbCr',
2 => 'YCCK',
},
},
);
# GraphicConverter APP15 (ref PH)
%Image::ExifTool::JPEG::GraphConv = (
GROUPS => { 0 => 'APP15', 1 => 'GraphConv', 2 => 'Image' },
NOTES => 'APP15 is used by GraphicConverter to store JPEG quality.',
'Q' => 'Quality',
);
# APP0 AVI1 segment (ref http://www.schnarff.com/file-formats/bmp/BMPDIB.TXT)
%Image::ExifTool::JPEG::AVI1 = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'APP0', 1 => 'AVI1', 2 => 'Image' },
NOTES => 'This information may be found in APP0 of JPEG image data from AVI videos.',
FIRST_ENTRY => 0,
0 => {
Name => 'InterleavedField',
PrintConv => {
0 => 'Not Interleaved',
1 => 'Odd',
2 => 'Even',
},
},
);
# APP0 Ocad segment (ref PH)
%Image::ExifTool::JPEG::Ocad = (
PROCESS_PROC => \&ProcessOcad,
GROUPS => { 0 => 'APP0', 1 => 'Ocad', 2 => 'Image' },
TAG_PREFIX => 'Ocad',
FIRST_ENTRY => 0,
NOTES => q{
Tags extracted from the JPEG APP0 "Ocad" segment (found in Photobucket
images).
},
Rev => {
Name => 'OcadRevision',
Format => 'string[6]',
}
);
# APP6 NITF segment (National Imagery Transmission Format)
# ref http://www.gwg.nga.mil/ntb/baseline/docs/n010697/bwcguide25aug98.pdf
%Image::ExifTool::JPEG::NITF = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
GROUPS => { 0 => 'APP6', 1 => 'NITF', 2 => 'Image' },
NOTES => q{
Information in APP6 used by the National Imagery Transmission Format. See
L<http://www.gwg.nga.mil/ntb/baseline/docs/n010697/bwcguide25aug98.pdf> for
the official specification.
},
0 => {
Name => 'NITFVersion',
Format => 'int8u[2]',
ValueConv => 'sprintf("%d.%.2d", split(" ",$val))',
},
2 => {
Name => 'ImageFormat',
ValueConv => 'chr($val)',
PrintConv => { B => 'IMode B' },
},
3 => {
Name => 'BlocksPerRow',
Format => 'int16u',
},
5 => {
Name => 'BlocksPerColumn',
Format => 'int16u',
},
7 => {
Name => 'ImageColor',
PrintConv => { 0 => 'Monochrome' },
},
8 => 'BitDepth',
9 => {
Name => 'ImageClass',
PrintConv => {
0 => 'General Purpose',
4 => 'Tactical Imagery',
},
},
10 => {
Name => 'JPEGProcess',
PrintConv => {
1 => 'Baseline sequential DCT, Huffman coding, 8-bit samples',
4 => 'Extended sequential DCT, Huffman coding, 12-bit samples',
},
},
11 => 'Quality',
12 => {
Name => 'StreamColor',
PrintConv => { 0 => 'Monochrome' },
},
13 => 'StreamBitDepth',
14 => {
Name => 'Flags',
Format => 'int32u',
PrintConv => 'sprintf("0x%x", $val)',
},
);
#------------------------------------------------------------------------------
# Extract information from the JPEG APP0 Ocad segment
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessOcad($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
$et->VerboseDir('APP0 Ocad', undef, length $$dataPt);
for (;;) {
last unless $$dataPt =~ /\$(\w+):([^\0\$]+)/g;
my ($tag, $val) = ($1, $2);
$val =~ s/^\s+//; $val =~ s/\s+$//; # remove leading/trailing spaces
AddTagToTable($tagTablePtr, $tag) unless $$tagTablePtr{$tag};
$et->HandleTag($tagTablePtr, $tag, $val);
}
return 1;
}
#------------------------------------------------------------------------------
# Extract information from the JPEG APP0 Ocad segment
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessJPEG_HDR($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
$$dataPt =~ /~\0/g or $et->Warn('Unrecognized JPEG-HDR format'), return 0;
my $pos = pos $$dataPt;
my $meta = substr($$dataPt, 7, $pos-9);
$et->VerboseDir('APP11 JPEG-HDR', undef, length $$dataPt);
while ($meta =~ /(\w+)=([^,\s]*)/g) {
my ($tag, $val) = ($1, $2);
AddTagToTable($tagTablePtr, $tag) unless $$tagTablePtr{$tag};
$et->HandleTag($tagTablePtr, $tag, $val);
}
$et->HandleTag($tagTablePtr, 'RatioImage', substr($$dataPt, $pos));
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::JPEG - Definitions for uncommon JPEG segments
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool for some
uncommon JPEG segments. For speed reasons, definitions for more common JPEG
segments are included in the Image::ExifTool module itself.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
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/JPEG Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut

Some files were not shown because too many files have changed in this diff Show More