WriteExif.pl 164 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747
  1. #------------------------------------------------------------------------------
  2. # File: WriteExif.pl
  3. #
  4. # Description: Write EXIF meta information
  5. #
  6. # Revisions: 12/13/2004 - P. Harvey Created
  7. #------------------------------------------------------------------------------
  8. package Image::ExifTool::Exif;
  9. use strict;
  10. use vars qw($VERSION $AUTOLOAD @formatSize @formatName %formatNumber
  11. %compression %photometricInterpretation %orientation);
  12. use Image::ExifTool::Fixup;
  13. sub InsertWritableProperties($$;$);
  14. # some information may be stored in different IFD's with the same meaning.
  15. # Use this lookup to decide when we should delete information that is stored
  16. # in another IFD when we write it to the preferred IFD.
  17. my %crossDelete = (
  18. ExifIFD => 'IFD0',
  19. IFD0 => 'ExifIFD',
  20. );
  21. # mandatory tag default values
  22. my %mandatory = (
  23. IFD0 => {
  24. 0x011a => 72, # XResolution
  25. 0x011b => 72, # YResolution
  26. 0x0128 => 2, # ResolutionUnit (inches)
  27. 0x0213 => 1, # YCbCrPositioning (centered)
  28. # 0x8769 => ????, # ExifOffset
  29. },
  30. IFD1 => {
  31. 0x0103 => 6, # Compression (JPEG)
  32. 0x011a => 72, # XResolution
  33. 0x011b => 72, # YResolution
  34. 0x0128 => 2, # ResolutionUnit (inches)
  35. },
  36. ExifIFD => {
  37. 0x9000 => '0230', # ExifVersion
  38. 0x9101 => "1 2 3 0",# ComponentsConfiguration
  39. 0xa000 => '0100', # FlashpixVersion
  40. 0xa001 => 0xffff, # ColorSpace (uncalibrated)
  41. # 0xa002 => ????, # ExifImageWidth
  42. # 0xa003 => ????, # ExifImageHeight
  43. },
  44. GPS => {
  45. 0x0000 => '2 3 0 0',# GPSVersionID
  46. },
  47. InteropIFD => {
  48. 0x0002 => '0100', # InteropVersion
  49. },
  50. );
  51. # The main EXIF table is unique because the tags from this table may appear
  52. # in many different directories. For this reason, we introduce a
  53. # "WriteGroup" member to the tagInfo that tells us the preferred location
  54. # for writing each tag. Here is the lookup for Writable flag (format)
  55. # and WriteGroup for all writable tags
  56. # - WriteGroup is ExifIFD unless otherwise specified
  57. # - Protected is 1 if the tag shouldn't be copied with SetNewValuesFromFile()
  58. my %writeTable = (
  59. 0x0001 => { # InteropIndex
  60. Protected => 1,
  61. Writable => 'string',
  62. WriteGroup => 'InteropIFD',
  63. },
  64. 0x0002 => { # InteropVersion
  65. Protected => 1,
  66. Writable => 'undef',
  67. Mandatory => 1,
  68. WriteGroup => 'InteropIFD',
  69. },
  70. 0x000b => { # ProcessingSoftware
  71. Writable => 'string',
  72. WriteGroup => 'IFD0',
  73. },
  74. 0x00fe => { # SubfileType
  75. Protected => 1,
  76. Writable => 'int32u',
  77. WriteGroup => 'IFD0',
  78. },
  79. 0x00ff => { # OldSubfileType
  80. Protected => 1,
  81. Writable => 'int16u',
  82. WriteGroup => 'IFD0',
  83. },
  84. 0x0100 => { # ImageWidth
  85. Protected => 1,
  86. Writable => 'int32u',
  87. WriteGroup => 'IFD0',
  88. },
  89. 0x0101 => { # ImageHeight
  90. Protected => 1,
  91. Writable => 'int32u',
  92. WriteGroup => 'IFD0',
  93. },
  94. 0x0102 => { # BitsPerSample
  95. Protected => 1,
  96. Writable => 'int16u',
  97. WriteGroup => 'IFD0',
  98. Count => -1, # can be 1 or 3: -1 means 'variable'
  99. },
  100. 0x0103 => { # Compression
  101. Protected => 1,
  102. Writable => 'int16u',
  103. WriteGroup => 'IFD0',
  104. Mandatory => 1,
  105. },
  106. 0x0106 => { # PhotometricInterpretation
  107. Protected => 1,
  108. Writable => 'int16u',
  109. WriteGroup => 'IFD0',
  110. },
  111. 0x0107 => { # Thresholding
  112. Protected => 1,
  113. Writable => 'int16u',
  114. WriteGroup => 'IFD0',
  115. },
  116. 0x0108 => { # CellWidth
  117. Protected => 1,
  118. Writable => 'int16u',
  119. WriteGroup => 'IFD0',
  120. },
  121. 0x0109 => { # CellLength
  122. Protected => 1,
  123. Writable => 'int16u',
  124. WriteGroup => 'IFD0',
  125. },
  126. 0x010a => { # FillOrder
  127. Protected => 1,
  128. Writable => 'int16u',
  129. WriteGroup => 'IFD0',
  130. },
  131. 0x010d => { # DocumentName
  132. Writable => 'string',
  133. WriteGroup => 'IFD0',
  134. },
  135. 0x010e => { # ImageDescription
  136. Writable => 'string',
  137. WriteGroup => 'IFD0',
  138. },
  139. 0x010f => { # Make
  140. Writable => 'string',
  141. WriteGroup => 'IFD0',
  142. },
  143. 0x0110 => { # Model
  144. Writable => 'string',
  145. WriteGroup => 'IFD0',
  146. },
  147. 0x0112 => { # Orientation
  148. Writable => 'int16u',
  149. WriteGroup => 'IFD0',
  150. },
  151. 0x0115 => { # SamplesPerPixel
  152. Protected => 1,
  153. Writable => 'int16u',
  154. WriteGroup => 'IFD0',
  155. },
  156. 0x0116 => { # RowsPerStrip
  157. Protected => 1,
  158. Writable => 'int32u',
  159. WriteGroup => 'IFD0',
  160. },
  161. 0x0118 => { # MinSampleValue
  162. Writable => 'int16u',
  163. WriteGroup => 'IFD0',
  164. },
  165. 0x0119 => { # MaxSampleValue
  166. Writable => 'int16u',
  167. WriteGroup => 'IFD0',
  168. },
  169. 0x011a => { # XResolution
  170. Writable => 'rational64u',
  171. WriteGroup => 'IFD0',
  172. Mandatory => 1,
  173. },
  174. 0x011b => { # YResolution
  175. Writable => 'rational64u',
  176. WriteGroup => 'IFD0',
  177. Mandatory => 1,
  178. },
  179. 0x011c => { # PlanarConfiguration
  180. Protected => 1,
  181. Writable => 'int16u',
  182. WriteGroup => 'IFD0',
  183. },
  184. 0x011d => { # PageName
  185. Writable => 'string',
  186. WriteGroup => 'IFD0',
  187. },
  188. 0x011e => { # XPosition
  189. Writable => 'rational64u',
  190. WriteGroup => 'IFD0',
  191. },
  192. 0x011f => { # YPosition
  193. Writable => 'rational64u',
  194. WriteGroup => 'IFD0',
  195. },
  196. 0x0122 => { # GrayResponseUnit
  197. Writable => 'int16u',
  198. WriteGroup => 'IFD0',
  199. },
  200. 0x0128 => { # ResolutionUnit
  201. Writable => 'int16u',
  202. WriteGroup => 'IFD0',
  203. Mandatory => 1,
  204. },
  205. 0x0129 => { # PageNumber
  206. Writable => 'int16u',
  207. WriteGroup => 'IFD0',
  208. Count => 2,
  209. },
  210. 0x012d => { # TransferFunction
  211. Protected => 1,
  212. Writable => 'int16u',
  213. WriteGroup => 'IFD0',
  214. Count => 768,
  215. },
  216. 0x0131 => { # Software
  217. Writable => 'string',
  218. WriteGroup => 'IFD0',
  219. },
  220. 0x0132 => { # ModifyDate
  221. Writable => 'string',
  222. Shift => 'Time',
  223. WriteGroup => 'IFD0',
  224. PrintConvInv => '$self->InverseDateTime($val,0)',
  225. },
  226. 0x013b => { # Artist
  227. Writable => 'string',
  228. WriteGroup => 'IFD0',
  229. },
  230. 0x013c => { # HostComputer
  231. Writable => 'string',
  232. WriteGroup => 'IFD0',
  233. },
  234. 0x013d => { # Predictor
  235. Protected => 1,
  236. Writable => 'int16u',
  237. WriteGroup => 'IFD0',
  238. },
  239. 0x013e => { # WhitePoint
  240. Writable => 'rational64u',
  241. WriteGroup => 'IFD0',
  242. Count => 2,
  243. },
  244. 0x013f => { # PrimaryChromaticities
  245. Writable => 'rational64u',
  246. WriteGroup => 'IFD0',
  247. Count => 6,
  248. },
  249. 0x0141 => { # HalftoneHints
  250. Writable => 'int16u',
  251. WriteGroup => 'IFD0',
  252. Count => 2,
  253. },
  254. 0x0142 => { # TileWidth
  255. Protected => 1,
  256. Writable => 'int32u',
  257. WriteGroup => 'IFD0',
  258. },
  259. 0x0143 => { # TileLength
  260. Protected => 1,
  261. Writable => 'int32u',
  262. WriteGroup => 'IFD0',
  263. },
  264. 0x014c => { # InkSet
  265. Writable => 'int16u',
  266. WriteGroup => 'IFD0',
  267. },
  268. 0x0150 => { # TargetPrinter
  269. Writable => 'string',
  270. WriteGroup => 'IFD0',
  271. },
  272. 0x013c => { # HostComputer
  273. Writable => 'string',
  274. WriteGroup => 'IFD0',
  275. },
  276. 0x0211 => { # YCbCrCoefficients
  277. Protected => 1,
  278. Writable => 'rational64u',
  279. WriteGroup => 'IFD0',
  280. Count => 3,
  281. },
  282. 0x0212 => { # YCbCrSubSampling
  283. Protected => 1,
  284. Writable => 'int16u',
  285. WriteGroup => 'IFD0',
  286. Count => 2,
  287. },
  288. 0x0213 => { # YCbCrPositioning
  289. Protected => 1,
  290. Writable => 'int16u',
  291. WriteGroup => 'IFD0',
  292. Mandatory => 1,
  293. },
  294. 0x0214 => { # ReferenceBlackWhite
  295. Writable => 'rational64u',
  296. WriteGroup => 'IFD0',
  297. Count => 6,
  298. },
  299. 0x1000 => { # RelatedImageFileFormat
  300. Protected => 1,
  301. Writable => 'string',
  302. WriteGroup => 'InteropIFD',
  303. },
  304. 0x1001 => { # RelatedImageWidth
  305. Protected => 1,
  306. Writable => 'int16u',
  307. WriteGroup => 'InteropIFD',
  308. },
  309. 0x1002 => { # RelatedImageHeight (more commonly RelatedImageLength)
  310. Protected => 1,
  311. Writable => 'int16u',
  312. WriteGroup => 'InteropIFD',
  313. },
  314. 0x4746 => { # Rating (MicrosoftPhoto)
  315. Writable => 'int16u',
  316. WriteGroup => 'IFD0',
  317. Avoid => 1,
  318. },
  319. 0x4749 => { # RatingPercent (MicrosoftPhoto)
  320. Writable => 'int16u',
  321. WriteGroup => 'IFD0',
  322. Avoid => 1,
  323. },
  324. 0x828d => { # CFARepeatPatternDim
  325. Protected => 1,
  326. Writable => 'int16u',
  327. WriteGroup => 'SubIFD',
  328. Count => 2,
  329. },
  330. 0x828e => { # CFAPattern2
  331. Protected => 1,
  332. Writable => 'int8u',
  333. WriteGroup => 'SubIFD',
  334. Count => -1,
  335. },
  336. 0x8298 => { # Copyright
  337. Writable => 'string',
  338. WriteGroup => 'IFD0',
  339. RawConvInv => '$val . "\0"',
  340. PrintConvInv => sub {
  341. my ($val, $self) = @_;
  342. # encode if necessary
  343. my $enc = $self->Options('CharsetEXIF');
  344. $val = $self->Encode($val,$enc) if $enc and $val !~ /\0/;
  345. if ($val =~ /(.*?)\s*[\n\r]+\s*(.*)/s) {
  346. return $1 unless length $2;
  347. # photographer copyright set to ' ' if it doesn't exist, according to spec.
  348. return((length($1) ? $1 : ' ') . "\0" . $2);
  349. }
  350. return $val;
  351. },
  352. },
  353. #
  354. # Most of the tags below this belong in the ExifIFD...
  355. #
  356. 0x829a => { # ExposureTime
  357. Writable => 'rational64u',
  358. PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
  359. },
  360. 0x829d => { # FNumber
  361. Writable => 'rational64u',
  362. PrintConvInv => '$val',
  363. },
  364. 0x8546 => { # SEMInfo
  365. Writable => 'string',
  366. WriteGroup => 'IFD0',
  367. },
  368. 0x87af => { # GeoTiffDirectory
  369. Writable => 'undef',
  370. WriteGroup => 'IFD0',
  371. # swap byte order if necessary
  372. RawConvInv => q{
  373. return $val if length $val < 2;
  374. my $order = substr($val, -2);
  375. return $val unless $order eq 'II' or $order eq 'MM';
  376. $val = substr($val, 0, -2);
  377. return $val if $order eq GetByteOrder();
  378. return pack('v*',unpack('n*',$val));
  379. },
  380. },
  381. 0x87b0 => { # GeoTiffDoubleParams
  382. Writable => 'undef',
  383. WriteGroup => 'IFD0',
  384. # swap byte order if necessary
  385. RawConvInv => q{
  386. return $val if length $val < 2;
  387. my $order = substr($val, -2);
  388. return $val unless $order eq 'II' or $order eq 'MM';
  389. $val = substr($val, 0, -2);
  390. return $val if $order eq GetByteOrder();
  391. $val =~ s/(.{4})(.{4})/$2$1/sg; # swap words
  392. return pack('V*',unpack('N*',$val));
  393. },
  394. },
  395. 0x87b1 => { # GeoTiffAsciiParams
  396. Writable => 'string',
  397. WriteGroup => 'IFD0',
  398. },
  399. 0x8822 => 'int16u', # ExposureProgram
  400. 0x8824 => 'string', # SpectralSensitivity
  401. 0x8827 => { # ISO
  402. Writable => 'int16u',
  403. Count => -1,
  404. PrintConvInv => '$val=~tr/,//d; $val',
  405. },
  406. 0x882a => { # TimeZoneOffset
  407. Writable => 'int16s',
  408. Count => -1, # can be 1 or 2
  409. Notes => q{
  410. 1 or 2 values: 1. The time zone offset of DateTimeOriginal from GMT in
  411. hours, 2. If present, the time zone offset of ModifyDate
  412. },
  413. },
  414. 0x882b => 'int16u', # SelfTimerMode
  415. 0x8830 => 'int16u', # SensitivityType
  416. 0x8831 => 'int32u', # StandardOutputSensitivity
  417. 0x8832 => 'int32u', # RecommendedExposureIndex
  418. 0x8833 => 'int32u', # ISOSpeed
  419. 0x8834 => 'int32u', # ISOSpeedLatitudeyyy
  420. 0x8835 => 'int32u', # ISOSpeedLatitudezzz
  421. 0x9000 => { # ExifVersion
  422. Writable => 'undef',
  423. Mandatory => 1,
  424. PrintConvInv => '$val=~tr/.//d; $val=~/^\d{4}$/ ? $val : undef',
  425. },
  426. 0x9003 => { # DateTimeOriginal
  427. Writable => 'string',
  428. Shift => 'Time',
  429. PrintConvInv => '$self->InverseDateTime($val,0)',
  430. },
  431. 0x9004 => { # CreateDate
  432. Writable => 'string',
  433. Shift => 'Time',
  434. PrintConvInv => '$self->InverseDateTime($val,0)',
  435. },
  436. 0x9009 => 'undef', # GooglePlusUploadCode
  437. 0x9101 => { # ComponentsConfiguration
  438. Protected => 1,
  439. Writable => 'undef',
  440. Count => 4,
  441. Mandatory => 1,
  442. ValueConvInv => '$val=~tr/,//d; $val', # (so we can copy from XMP with -n)
  443. },
  444. 0x9102 => { # CompressedBitsPerPixel
  445. Protected => 1,
  446. Writable => 'rational64u',
  447. },
  448. 0x9201 => { # ShutterSpeedValue
  449. Writable => 'rational64s',
  450. ValueConvInv => '$val>0 ? -log($val)/log(2) : -100',
  451. PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
  452. },
  453. 0x9202 => { # ApertureValue
  454. Writable => 'rational64u',
  455. ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
  456. PrintConvInv => '$val',
  457. },
  458. 0x9203 => 'rational64s',# BrightnessValue
  459. 0x9204 => { # ExposureCompensation
  460. Writable => 'rational64s',
  461. PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
  462. },
  463. 0x9205 => { # MaxApertureValue
  464. Writable => 'rational64u',
  465. ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
  466. PrintConvInv => '$val',
  467. },
  468. 0x9206 => { # SubjectDistance
  469. Writable => 'rational64u',
  470. PrintConvInv => '$val=~s/\s*m$//;$val',
  471. },
  472. 0x9207 => 'int16u', # MeteringMode
  473. 0x9208 => 'int16u', # LightSource
  474. 0x9209 => 'int16u', # Flash
  475. 0x920a => { # FocalLength
  476. Writable => 'rational64u',
  477. PrintConvInv => '$val=~s/\s*mm$//;$val',
  478. },
  479. 0x9211 => 'int32u', # ImageNumber
  480. 0x9212 => 'string', # SecurityClassification
  481. 0x9213 => 'string', # ImageHistory
  482. 0x9214 => { # SubjectArea
  483. Writable => 'int16u',
  484. Count => -1, # 2, 3 or 4 values
  485. },
  486. # 0x927c => 'undef', # MakerNotes
  487. 0x9286 => { # UserComment
  488. Writable => 'undef',
  489. # (starts with "ASCII\0\0\0", "UNICODE\0", "JIS\0\0\0\0\0" or "\0\0\0\0\0\0\0\0")
  490. RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)',
  491. # SHOULD ADD SPECIAL LOGIC TO ALLOW CONDITIONAL OVERWRITE OF
  492. # "UNKNOWN" VALUES FILLED WITH SPACES
  493. },
  494. 0x9290 => { # SubSecTime
  495. Writable => 'string',
  496. # extract fractional seconds from a full date/time value
  497. ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)',
  498. },
  499. 0x9291 => { # SubSecTimeOriginal
  500. Writable => 'string',
  501. ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)',
  502. },
  503. 0x9292 => { # SubSecTimeDigitized
  504. Writable => 'string',
  505. ValueConvInv => '$val=~/^(\d+)\s*$/ ? $1 : ($val=~/\.(\d+)/ ? $1 : undef)',
  506. },
  507. 0x935c => { # ImageSourceData
  508. Writable => 'undef',
  509. WriteGroup => 'IFD0',
  510. Protected => 1,
  511. },
  512. # 0x9928 => 'undef', # Opto-ElectricConversionFactor
  513. 0x9c9b => { # XPTitle
  514. Writable => 'int8u',
  515. WriteGroup => 'IFD0',
  516. Notes => q{
  517. tags 0x9c9b-0x9c9f are used by Windows Explorer; special characters
  518. in these values are converted to UTF-8 by default, or Windows Latin1
  519. with the -L option. XPTitle is ignored by Windows Explorer if
  520. ImageDescription exists
  521. },
  522. ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"',
  523. },
  524. 0x9c9c => { # XPComment
  525. Writable => 'int8u',
  526. WriteGroup => 'IFD0',
  527. ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"',
  528. },
  529. 0x9c9d => { # XPAuthor
  530. Writable => 'int8u',
  531. WriteGroup => 'IFD0',
  532. Notes => 'ignored by Windows Explorer if Artist exists',
  533. ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"',
  534. },
  535. 0x9c9e => { # XPKeywords
  536. Writable => 'int8u',
  537. WriteGroup => 'IFD0',
  538. ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"',
  539. },
  540. 0x9c9f => { # XPSubject
  541. Writable => 'int8u',
  542. WriteGroup => 'IFD0',
  543. ValueConvInv => '$self->Encode($val,"UCS2","II") . "\0\0"',
  544. },
  545. 0xa000 => { # FlashpixVersion
  546. Writable => 'undef',
  547. Mandatory => 1,
  548. PrintConvInv => '$val=~tr/.//d; $val=~/^\d{4}$/ ? $val : undef',
  549. },
  550. 0xa001 => { # ColorSpace
  551. Writable => 'int16u',
  552. Mandatory => 1,
  553. },
  554. 0xa002 => { # ExifImageWidth (could also be int32u)
  555. Writable => 'int16u',
  556. Mandatory => 1,
  557. },
  558. 0xa003 => { # ExifImageHeight (could also be int32u)
  559. Writable => 'int16u',
  560. Mandatory => 1,
  561. },
  562. 0xa004 => 'string', # RelatedSoundFile
  563. 0xa20b => { # FlashEnergy
  564. Writable => 'rational64u',
  565. Count => -1, # 1 or 2 (ref 12)
  566. },
  567. # 0xa20c => 'undef', # SpatialFrequencyResponse
  568. 0xa20e => 'rational64u',# FocalPlaneXResolution
  569. 0xa20f => 'rational64u',# FocalPlaneYResolution
  570. 0xa210 => 'int16u', # FocalPlaneResolutionUnit
  571. 0xa214 => { # SubjectLocation
  572. Writable => 'int16u',
  573. Count => 2,
  574. },
  575. 0xa215 => 'rational64u',# ExposureIndex
  576. 0xa217 => 'int16u', # SensingMethod
  577. 0xa300 => { # FileSource
  578. Writable => 'undef',
  579. ValueConvInv => '($val=~/^\d+$/ and $val < 256) ? chr($val) : $val',
  580. },
  581. 0xa301 => { # SceneType
  582. Writable => 'undef',
  583. ValueConvInv => 'chr($val)',
  584. },
  585. 0xa302 => { # CFAPattern
  586. Writable => 'undef',
  587. RawConvInv => q{
  588. my @a = split ' ', $val;
  589. return $val if @a <= 2; # also accept binary data for backward compatibility
  590. return pack(GetByteOrder() eq 'II' ? 'v2C*' : 'n2C*', @a);
  591. },
  592. PrintConvInv => 'Image::ExifTool::Exif::GetCFAPattern($val)',
  593. },
  594. 0xa401 => 'int16u', # CustomRendered
  595. 0xa402 => 'int16u', # ExposureMode
  596. 0xa403 => 'int16u', # WhiteBalance
  597. 0xa404 => 'rational64u',# DigitalZoomRatio
  598. 0xa405 => { # FocalLengthIn35mmFormat
  599. Writable => 'int16u',
  600. PrintConvInv => '$val=~s/\s*mm$//;$val',
  601. },
  602. 0xa406 => 'int16u', # SceneCaptureType
  603. 0xa407 => 'int16u', # GainControl
  604. 0xa408 => { # Contrast
  605. Writable => 'int16u',
  606. PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)',
  607. },
  608. 0xa409 => { # Saturation
  609. Writable => 'int16u',
  610. PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)',
  611. },
  612. 0xa40a => { # Sharpness
  613. Writable => 'int16u',
  614. PrintConvInv => 'Image::ExifTool::Exif::ConvertParameter($val)',
  615. },
  616. # 0xa40b => 'undef', # DeviceSettingDescription
  617. 0xa40c => 'int16u', # SubjectDistanceRange
  618. 0xa420 => 'string', # ImageUniqueID
  619. 0xa430 => 'string', # OwnerName
  620. 0xa431 => 'string', # SerialNumber
  621. 0xa432 => { # LensInfo
  622. Writable => 'rational64u',
  623. Count => 4,
  624. PrintConvInv => \&ConvertLensInfo,
  625. },
  626. 0xa433 => 'string', # LensMake
  627. 0xa434 => 'string', # LensModel
  628. 0xa435 => 'string', # LensSerialNumber
  629. 0xa500 => 'rational64u',# Gamma
  630. #
  631. # DNG stuff (mostly in IFD0, "Raw IFD" in SubIFD)
  632. #
  633. 0xc612 => { # DNGVersion
  634. Writable => 'int8u',
  635. WriteGroup => 'IFD0',
  636. Count => 4,
  637. Protected => 1, # (confuses Apple Preview if written to a TIFF image)
  638. PrintConvInv => '$val =~ tr/./ /; $val',
  639. },
  640. 0xc613 => { # DNGBackwardVersion
  641. Writable => 'int8u',
  642. WriteGroup => 'IFD0',
  643. Count => 4,
  644. Protected => 1,
  645. PrintConvInv => '$val =~ tr/./ /; $val',
  646. },
  647. 0xc614 => { # UniqueCameraModel
  648. Writable => 'string',
  649. WriteGroup => 'IFD0',
  650. },
  651. 0xc615 => { # LocalizedCameraModel
  652. Writable => 'string',
  653. WriteGroup => 'IFD0',
  654. PrintConvInv => '$val',
  655. },
  656. 0xc618 => { # LinearizationTable
  657. Writable => 'int16u',
  658. WriteGroup => 'SubIFD',
  659. Count => -1,
  660. Protected => 1,
  661. },,
  662. 0xc619 => { # BlackLevelRepeatDim
  663. Writable => 'int16u',
  664. WriteGroup => 'SubIFD',
  665. Count => 2,
  666. Protected => 1,
  667. },
  668. 0xc61a => { # BlackLevel
  669. Writable => 'rational64u',
  670. WriteGroup => 'SubIFD',
  671. Count => -1,
  672. Protected => 1,
  673. },
  674. 0xc61b => { # BlackLevelDeltaH
  675. Writable => 'rational64s',
  676. WriteGroup => 'SubIFD',
  677. Count => -1,
  678. Protected => 1,
  679. },
  680. 0xc61c => { # BlackLevelDeltaV
  681. Writable => 'rational64s',
  682. WriteGroup => 'SubIFD',
  683. Count => -1,
  684. Protected => 1,
  685. },
  686. 0xc61d => { # WhiteLevel
  687. Writable => 'int32u',
  688. WriteGroup => 'SubIFD',
  689. Count => -1,
  690. Protected => 1,
  691. },
  692. 0xc61e => { # DefaultScale
  693. Writable => 'rational64u',
  694. WriteGroup => 'SubIFD',
  695. Count => 2,
  696. Protected => 1,
  697. },
  698. 0xc61f => { # DefaultCropOrigin
  699. Writable => 'int32u',
  700. WriteGroup => 'SubIFD',
  701. Count => 2,
  702. Protected => 1,
  703. },
  704. 0xc620 => { # DefaultCropSize
  705. Writable => 'int32u',
  706. WriteGroup => 'SubIFD',
  707. Count => 2,
  708. Protected => 1,
  709. },
  710. 0xc621 => { # ColorMatrix1
  711. Writable => 'rational64s',
  712. WriteGroup => 'IFD0',
  713. Count => -1,
  714. Protected => 1,
  715. },
  716. 0xc622 => { # ColorMatrix2
  717. Writable => 'rational64s',
  718. WriteGroup => 'IFD0',
  719. Count => -1,
  720. Protected => 1,
  721. },
  722. 0xc623 => { # CameraCalibration1
  723. Writable => 'rational64s',
  724. WriteGroup => 'IFD0',
  725. Count => -1,
  726. Protected => 1,
  727. },
  728. 0xc624 => { # CameraCalibration2
  729. Writable => 'rational64s',
  730. WriteGroup => 'IFD0',
  731. Count => -1,
  732. Protected => 1,
  733. },
  734. 0xc625 => { # ReductionMatrix1
  735. Writable => 'rational64s',
  736. WriteGroup => 'IFD0',
  737. Count => -1,
  738. Protected => 1,
  739. },
  740. 0xc626 => { # ReductionMatrix2
  741. Writable => 'rational64s',
  742. WriteGroup => 'IFD0',
  743. Count => -1,
  744. Protected => 1,
  745. },
  746. 0xc627 => { # AnalogBalance
  747. Writable => 'rational64u',
  748. WriteGroup => 'IFD0',
  749. Count => -1,
  750. Protected => 1,
  751. },
  752. 0xc628 => { # AsShotNeutral
  753. Writable => 'rational64u',
  754. WriteGroup => 'IFD0',
  755. Count => -1,
  756. Protected => 1,
  757. },
  758. 0xc629 => { # AsShotWhiteXY
  759. Writable => 'rational64u',
  760. WriteGroup => 'IFD0',
  761. Count => 2,
  762. Protected => 1,
  763. },
  764. 0xc62a => { # BaselineExposure
  765. Writable => 'rational64s',
  766. WriteGroup => 'IFD0',
  767. Protected => 1,
  768. },
  769. 0xc62b => { # BaselineNoise
  770. Writable => 'rational64u',
  771. WriteGroup => 'IFD0',
  772. Protected => 1,
  773. },
  774. 0xc62c => { # BaselineSharpness
  775. Writable => 'rational64u',
  776. WriteGroup => 'IFD0',
  777. Protected => 1,
  778. },
  779. 0xc62d => { # BayerGreenSplit
  780. Writable => 'int32u',
  781. WriteGroup => 'SubIFD',
  782. Protected => 1,
  783. },
  784. 0xc62e => { # LinearResponseLimit
  785. Writable => 'rational64u',
  786. WriteGroup => 'IFD0',
  787. Protected => 1,
  788. },
  789. 0xc62f => { # CameraSerialNumber
  790. Writable => 'string',
  791. WriteGroup => 'IFD0',
  792. },
  793. 0xc630 => { # DNGLensInfo
  794. Writable => 'rational64u',
  795. WriteGroup => 'IFD0',
  796. Count => 4,
  797. PrintConvInv => \&ConvertLensInfo,
  798. },
  799. 0xc631 => { # ChromaBlurRadius
  800. Writable => 'rational64u',
  801. WriteGroup => 'SubIFD',
  802. Protected => 1,
  803. },
  804. 0xc632 => { # AntiAliasStrength
  805. Writable => 'rational64u',
  806. WriteGroup => 'SubIFD',
  807. Protected => 1,
  808. },
  809. 0xc633 => { # ShadowScale
  810. Writable => 'rational64u',
  811. WriteGroup => 'IFD0',
  812. Protected => 1,
  813. },
  814. 0xc635 => { # MakerNoteSafety
  815. Writable => 'int16u',
  816. WriteGroup => 'IFD0',
  817. },
  818. 0xc65a => { # CalibrationIlluminant1
  819. Writable => 'int16u',
  820. WriteGroup => 'IFD0',
  821. Protected => 1,
  822. },
  823. 0xc65b => { # CalibrationIlluminant2
  824. Writable => 'int16u',
  825. WriteGroup => 'IFD0',
  826. Protected => 1,
  827. },
  828. 0xc65c => { # BestQualityScale
  829. Writable => 'rational64u',
  830. WriteGroup => 'SubIFD',
  831. Protected => 1,
  832. },
  833. 0xc65d => { # RawDataUniqueID
  834. Writable => 'int8u',
  835. WriteGroup => 'IFD0',
  836. Count => 16,
  837. Count => 16,
  838. ValueConvInv => 'pack("H*", $val)',
  839. Protected => 1,
  840. },
  841. 0xc68b => { # OriginalRawFileName
  842. Writable => 'string',
  843. WriteGroup => 'IFD0',
  844. Protected => 1,
  845. },
  846. 0xc68d => { # ActiveArea
  847. Writable => 'int32u',
  848. WriteGroup => 'SubIFD',
  849. Count => 4,
  850. Protected => 1,
  851. },
  852. 0xc68e => { # MaskedAreas
  853. Writable => 'int32u',
  854. WriteGroup => 'SubIFD',
  855. Count => 4,
  856. Protected => 1,
  857. },
  858. 0xc68f => { # AsShotICCProfile (writable directory)
  859. WriteGroup => 'IFD0',
  860. Protected => 1,
  861. WriteCheck => q{
  862. require Image::ExifTool::ICC_Profile;
  863. return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
  864. },
  865. },
  866. 0xc690 => { # AsShotPreProfileMatrix
  867. Writable => 'rational64s',
  868. WriteGroup => 'IFD0',
  869. Count => -1,
  870. Protected => 1,
  871. },
  872. 0xc691 => { # CurrentICCProfile (writable directory)
  873. Writable => 'undef',
  874. WriteGroup => 'IFD0',
  875. Protected => 1,
  876. WriteCheck => q{
  877. require Image::ExifTool::ICC_Profile;
  878. return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
  879. },
  880. },
  881. 0xc692 => { # CurrentPreProfileMatrix
  882. Writable => 'rational64s',
  883. WriteGroup => 'IFD0',
  884. Count => -1,
  885. Protected => 1,
  886. },
  887. 0xc6bf => { # ColorimetricReference
  888. Writable => 'int16u',
  889. WriteGroup => 'IFD0',
  890. Protected => 1,
  891. },
  892. 0xc6d2 => { # PanasonicTitle (Panasonic DMC-TZ5, not a DNG tag)
  893. Writable => 'undef',
  894. WriteGroup => 'IFD0',
  895. ValueConvInv => '$self->Encode($val,"UTF8")',
  896. },
  897. 0xc6d3 => { # PanasonicTitle2 (Panasonic DMC-FS7, not a DNG tag)
  898. Writable => 'undef',
  899. WriteGroup => 'IFD0',
  900. ValueConvInv => '$self->Encode($val,"UTF8")',
  901. },
  902. 0xc6f3 => { # CameraCalibrationSig
  903. Writable => 'string',
  904. WriteGroup => 'IFD0',
  905. Protected => 1,
  906. },
  907. 0xc6f4 => { # ProfileCalibrationSig
  908. Writable => 'string',
  909. WriteGroup => 'IFD0',
  910. Protected => 1,
  911. },
  912. 0xc6f6 => { # AsShotProfileName
  913. Writable => 'string',
  914. WriteGroup => 'IFD0',
  915. Protected => 1,
  916. },
  917. 0xc6f7 => { # NoiseReductionApplied
  918. Writable => 'rational64u',
  919. WriteGroup => 'SubIFD',
  920. Protected => 1,
  921. },
  922. 0xc6f8 => { # ProfileName
  923. Writable => 'string',
  924. WriteGroup => 'IFD0',
  925. Protected => 1,
  926. },
  927. 0xc6f9 => { # ProfileHueSatMapDims
  928. Writable => 'int32u',
  929. WriteGroup => 'IFD0',
  930. Count => 3,
  931. Protected => 1,
  932. },
  933. 0xc6fa => { # ProfileHueSatMapData1
  934. Writable => 'float',
  935. WriteGroup => 'IFD0',
  936. Count => -1,
  937. Protected => 1,
  938. },
  939. 0xc6fb => { # ProfileHueSatMapData2
  940. Writable => 'float',
  941. WriteGroup => 'IFD0',
  942. Count => -1,
  943. Protected => 1,
  944. },
  945. 0xc6fc => { # ProfileToneCurve
  946. Writable => 'float',
  947. WriteGroup => 'IFD0',
  948. Count => -1,
  949. Protected => 1,
  950. },
  951. 0xc6fd => { # ProfileEmbedPolicy
  952. Writable => 'int32u',
  953. WriteGroup => 'IFD0',
  954. Protected => 1,
  955. },
  956. 0xc6fe => { # ProfileCopyright
  957. Writable => 'string',
  958. WriteGroup => 'IFD0',
  959. Protected => 1,
  960. },
  961. 0xc714 => { # ForwardMatrix1
  962. Writable => 'rational64s',
  963. WriteGroup => 'IFD0',
  964. Count => -1,
  965. Protected => 1,
  966. },
  967. 0xc715 => { # ForwardMatrix2
  968. Writable => 'rational64s',
  969. WriteGroup => 'IFD0',
  970. Count => -1,
  971. Protected => 1,
  972. },
  973. 0xc716 => { # PreviewApplicationName
  974. Writable => 'string',
  975. WriteGroup => 'IFD0',
  976. Protected => 1,
  977. },
  978. 0xc717 => { # PreviewApplicationVersion
  979. Writable => 'string',
  980. WriteGroup => 'IFD0',
  981. Protected => 1,
  982. },
  983. 0xc718 => { # PreviewSettingsName
  984. Writable => 'string',
  985. WriteGroup => 'IFD0',
  986. Protected => 1,
  987. },
  988. 0xc719 => { # PreviewSettingsDigest
  989. Writable => 'int8u',
  990. WriteGroup => 'IFD0',
  991. Protected => 1,
  992. ValueConvInv => 'pack("H*", $val)',
  993. },
  994. 0xc71a => { # PreviewColorSpace
  995. Writable => 'int32u',
  996. WriteGroup => 'IFD0',
  997. Protected => 1,
  998. PrintConv => {
  999. 0 => 'Unknown',
  1000. 1 => 'Gray Gamma 2.2',
  1001. 2 => 'sRGB',
  1002. 3 => 'Adobe RGB',
  1003. 4 => 'ProPhoto RGB',
  1004. },
  1005. },
  1006. 0xc71b => { # PreviewDateTime
  1007. Writable => 'string',
  1008. WriteGroup => 'IFD0',
  1009. Protected => 1,
  1010. ValueConvInv => q{
  1011. require Image::ExifTool::XMP;
  1012. return Image::ExifTool::XMP::FormatXMPDate($val);
  1013. },
  1014. PrintConvInv => '$self->InverseDateTime($val,1,1)',
  1015. },
  1016. 0xc71c => { # RawImageDigest
  1017. Writable => 'int8u',
  1018. WriteGroup => 'IFD0',
  1019. Count => 16,
  1020. Protected => 1,
  1021. ValueConvInv => 'pack("H*", $val)',
  1022. },
  1023. 0xc71d => { # OriginalRawFileDigest
  1024. Writable => 'int8u',
  1025. WriteGroup => 'IFD0',
  1026. Count => 16,
  1027. Protected => 1,
  1028. ValueConvInv => 'pack("H*", $val)',
  1029. },
  1030. 0xc725 => { # ProfileLookTableDims
  1031. Writable => 'int32u',
  1032. WriteGroup => 'IFD0',
  1033. Count => 3,
  1034. Protected => 1,
  1035. },
  1036. 0xc726 => { # ProfileLookTableData
  1037. Writable => 'float',
  1038. WriteGroup => 'IFD0',
  1039. Count => -1,
  1040. Protected => 1,
  1041. },
  1042. 0xc761 => { # NoiseProfile
  1043. Writable => 'double',
  1044. WriteGroup => 'SubIFD',
  1045. Count => -1,
  1046. Protected => 1,
  1047. },
  1048. 0xc763 => { # TimeCodes
  1049. Writable => 'int8u',
  1050. WriteGroup => 'IFD0',
  1051. Count => -1, # (8 * number of time codes, max 10)
  1052. ValueConvInv => q{
  1053. my @a = map hex, split /[. ]+/, $val;
  1054. join ' ', @a;
  1055. },
  1056. PrintConvInv => q{
  1057. my @a = split ' ', $val;
  1058. my @v;
  1059. foreach (@a) {
  1060. my @td = reverse split /T/;
  1061. my $tz = 0x39; # default to unknown timezone
  1062. if ($td[0] =~ s/([-+])(\d+):(\d+)$//) {
  1063. if ($3 == 0) {
  1064. $tz = hex(($1 eq '-') ? $2 : 0x26 - $2);
  1065. } elsif ($3 == 30) {
  1066. if ($1 eq '-') {
  1067. $tz = $2 + 0x0a;
  1068. $tz += 0x0a if $tz > 0x0f;
  1069. } else {
  1070. $tz = 0x3f - $2;
  1071. $tz -= 0x0a if $tz < 0x3a;
  1072. }
  1073. } elsif ($3 == 45) {
  1074. $tz = 0x32 if $1 eq '+' and $2 == 12;
  1075. }
  1076. }
  1077. my @t = split /[:.]/, $td[0];
  1078. push @t, '00' while @t < 4;
  1079. my $bg;
  1080. if ($td[1]) {
  1081. # date was specified: fill in date & timezone
  1082. my @d = split /[-]/, $td[1];
  1083. next if @d < 3;
  1084. $bg = sprintf('.%.2d.%.2d.%.2d.%.2x', $d[2], $d[1], $d[0]%100, $tz);
  1085. $t[0] = sprintf('%.2x', hex($t[0]) + 0xc0); # set BGF1+BGF2
  1086. } else { # time only
  1087. $bg = '.00.00.00.00';
  1088. }
  1089. push @v, join('.', reverse(@t[0..3])) . $bg;
  1090. }
  1091. join ' ', @v;
  1092. },
  1093. },
  1094. 0xc764 => { # FrameRate
  1095. Writable => 'rational64s',
  1096. WriteGroup => 'IFD0',
  1097. PrintConvInv => '$val',
  1098. },
  1099. 0xc772 => { # TStop
  1100. Writable => 'rational64u',
  1101. WriteGroup => 'IFD0',
  1102. Count => -1, # (1 or 2)
  1103. PrintConvInv => '$val=~tr/-/ /; $val',
  1104. },
  1105. 0xc789 => { # ReelName
  1106. Writable => 'string',
  1107. WriteGroup => 'IFD0',
  1108. },
  1109. 0xc791 => { # OriginalDefaultFinalSize
  1110. Writable => 'int32u',
  1111. WriteGroup => 'IFD0',
  1112. Count => 2,
  1113. Protected => 1,
  1114. },
  1115. 0xc792 => { # OriginalBestQualitySize
  1116. Writable => 'int32u',
  1117. WriteGroup => 'IFD0',
  1118. Count => 2,
  1119. Protected => 1,
  1120. },
  1121. 0xc793 => { # OriginalDefaultCropSize
  1122. Writable => 'rational64u',
  1123. WriteGroup => 'IFD0',
  1124. Count => 2,
  1125. Protected => 1,
  1126. },
  1127. 0xc7a1 => { # CameraLabel
  1128. Writable => 'string',
  1129. WriteGroup => 'IFD0',
  1130. },
  1131. 0xc7a3 => { # ProfileHueSatMapEncoding
  1132. Writable => 'int32u',
  1133. WriteGroup => 'IFD0',
  1134. Protected => 1,
  1135. },
  1136. 0xc7a4 => { # ProfileLookTableEncoding
  1137. Writable => 'int32u',
  1138. WriteGroup => 'IFD0',
  1139. Protected => 1,
  1140. },
  1141. 0xc7a5 => { # BaselineExposureOffset
  1142. Writable => 'rational64s', # (incorrectly "RATIONAL" in DNG 1.4 spec)
  1143. WriteGroup => 'IFD0',
  1144. Protected => 1,
  1145. },
  1146. 0xc7a6 => { # DefaultBlackRender
  1147. Writable => 'int32u',
  1148. WriteGroup => 'IFD0',
  1149. Protected => 1,
  1150. },
  1151. 0xc7a7 => { # NewRawImageDigest
  1152. Writable => 'int8u',
  1153. WriteGroup => 'IFD0',
  1154. Count => 16,
  1155. Protected => 1,
  1156. ValueConvInv => 'pack("H*", $val)',
  1157. },
  1158. 0xc7a8 => { # RawToPreviewGain
  1159. Writable => 'double',
  1160. WriteGroup => 'IFD0',
  1161. Protected => 1,
  1162. },
  1163. 0xc7b5 => { # DefaultUserCrop
  1164. Writable => 'rational64u',
  1165. WriteGroup => 'SubIFD',
  1166. Count => 4,
  1167. Protected => 1,
  1168. },
  1169. # --- end DNG tags ---
  1170. 0xea1d => { # OffsetSchema
  1171. Writable => 'int32s',
  1172. },
  1173. # tags produced by Photoshop Camera RAW
  1174. # (avoid creating these tags unless there is no other option)
  1175. 0xfde8 => {
  1176. Name => 'OwnerName',
  1177. Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR images)
  1178. Avoid => 1,
  1179. PSRaw => 1,
  1180. Writable => 'string',
  1181. ValueConv => '$val=~s/^.*: //;$val',
  1182. ValueConvInv => q{"Owner's Name: $val"},
  1183. Notes => q{
  1184. tags 0xfde8-0xfdea and 0xfe4c-0xfe58 are generated by Photoshop Camera RAW.
  1185. Some names are the same as other EXIF tags, but ExifTool will avoid writing
  1186. these unless they already exist in the file
  1187. },
  1188. },
  1189. 0xfde9 => {
  1190. Name => 'SerialNumber',
  1191. Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR SubIFD)
  1192. Avoid => 1,
  1193. PSRaw => 1,
  1194. Writable => 'string',
  1195. ValueConv => '$val=~s/^.*: //;$val',
  1196. ValueConvInv => q{"Serial Number: $val"},
  1197. },
  1198. 0xfdea => {
  1199. Name => 'Lens',
  1200. Condition => '$$self{TIFF_TYPE} ne "DCR"', # (used for another purpose in Kodak DCR SubIFD)
  1201. Avoid => 1,
  1202. PSRaw => 1,
  1203. Writable => 'string',
  1204. ValueConv => '$val=~s/^.*: //;$val',
  1205. ValueConvInv => q{"Lens: $val"},
  1206. },
  1207. 0xfe4c => {
  1208. Name => 'RawFile',
  1209. Avoid => 1,
  1210. PSRaw => 1,
  1211. Writable => 'string',
  1212. ValueConv => '$val=~s/^.*: //;$val',
  1213. ValueConvInv => q{"Raw File: $val"},
  1214. },
  1215. 0xfe4d => {
  1216. Name => 'Converter',
  1217. Avoid => 1,
  1218. PSRaw => 1,
  1219. Writable => 'string',
  1220. ValueConv => '$val=~s/^.*: //;$val',
  1221. ValueConvInv => q{"Converter: $val"},
  1222. },
  1223. 0xfe4e => {
  1224. Name => 'WhiteBalance',
  1225. Avoid => 1,
  1226. PSRaw => 1,
  1227. Writable => 'string',
  1228. ValueConv => '$val=~s/^.*: //;$val',
  1229. ValueConvInv => q{"White Balance: $val"},
  1230. },
  1231. 0xfe51 => {
  1232. Name => 'Exposure',
  1233. Avoid => 1,
  1234. PSRaw => 1,
  1235. Writable => 'string',
  1236. ValueConv => '$val=~s/^.*: //;$val',
  1237. ValueConvInv => q{"Exposure: $val"},
  1238. },
  1239. 0xfe52 => {
  1240. Name => 'Shadows',
  1241. Avoid => 1,
  1242. PSRaw => 1,
  1243. Writable => 'string',
  1244. ValueConv => '$val=~s/^.*: //;$val',
  1245. ValueConvInv => q{"Shadows: $val"},
  1246. },
  1247. 0xfe53 => {
  1248. Name => 'Brightness',
  1249. Avoid => 1,
  1250. PSRaw => 1,
  1251. Writable => 'string',
  1252. ValueConv => '$val=~s/^.*: //;$val',
  1253. ValueConvInv => q{"Brightness: $val"},
  1254. },
  1255. 0xfe54 => {
  1256. Name => 'Contrast',
  1257. Avoid => 1,
  1258. PSRaw => 1,
  1259. Writable => 'string',
  1260. ValueConv => '$val=~s/^.*: //;$val',
  1261. ValueConvInv => q{"Contrast: $val"},
  1262. },
  1263. 0xfe55 => {
  1264. Name => 'Saturation',
  1265. Avoid => 1,
  1266. PSRaw => 1,
  1267. Writable => 'string',
  1268. ValueConv => '$val=~s/^.*: //;$val',
  1269. ValueConvInv => q{"Saturation: $val"},
  1270. },
  1271. 0xfe56 => {
  1272. Name => 'Sharpness',
  1273. Avoid => 1,
  1274. PSRaw => 1,
  1275. Writable => 'string',
  1276. ValueConv => '$val=~s/^.*: //;$val',
  1277. ValueConvInv => q{"Sharpness: $val"},
  1278. },
  1279. 0xfe57 => {
  1280. Name => 'Smoothness',
  1281. Avoid => 1,
  1282. PSRaw => 1,
  1283. Writable => 'string',
  1284. ValueConv => '$val=~s/^.*: //;$val',
  1285. ValueConvInv => q{"Smoothness: $val"},
  1286. },
  1287. 0xfe58 => {
  1288. Name => 'MoireFilter',
  1289. Avoid => 1,
  1290. PSRaw => 1,
  1291. Writable => 'string',
  1292. ValueConv => '$val=~s/^.*: //;$val',
  1293. ValueConvInv => q{"Moire Filter: $val"},
  1294. },
  1295. );
  1296. # insert our writable properties into main EXIF tag table
  1297. InsertWritableProperties(\%Image::ExifTool::Exif::Main, \%writeTable, \&CheckExif);
  1298. #------------------------------------------------------------------------------
  1299. # Inverse print conversion for LensInfo
  1300. # Inputs: 0) lens info string
  1301. # Returns: PrintConvInv of string
  1302. sub ConvertLensInfo($)
  1303. {
  1304. my $val = shift;
  1305. my @a = GetLensInfo($val, 1); # (allow unknown "?" values)
  1306. return @a ? join(' ', @a) : $val;
  1307. }
  1308. #------------------------------------------------------------------------------
  1309. # Get binary CFA Pattern from a text string
  1310. # Inputs: Print-converted CFA pattern (eg. '[Blue,Green][Green,Red]')
  1311. # Returns: CFA pattern as a string of numbers
  1312. sub GetCFAPattern($)
  1313. {
  1314. my $val = shift;
  1315. my @rows = split /\]\s*\[/, $val;
  1316. @rows or warn("Rows not properly bracketed by '[]'\n"), return undef;
  1317. my @cols = split /,/, $rows[0];
  1318. @cols or warn("Colors not separated by ','\n"), return undef;
  1319. my $ny = @cols;
  1320. my @a = (scalar(@rows), scalar(@cols));
  1321. my %cfaLookup = (red=>0, green=>1, blue=>2, cyan=>3, magenta=>4, yellow=>5, white=>6);
  1322. my $row;
  1323. foreach $row (@rows) {
  1324. @cols = split /,/, $row;
  1325. @cols == $ny or warn("Inconsistent number of colors in each row\n"), return undef;
  1326. foreach (@cols) {
  1327. tr/ \]\[//d; # remove remaining brackets and any spaces
  1328. my $c = $cfaLookup{lc($_)};
  1329. defined $c or warn("Unknown color '$_'\n"), return undef;
  1330. push @a, $c;
  1331. }
  1332. }
  1333. return "@a";
  1334. }
  1335. #------------------------------------------------------------------------------
  1336. # validate raw values for writing
  1337. # Inputs: 0) ExifTool ref, 1) tagInfo hash ref, 2) raw value ref
  1338. # Returns: error string or undef (and possibly changes value) on success
  1339. sub CheckExif($$$)
  1340. {
  1341. my ($et, $tagInfo, $valPtr) = @_;
  1342. my $format = $$tagInfo{Format} || $$tagInfo{Writable} || $$tagInfo{Table}{WRITABLE};
  1343. if (not $format or $format eq '1') {
  1344. if ($$tagInfo{Groups}{0} eq 'MakerNotes') {
  1345. return undef; # OK to have no format for makernotes
  1346. } else {
  1347. return 'No writable format';
  1348. }
  1349. }
  1350. return Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
  1351. }
  1352. #------------------------------------------------------------------------------
  1353. # encode exif ASCII/Unicode text from UTF8 or Latin
  1354. # Inputs: 0) ExifTool ref, 1) text string
  1355. # Returns: encoded string
  1356. # Note: MUST be called Raw conversion time so the EXIF byte order is known!
  1357. sub EncodeExifText($$)
  1358. {
  1359. my ($et, $val) = @_;
  1360. # does the string contain special characters?
  1361. if ($val =~ /[\x80-\xff]/) {
  1362. my $order = $et->GetNewValue('ExifUnicodeByteOrder');
  1363. return "UNICODE\0" . $et->Encode($val,'UTF16',$order);
  1364. } else {
  1365. return "ASCII\0\0\0$val";
  1366. }
  1367. }
  1368. #------------------------------------------------------------------------------
  1369. # insert writable properties into main tag table
  1370. # Inputs: 0) tag table ref, 1) reference to writable properties
  1371. # 2) [optional] CHECK_PROC reference
  1372. sub InsertWritableProperties($$;$)
  1373. {
  1374. my ($tagTablePtr, $writeTablePtr, $checkProc) = @_;
  1375. my $tag;
  1376. $checkProc and $$tagTablePtr{CHECK_PROC} = $checkProc;
  1377. foreach $tag (keys %$writeTablePtr) {
  1378. my $writeInfo = $$writeTablePtr{$tag};
  1379. my @infoList = GetTagInfoList($tagTablePtr, $tag);
  1380. if (@infoList) {
  1381. my $tagInfo;
  1382. foreach $tagInfo (@infoList) {
  1383. if (ref $writeInfo) {
  1384. my $key;
  1385. foreach $key (keys %$writeInfo) {
  1386. $$tagInfo{$key} = $$writeInfo{$key} unless defined $$tagInfo{$key};
  1387. }
  1388. } else {
  1389. $$tagInfo{Writable} = $writeInfo unless defined $$tagInfo{Writable};
  1390. }
  1391. }
  1392. } else {
  1393. AddTagToTable($tagTablePtr, $tag, $writeInfo);
  1394. }
  1395. }
  1396. }
  1397. #------------------------------------------------------------------------------
  1398. # rebuild maker notes to properly contain all value data
  1399. # (some manufacturers put value data outside maker notes!!)
  1400. # Inputs: 0) ExifTool object ref, 1) tag table ref, 2) dirInfo ref
  1401. # Returns: new maker note data (and creates MAKER_NOTE_FIXUP), or undef on error
  1402. sub RebuildMakerNotes($$$)
  1403. {
  1404. my ($et, $tagTablePtr, $dirInfo) = @_;
  1405. my $dirStart = $$dirInfo{DirStart};
  1406. my $dirLen = $$dirInfo{DirLen};
  1407. my $dataPt = $$dirInfo{DataPt};
  1408. my $dataPos = $$dirInfo{DataPos} || 0;
  1409. my $rtnValue;
  1410. my %subdirInfo = %$dirInfo;
  1411. delete $$et{MAKER_NOTE_FIXUP};
  1412. # don't need to rebuild text, BinaryData or PreviewImage maker notes
  1413. my $tagInfo = $$dirInfo{TagInfo};
  1414. my $subdir = $$tagInfo{SubDirectory};
  1415. my $proc = $$subdir{ProcessProc} || $$tagTablePtr{PROCESS_PROC} || \&ProcessExif;
  1416. if (($proc ne \&ProcessExif and $$tagInfo{Name} =~ /Text/) or
  1417. $proc eq \&Image::ExifTool::ProcessBinaryData or
  1418. ($$tagInfo{PossiblePreview} and $dirLen > 6 and
  1419. substr($$dataPt, $dirStart, 3) eq "\xff\xd8\xff"))
  1420. {
  1421. return substr($$dataPt, $dirStart, $dirLen);
  1422. }
  1423. my $saveOrder = GetByteOrder();
  1424. my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
  1425. if (defined $loc) {
  1426. my $makerFixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
  1427. # create new exiftool object to rewrite the directory without changing it
  1428. my $newTool = new Image::ExifTool;
  1429. $newTool->Options(
  1430. IgnoreMinorErrors => $$et{OPTIONS}{IgnoreMinorErrors},
  1431. FixBase => $$et{OPTIONS}{FixBase},
  1432. );
  1433. $newTool->Init(); # must do this before calling WriteDirectory()!
  1434. # don't copy over preview image
  1435. $newTool->SetNewValue(PreviewImage => '');
  1436. # copy all transient members over in case they are used for writing
  1437. # (Make, Model, etc)
  1438. foreach (grep /[a-z]/, keys %$et) {
  1439. $$newTool{$_} = $$et{$_};
  1440. }
  1441. # fix base offsets if specified
  1442. $newTool->Options(FixBase => $et->Options('FixBase'));
  1443. # set GENERATE_PREVIEW_INFO flag so PREVIEW_INFO will be generated
  1444. $$newTool{GENERATE_PREVIEW_INFO} = 1;
  1445. # drop any large tags
  1446. $$newTool{DROP_TAGS} = 1;
  1447. # initialize other necessary data members
  1448. $$newTool{FILE_TYPE} = $$et{FILE_TYPE};
  1449. $$newTool{TIFF_TYPE} = $$et{TIFF_TYPE};
  1450. # rewrite maker notes
  1451. $rtnValue = $newTool->WriteDirectory(\%subdirInfo, $tagTablePtr);
  1452. if (defined $rtnValue and length $rtnValue) {
  1453. # add the dummy/empty preview image if necessary
  1454. if ($$newTool{PREVIEW_INFO}) {
  1455. $makerFixup->SetMarkerPointers(\$rtnValue, 'PreviewImage', length($rtnValue));
  1456. $rtnValue .= $$newTool{PREVIEW_INFO}{Data};
  1457. delete $$newTool{PREVIEW_INFO};
  1458. }
  1459. # add makernote header
  1460. if ($loc) {
  1461. my $hdr = substr($$dataPt, $dirStart, $loc);
  1462. # special case: convert Pentax/Samsung DNG maker notes to JPEG style
  1463. # (in JPEG, Pentax makernotes are absolute and start with "AOC\0" for some
  1464. # models, but in DNG images they are stored in tag 0xc634 of IFD0 and
  1465. # start with either "PENTAX \0" or "SAMSUNG\0")
  1466. if ($$dirInfo{Parent} eq 'IFD0' and $hdr =~ /^(PENTAX |SAMSUNG)\0/) {
  1467. # convert to JPEG-style AOC maker notes if used by this model
  1468. # (Note: this expression also appears in Exif.pm)
  1469. if ($$et{Model} =~ /\b(K(-[57mrx]|(10|20|100|110|200)D|2000)|GX(10|20))\b/) {
  1470. $hdr =~ s/^(PENTAX |SAMSUNG)\0/AOC\0/;
  1471. # save fixup because AOC maker notes have absolute offsets
  1472. $$et{MAKER_NOTE_FIXUP} = $makerFixup;
  1473. }
  1474. }
  1475. $rtnValue = $hdr . $rtnValue;
  1476. # adjust fixup for shift in start position
  1477. $$makerFixup{Start} += length $hdr;
  1478. }
  1479. # shift offsets according to original position of maker notes,
  1480. # and relative to the makernotes Base
  1481. $$makerFixup{Shift} += $dataPos + $dirStart +
  1482. $$dirInfo{Base} - $subdirInfo{Base};
  1483. # repair incorrect offsets if offsets were fixed
  1484. $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0;
  1485. # fix up pointers to the specified offset
  1486. $makerFixup->ApplyFixup(\$rtnValue);
  1487. # save fixup information unless offsets were relative
  1488. unless ($subdirInfo{Relative}) {
  1489. # set shift so offsets are all relative to start of maker notes
  1490. $$makerFixup{Shift} -= $dataPos + $dirStart;
  1491. $$et{MAKER_NOTE_FIXUP} = $makerFixup; # save fixup for later
  1492. }
  1493. }
  1494. }
  1495. SetByteOrder($saveOrder);
  1496. return $rtnValue;
  1497. }
  1498. #------------------------------------------------------------------------------
  1499. # Sort IFD directory entries
  1500. # Inputs: 0) data reference, 1) directory start, 2) number of entries,
  1501. # 3) flag to treat 0 as a valid tag ID (as opposed to an empty IFD entry)
  1502. sub SortIFD($$$;$)
  1503. {
  1504. my ($dataPt, $dirStart, $numEntries, $allowZero) = @_;
  1505. my ($index, %entries);
  1506. # split the directory into separate entries
  1507. for ($index=0; $index<$numEntries; ++$index) {
  1508. my $entry = $dirStart + 2 + 12 * $index;
  1509. my $tagID = Get16u($dataPt, $entry);
  1510. my $entryData = substr($$dataPt, $entry, 12);
  1511. # silly software can pad directories with zero entries -- put these at the end
  1512. $tagID = 0x10000 unless $tagID or $index == 0 or $allowZero;
  1513. # add new entry (allow for duplicate tag ID's, which shouldn't normally happen)
  1514. if ($entries{$tagID}) {
  1515. $entries{$tagID} .= $entryData;
  1516. } else {
  1517. $entries{$tagID} = $entryData;
  1518. }
  1519. }
  1520. # sort the directory entries
  1521. my @sortedTags = sort { $a <=> $b } keys %entries;
  1522. # generate the sorted IFD
  1523. my $newDir = '';
  1524. foreach (@sortedTags) {
  1525. $newDir .= $entries{$_};
  1526. }
  1527. # replace original directory with new, sorted one
  1528. substr($$dataPt, $dirStart + 2, 12 * $numEntries) = $newDir;
  1529. }
  1530. #------------------------------------------------------------------------------
  1531. # Validate IFD entries (strict validation to test possible chained IFD's)
  1532. # Inputs: 0) dirInfo ref (must have RAF set), 1) optional DirStart
  1533. # Returns: true if IFD looks OK
  1534. sub ValidateIFD($;$)
  1535. {
  1536. my ($dirInfo, $dirStart) = @_;
  1537. my $raf = $$dirInfo{RAF} or return 0;
  1538. my $base = $$dirInfo{Base};
  1539. $dirStart = $$dirInfo{DirStart} || 0 unless defined $dirStart;
  1540. my $offset = $dirStart + ($$dirInfo{DataPos} || 0);
  1541. my ($buff, $index);
  1542. $raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2 or return 0;
  1543. my $numEntries = Get16u(\$buff,0);
  1544. $numEntries > 1 and $numEntries < 64 or return 0;
  1545. my $len = 12 * $numEntries;
  1546. $raf->Read($buff, $len) == $len or return 0;
  1547. my $lastID = -1;
  1548. for ($index=0; $index<$numEntries; ++$index) {
  1549. my $entry = 12 * $index;
  1550. my $tagID = Get16u(\$buff, $entry);
  1551. $tagID > $lastID or $$dirInfo{AllowOutOfOrderTags} or return 0;
  1552. my $format = Get16u(\$buff, $entry+2);
  1553. $format > 0 and $format <= 13 or return 0;
  1554. my $count = Get32u(\$buff, $entry+4);
  1555. $count > 0 or return 0;
  1556. $lastID = $tagID;
  1557. }
  1558. return 1;
  1559. }
  1560. #------------------------------------------------------------------------------
  1561. # Get sorted list of offsets used in IFD
  1562. # Inputs: 0) data ref, 1) directory start, 2) dataPos, 3) IFD entries, 4) tag table ref
  1563. # Returns: 0) sorted list of offsets (only offsets after the end of the IFD)
  1564. # 1) hash of list indices keyed by offset value
  1565. # Notes: This is used in a patch to fix the count for tags in Kodak SubIFD3
  1566. sub GetOffList($$$$$)
  1567. {
  1568. my ($dataPt, $dirStart, $dataPos, $numEntries, $tagTablePtr) = @_;
  1569. my $ifdEnd = $dirStart + 2 + 12 * $numEntries + $dataPos;
  1570. my ($index, $offset, %offHash);
  1571. for ($index=0; $index<$numEntries; ++$index) {
  1572. my $entry = $dirStart + 2 + 12 * $index;
  1573. my $format = Get16u($dataPt, $entry + 2);
  1574. next if $format < 1 or $format > 13;
  1575. my $count = Get16u($dataPt, $entry + 4);
  1576. my $size = $formatSize[$format] * $count;
  1577. if ($size <= 4) {
  1578. my $tagID = Get16u($dataPt, $entry);
  1579. next unless ref $$tagTablePtr{$tagID} eq 'HASH' and $$tagTablePtr{$tagID}{FixCount};
  1580. }
  1581. my $offset = Get16u($dataPt, $entry + 8);
  1582. $offHash{$offset} = 1 if $offset >= $ifdEnd;
  1583. }
  1584. # set offset hash values to indices in list
  1585. my @offList = sort keys %offHash;
  1586. $index = 0;
  1587. foreach $offset (@offList) {
  1588. $offHash{$offset} = $index++;
  1589. }
  1590. return(\@offList, \%offHash);
  1591. }
  1592. #------------------------------------------------------------------------------
  1593. # Update TIFF_END member if defined
  1594. # Inputs: 0) ExifTool ref, 1) end of valid TIFF data
  1595. sub UpdateTiffEnd($$)
  1596. {
  1597. my ($et, $end) = @_;
  1598. if (defined $$et{TIFF_END} and
  1599. $$et{TIFF_END} < $end)
  1600. {
  1601. $$et{TIFF_END} = $end;
  1602. }
  1603. }
  1604. #------------------------------------------------------------------------------
  1605. # Handle error while writing EXIF
  1606. # Inputs: 0) ExifTool ref, 1) error string, 2) tag table ref
  1607. # Returns: undef on fatal error, or '' if minor error is ignored
  1608. sub ExifErr($$$)
  1609. {
  1610. my ($et, $errStr, $tagTablePtr) = @_;
  1611. # MakerNote errors are minor by default
  1612. my $minor = ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes');
  1613. if ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{MINOR_ERRORS}) {
  1614. $et->Warn("$errStr. IFD dropped.") and return '' if $minor;
  1615. $minor = 1;
  1616. }
  1617. return undef if $et->Error($errStr, $minor);
  1618. return '';
  1619. }
  1620. #------------------------------------------------------------------------------
  1621. # Read/Write IFD with TIFF-like header (used by DNG 1.2)
  1622. # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
  1623. # Returns: Reading: 1 on success, otherwise returns 0 and sets a Warning
  1624. # Writing: new data block or undef on error
  1625. sub ProcessTiffIFD($$$)
  1626. {
  1627. my ($et, $dirInfo, $tagTablePtr) = @_;
  1628. $et or return 1; # allow dummy access
  1629. my $raf = $$dirInfo{RAF};
  1630. my $base = $$dirInfo{Base} || 0;
  1631. my $dirName = $$dirInfo{DirName};
  1632. my $magic = $$dirInfo{Subdir}{Magic} || 0x002a;
  1633. my $buff;
  1634. # structured with a TIFF-like header and relative offsets
  1635. $raf->Seek($base, 0) and $raf->Read($buff, 8) == 8 or return 0;
  1636. unless (SetByteOrder(substr($buff,0,2)) and Get16u(\$buff, 2) == $magic) {
  1637. my $msg = "Invalid $dirName header";
  1638. if ($$dirInfo{IsWriting}) {
  1639. $et->Error($msg);
  1640. return undef;
  1641. } else {
  1642. $et->Warn($msg);
  1643. return 0;
  1644. }
  1645. }
  1646. my $offset = Get32u(\$buff, 4);
  1647. my %dirInfo = (
  1648. DirName => $$dirInfo{DirName},
  1649. Parent => $$dirInfo{Parent},
  1650. Base => $base,
  1651. DataPt => \$buff,
  1652. DataLen => length $buff,
  1653. DataPos => 0,
  1654. DirStart => $offset,
  1655. DirLen => length($buff) - $offset,
  1656. RAF => $raf,
  1657. NewDataPos => 8,
  1658. );
  1659. if ($$dirInfo{IsWriting}) {
  1660. # rewrite the Camera Profile IFD
  1661. my $newDir = WriteExif($et, \%dirInfo, $tagTablePtr);
  1662. # don't add header if error writing directory ($newDir is undef)
  1663. # or if directory is being deleted ($newDir is empty)
  1664. return $newDir unless $newDir;
  1665. # return directory with TIFF-like header
  1666. return GetByteOrder() . Set16u($magic) . Set32u(8) . $newDir;
  1667. }
  1668. if ($$et{HTML_DUMP}) {
  1669. my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n%s offset: 0x%.4x",
  1670. (GetByteOrder() eq 'II') ? 'Little' : 'Big', $magic, $dirName, $offset);
  1671. $et->HDump($base, 8, "$dirName header", $tip, 0);
  1672. }
  1673. return ProcessExif($et, \%dirInfo, $tagTablePtr);
  1674. }
  1675. #------------------------------------------------------------------------------
  1676. # Write EXIF directory
  1677. # Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
  1678. # Returns: Exif data block (may be empty if no Exif data) or undef on error
  1679. # Notes: Increments ExifTool CHANGED flag for each tag changed. Also updates
  1680. # TIFF_END if defined with location of end of original TIFF image.
  1681. # Returns IFD data in the following order:
  1682. # 1. IFD0 directory followed by its data
  1683. # 2. SubIFD directory followed by its data, thumbnail and image
  1684. # 3. GlobalParameters, EXIF, GPS, Interop IFD's each with their data
  1685. # 4. IFD1,IFD2,... directories each followed by their data
  1686. # 5. Thumbnail and/or image data for each IFD, with IFD0 image last
  1687. sub WriteExif($$$)
  1688. {
  1689. my ($et, $dirInfo, $tagTablePtr) = @_;
  1690. $et or return 1; # allow dummy access to autoload this package
  1691. my $origDirInfo = $dirInfo; # save original dirInfo
  1692. my $dataPt = $$dirInfo{DataPt};
  1693. unless ($dataPt) {
  1694. my $emptyData = '';
  1695. $dataPt = \$emptyData;
  1696. }
  1697. my $dataPos = $$dirInfo{DataPos} || 0;
  1698. my $dirStart = $$dirInfo{DirStart} || 0;
  1699. my $dataLen = $$dirInfo{DataLen} || length($$dataPt);
  1700. my $dirLen = $$dirInfo{DirLen} || ($dataLen - $dirStart);
  1701. my $base = $$dirInfo{Base} || 0;
  1702. my $firstBase = $base;
  1703. my $raf = $$dirInfo{RAF};
  1704. my $dirName = $$dirInfo{DirName} || 'unknown';
  1705. my $fixup = $$dirInfo{Fixup} || new Image::ExifTool::Fixup;
  1706. my $imageDataFlag = $$dirInfo{ImageData} || '';
  1707. my $verbose = $et->Options('Verbose');
  1708. my $out = $et->Options('TextOut');
  1709. my ($nextIfdPos, %offsetData, $inMakerNotes);
  1710. my (@offsetInfo, %xDelete, $strEnc);
  1711. my $deleteAll = 0;
  1712. my $newData = ''; # initialize buffer to receive new directory data
  1713. my @imageData; # image data blocks to copy later if requested
  1714. my $name = $$dirInfo{Name};
  1715. $name = $dirName unless $name and $dirName eq 'MakerNotes' and $name !~ /^MakerNote/;
  1716. # set encoding for strings
  1717. $strEnc = $et->Options('CharsetEXIF') if $$tagTablePtr{GROUPS}{0} eq 'EXIF';
  1718. # allow multiple IFD's in IFD0-IFD1-IFD2... chain
  1719. $$dirInfo{Multi} = 1 if $dirName =~ /^(IFD0|SubIFD)$/ and not defined $$dirInfo{Multi};
  1720. $inMakerNotes = 1 if $$tagTablePtr{GROUPS}{0} eq 'MakerNotes';
  1721. my $ifd;
  1722. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1723. # loop through each IFD
  1724. #
  1725. for ($ifd=0; ; ++$ifd) { # loop through multiple IFD's
  1726. # save pointer to start of this IFD within the newData
  1727. my $newStart = length($newData);
  1728. my @subdirs; # list of subdirectory data and tag table pointers
  1729. # determine if directory is contained within our data
  1730. my $mustRead;
  1731. if ($dirStart < 0 or $dirStart > $dataLen-2) {
  1732. $mustRead = 1;
  1733. } elsif ($dirLen > 2) {
  1734. my $len = 2 + 12 * Get16u($dataPt, $dirStart);
  1735. $mustRead = 1 if $dirStart + $len > $dataLen;
  1736. }
  1737. # read IFD from file if necessary
  1738. if ($mustRead) {
  1739. if ($raf) {
  1740. # read the count of entries in this IFD
  1741. my $offset = $dirStart + $dataPos;
  1742. my ($buff, $buf2);
  1743. unless ($raf->Seek($offset + $base, 0) and $raf->Read($buff,2) == 2) {
  1744. return ExifErr($et, "Bad IFD or truncated file in $name", $tagTablePtr);
  1745. }
  1746. my $len = 12 * Get16u(\$buff,0);
  1747. # (also read next IFD pointer if available)
  1748. unless ($raf->Read($buf2, $len+4) >= $len) {
  1749. return ExifErr($et, "Error reading $name", $tagTablePtr);
  1750. }
  1751. $buff .= $buf2;
  1752. # make copy of dirInfo since we're going to modify it
  1753. my %newDirInfo = %$dirInfo;
  1754. $dirInfo = \%newDirInfo;
  1755. # update directory parameters for the newly loaded IFD
  1756. $dataPt = $$dirInfo{DataPt} = \$buff;
  1757. $dirStart = $$dirInfo{DirStart} = 0;
  1758. $dataPos = $$dirInfo{DataPos} = $offset;
  1759. $dataLen = $$dirInfo{DataLen} = length $buff;
  1760. $dirLen = $$dirInfo{DirLen} = $dataLen;
  1761. # only account for nextIFD pointer if we are going to use it
  1762. $len += 4 if $dataLen==$len+6 and ($$dirInfo{Multi} or $buff =~ /\0{4}$/);
  1763. UpdateTiffEnd($et, $offset+$base+2+$len);
  1764. } elsif ($dirLen) {
  1765. # error if we can't load IFD (unless we are creating
  1766. # from scratch, in which case dirLen will be zero)
  1767. my $str = $et->Options('IgnoreMinorErrors') ? 'Deleted bad' : 'Bad';
  1768. $et->Error("$str $name directory", 1);
  1769. }
  1770. }
  1771. my ($index, $dirEnd, $numEntries);
  1772. if ($dirStart + 4 < $dataLen) {
  1773. $numEntries = Get16u($dataPt, $dirStart);
  1774. $dirEnd = $dirStart + 2 + 12 * $numEntries;
  1775. if ($dirEnd > $dataLen) {
  1776. return ExifErr($et, "Truncated $name directory", $tagTablePtr);
  1777. }
  1778. # sort entries if necessary (but not in maker notes IFDs)
  1779. unless ($inMakerNotes) {
  1780. my $lastID = -1;
  1781. for ($index=0; $index<$numEntries; ++$index) {
  1782. my $tagID = Get16u($dataPt, $dirStart + 2 + 12 * $index);
  1783. # check for proper sequence (but ignore null entries at end)
  1784. if ($tagID < $lastID and ($tagID or $$tagTablePtr{0})) {
  1785. SortIFD($dataPt, $dirStart, $numEntries, $$tagTablePtr{0});
  1786. $et->Warn("Entries in $name were out of sequence. Fixed.",1);
  1787. last;
  1788. }
  1789. $lastID = $tagID;
  1790. }
  1791. }
  1792. } else {
  1793. $numEntries = 0;
  1794. $dirEnd = $dirStart;
  1795. }
  1796. # loop through new values and accumulate all information for this IFD
  1797. my (%set, %mayDelete, $tagInfo);
  1798. my $wrongDir = $crossDelete{$dirName};
  1799. foreach $tagInfo ($et->GetNewTagInfoList($tagTablePtr)) {
  1800. my $tagID = $$tagInfo{TagID};
  1801. # evaluate conditional lists now if necessary
  1802. if (ref $$tagTablePtr{$tagID} eq 'ARRAY' or $$tagInfo{Condition}) {
  1803. my $curInfo = $et->GetTagInfo($tagTablePtr, $tagID);
  1804. if (defined $curInfo and not $curInfo) {
  1805. # need value to evaluate the condition
  1806. my $val = $et->GetNewValue($tagInfo);
  1807. # must convert to binary for evaluating in Condition
  1808. if ($$tagInfo{Format} and defined $val) {
  1809. $val = WriteValue($val, $$tagInfo{Format}, $$tagInfo{Count});
  1810. }
  1811. if (defined $val) {
  1812. my $fmt = $$tagInfo{Writable} || $$tagInfo{Format} || 'undef';
  1813. my $cnt = $$tagInfo{Count} || 1;
  1814. # always use old format/count for Condition in maker notes
  1815. if ($inMakerNotes) {
  1816. for ($index=0; $index<$numEntries; ++$index) {
  1817. my $entry = $dirStart + 2 + 12 * $index;
  1818. my $id = Get16u($dataPt, $entry);
  1819. if ($id eq $tagID) {
  1820. my $f = Get16u($dataPt, $entry + 2);
  1821. if ($formatName[$f]) {
  1822. $fmt = $formatName[$f];
  1823. $cnt = Get32u($dataPt, $entry + 4);
  1824. }
  1825. last;
  1826. }
  1827. }
  1828. }
  1829. $curInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$val, $fmt, $cnt);
  1830. } else {
  1831. # may want to delete this, but we need to see the value first
  1832. $mayDelete{$tagID} = 1;
  1833. }
  1834. }
  1835. # don't set this tag unless valid for the current condition
  1836. next unless defined $curInfo and $curInfo eq $tagInfo;
  1837. }
  1838. if ($$tagInfo{WriteCondition}) {
  1839. my $self = $et; # set $self to be used in eval
  1840. #### eval WriteCondition ($self)
  1841. unless (eval $$tagInfo{WriteCondition}) {
  1842. $@ and warn $@;
  1843. next;
  1844. }
  1845. }
  1846. my $nvHash = $et->GetNewValueHash($tagInfo, $dirName);
  1847. unless ($nvHash) {
  1848. next unless $wrongDir;
  1849. # delete stuff from the wrong directory if setting somewhere else
  1850. $nvHash = $et->GetNewValueHash($tagInfo, $wrongDir);
  1851. # don't cross delete if not overwriting
  1852. next unless $et->IsOverwriting($nvHash);
  1853. # don't cross delete if specifically deleting from the other directory
  1854. # (Note: don't call GetValue() here because it shouldn't be called
  1855. # if IsOverwriting returns < 0 -- eg. when shifting)
  1856. next if not defined $$nvHash{Value} and $$nvHash{WantGroup} and
  1857. lc($$nvHash{WantGroup}) eq lc($wrongDir);
  1858. # remove this tag if found in this IFD
  1859. $xDelete{$tagID} = 1;
  1860. }
  1861. if ($set{$tagID}) {
  1862. # this tag is being set twice, which can happen if two Condition's
  1863. # were true for this tag. Hopefully the only case where this can
  1864. # happen is the MakerNotes tag since it may store two very different
  1865. # types of information (MakerNotes and PreviewImage), but we want
  1866. # to store the MakerNotes if both are available
  1867. if ($tagID == 0x927c and $dirName =~ /^(ExifIFD|IFD0)$/) {
  1868. next if $$tagInfo{Name} eq 'PreviewImage';
  1869. } else {
  1870. $et->Warn(sprintf("Multiple new values for $name tag 0x%.4x",$tagID));
  1871. }
  1872. }
  1873. $set{$tagID} = $tagInfo;
  1874. }
  1875. # fix base offsets (some cameras incorrectly write maker notes in IFD0)
  1876. if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/ and
  1877. $$et{TIFF_TYPE} !~ /^(ARW|SR2)$/ and not $$et{LeicaTrailerPos} and
  1878. Image::ExifTool::MakerNotes::FixBase($et, $dirInfo))
  1879. {
  1880. # update local variables from fixed values
  1881. $base = $$dirInfo{Base};
  1882. $dataPos = $$dirInfo{DataPos};
  1883. }
  1884. # initialize variables to handle mandatory tags
  1885. my $mandatory = $mandatory{$dirName};
  1886. my ($allMandatory, $addMandatory);
  1887. if ($mandatory) {
  1888. # use X/Y resolution values from JFIF if available
  1889. if ($dirName eq 'IFD0' and defined $$et{JFIFYResolution}) {
  1890. my %ifd0Vals = %$mandatory;
  1891. $ifd0Vals{0x011a} = $$et{JFIFXResolution};
  1892. $ifd0Vals{0x011b} = $$et{JFIFYResolution};
  1893. $ifd0Vals{0x0128} = $$et{JFIFResolutionUnit} + 1;
  1894. $mandatory = \%ifd0Vals;
  1895. }
  1896. $allMandatory = $addMandatory = 0; # initialize to zero
  1897. # add mandatory tags if creating a new directory
  1898. unless ($numEntries) {
  1899. foreach (keys %$mandatory) {
  1900. $set{$_} or $set{$_} = $$tagTablePtr{$_};
  1901. }
  1902. }
  1903. } else {
  1904. undef $deleteAll; # don't remove directory (no mandatory entries)
  1905. }
  1906. my ($addDirs, @newTags);
  1907. if ($inMakerNotes) {
  1908. $addDirs = { }; # can't currently add new directories in MakerNotes
  1909. # allow non-permanent makernotes tags to be added
  1910. # (note: we may get into trouble if there are too many of these
  1911. # because we allow out-of-order tags in MakerNote IFD's but our
  1912. # logic to add new tags relies on ordered entries)
  1913. foreach (keys %set) {
  1914. my $perm = $set{$_}{Permanent};
  1915. push @newTags, $_ if defined $perm and not $perm;
  1916. }
  1917. @newTags = sort { $a <=> $b } @newTags if @newTags > 1;
  1918. } else {
  1919. # get a hash of directories we will be writing in this one
  1920. $addDirs = $et->GetAddDirHash($tagTablePtr, $dirName);
  1921. # make a union of tags & dirs (can set whole dirs, like MakerNotes)
  1922. my %allTags = ( %set, %$addDirs );
  1923. # make sorted list of new tags to be added
  1924. @newTags = sort { $a <=> $b } keys(%allTags);
  1925. }
  1926. my $dirBuff = ''; # buffer for directory data
  1927. my $valBuff = ''; # buffer for value data
  1928. my @valFixups; # list of fixups for offsets in valBuff
  1929. # fixup for offsets in dirBuff
  1930. my $dirFixup = new Image::ExifTool::Fixup;
  1931. my $entryBasedFixup;
  1932. my $lastTagID = -1;
  1933. my ($oldInfo, $oldFormat, $oldFormName, $oldCount, $oldSize, $oldValue, $oldImageData);
  1934. my ($readFormat, $readFormName, $readCount); # format for reading old value(s)
  1935. my ($entry, $valueDataPt, $valueDataPos, $valueDataLen, $valuePtr, $valEnd);
  1936. my ($offList, $offHash, $ignoreCount, $fixCount);
  1937. my $oldID = -1;
  1938. my $newID = -1;
  1939. # patch for Canon EOS 40D firmware 1.0.4 bug (incorrect directory counts)
  1940. if ($inMakerNotes and $$et{Model} eq 'Canon EOS 40D') {
  1941. my $fmt = Get16u($dataPt, $dirStart + 2 + 12 * ($numEntries - 1) + 2);
  1942. if ($fmt < 1 or $fmt > 13) {
  1943. # adjust the number of directory entries
  1944. --$numEntries;
  1945. $dirEnd -= 12;
  1946. $ignoreCount = 1;
  1947. }
  1948. }
  1949. #..............................................................................
  1950. # loop through entries in new directory
  1951. #
  1952. $index = 0;
  1953. Entry: for (;;) {
  1954. if (defined $oldID and $oldID == $newID) {
  1955. #
  1956. # read next entry from existing directory
  1957. #
  1958. if ($index < $numEntries) {
  1959. $entry = $dirStart + 2 + 12 * $index;
  1960. $oldID = Get16u($dataPt, $entry);
  1961. $readFormat = $oldFormat = Get16u($dataPt, $entry+2);
  1962. $readCount = $oldCount = Get32u($dataPt, $entry+4);
  1963. undef $oldImageData;
  1964. if ($oldFormat < 1 or $oldFormat > 13) {
  1965. my $msg = "Bad format ($oldFormat) for $name entry $index";
  1966. # patch to preserve invalid directory entries in SubIFD3 of
  1967. # various Kodak Z-series cameras (Z812, Z1085IS, Z1275)
  1968. # and some Sony cameras such as the DSC-P10
  1969. if ($dirName eq 'MakerNotes' and (($$et{Make}=~/KODAK/i and
  1970. $$dirInfo{Name} and $$dirInfo{Name} eq 'SubIFD3') or
  1971. ($numEntries == 12 and $$et{Make} eq 'SONY' and $index >= 8)))
  1972. {
  1973. $dirBuff .= substr($$dataPt, $entry, 12);
  1974. ++$index;
  1975. $newID = $oldID; # we wrote this
  1976. $et->Warn($msg, 1);
  1977. next;
  1978. }
  1979. # don't write out null directory entry
  1980. if ($oldFormat==0 and $index and $oldCount==0) {
  1981. $ignoreCount = ($ignoreCount || 0) + 1;
  1982. # must keep same directory size to avoid messing up our fixed offsets
  1983. $dirBuff .= ("\0" x 12) if $$dirInfo{FixBase};
  1984. ++$index;
  1985. $newID = $oldID; # pretend we wrote this
  1986. next;
  1987. }
  1988. return ExifErr($et, $msg, $tagTablePtr);
  1989. }
  1990. $readFormName = $oldFormName = $formatName[$oldFormat];
  1991. $valueDataPt = $dataPt;
  1992. $valueDataPos = $dataPos;
  1993. $valueDataLen = $dataLen;
  1994. $valuePtr = $entry + 8;
  1995. # try direct method first for speed
  1996. $oldInfo = $$tagTablePtr{$oldID};
  1997. if (ref $oldInfo ne 'HASH' or $$oldInfo{Condition}) {
  1998. # must get unknown tags too
  1999. # (necessary so we don't miss a tag we want to Drop)
  2000. my $unk = $et->Options(Unknown => 1);
  2001. $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID);
  2002. $et->Options(Unknown => $unk);
  2003. }
  2004. # patch incorrect count in Kodak SubIFD3 tags
  2005. if ($oldCount < 2 and $oldInfo and $$oldInfo{FixCount}) {
  2006. $offList or ($offList, $offHash) = GetOffList($dataPt, $dirStart, $dataPos,
  2007. $numEntries, $tagTablePtr);
  2008. my $i = $$offHash{Get32u($dataPt, $valuePtr)};
  2009. if (defined $i and $i < $#$offList) {
  2010. $oldCount = int(($$offList[$i+1] - $$offList[$i]) / $formatSize[$oldFormat]);
  2011. $fixCount = ($fixCount || 0) + 1 if $oldCount != $readCount;
  2012. }
  2013. }
  2014. $oldSize = $oldCount * $formatSize[$oldFormat];
  2015. my $readFromFile;
  2016. if ($oldSize > 4) {
  2017. $valuePtr = Get32u($dataPt, $valuePtr);
  2018. # fix valuePtr if necessary
  2019. if ($$dirInfo{FixOffsets}) {
  2020. $valEnd or $valEnd = $dataPos + $dirStart + 2 + 12 * $numEntries + 4;
  2021. my ($tagID, $size, $wFlag) = ($oldID, $oldSize, 1);
  2022. #### eval FixOffsets ($valuePtr, $valEnd, $size, $tagID, $wFlag)
  2023. eval $$dirInfo{FixOffsets};
  2024. unless (defined $valuePtr) {
  2025. unless ($$et{DROP_TAGS}) {
  2026. my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf("tag 0x%.4x",$oldID);
  2027. return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
  2028. }
  2029. ++$index; $oldID = $newID; next; # drop this tag
  2030. }
  2031. }
  2032. # offset shouldn't point into TIFF or IFD header
  2033. my $suspect = ($valuePtr < 8);
  2034. # convert offset to pointer in $$dataPt
  2035. if ($$dirInfo{EntryBased} or (ref $$tagTablePtr{$oldID} eq 'HASH' and
  2036. $$tagTablePtr{$oldID}{EntryBased}))
  2037. {
  2038. $valuePtr += $entry;
  2039. } else {
  2040. $valuePtr -= $dataPos;
  2041. }
  2042. # value shouldn't overlap our directory
  2043. $suspect = 1 if $valuePtr < $dirEnd and $valuePtr+$oldSize > $dirStart;
  2044. # get value by seeking in file if we are allowed
  2045. if ($valuePtr < 0 or $valuePtr+$oldSize > $dataLen) {
  2046. my ($pos, $tagStr, $invalidPreview, $tmpInfo, $leicaTrailer);
  2047. if ($oldInfo) {
  2048. $tagStr = $$oldInfo{Name};
  2049. $leicaTrailer = $$oldInfo{LeicaTrailer};
  2050. } elsif (defined $oldInfo) {
  2051. $tmpInfo = $et->GetTagInfo($tagTablePtr, $oldID, \ '', $oldFormName, $oldCount);
  2052. if ($tmpInfo) {
  2053. $tagStr = $$tmpInfo{Name};
  2054. $leicaTrailer = $$tmpInfo{LeicaTrailer};
  2055. }
  2056. }
  2057. $tagStr or $tagStr = sprintf("tag 0x%.4x",$oldID);
  2058. # allow PreviewImage to run outside EXIF segment in JPEG images
  2059. if (not $raf) {
  2060. if ($tagStr eq 'PreviewImage') {
  2061. $raf = $$et{RAF};
  2062. if ($raf) {
  2063. $pos = $raf->Tell();
  2064. if ($oldInfo and $$oldInfo{ChangeBase}) {
  2065. # adjust base offset for this tag only
  2066. #### eval ChangeBase ($dirStart,$dataPos)
  2067. my $newBase = eval $$oldInfo{ChangeBase};
  2068. $valuePtr += $newBase;
  2069. }
  2070. } else {
  2071. $invalidPreview = 1;
  2072. }
  2073. } elsif ($leicaTrailer) {
  2074. # save information about Leica makernote trailer
  2075. $$et{LeicaTrailer} = {
  2076. TagInfo => $oldInfo || $tmpInfo,
  2077. Offset => $base + $valuePtr + $dataPos,
  2078. Size => $oldSize,
  2079. Fixup => new Image::ExifTool::Fixup,
  2080. },
  2081. $invalidPreview = 2;
  2082. # remove SubDirectory to prevent processing (for now)
  2083. my %copy = %{$oldInfo || $tmpInfo};
  2084. delete $copy{SubDirectory};
  2085. delete $copy{MakerNotes};
  2086. $oldInfo = \%copy;
  2087. }
  2088. }
  2089. if ($oldSize > BINARY_DATA_LIMIT and $$origDirInfo{ImageData} and
  2090. (not defined $oldInfo or ($oldInfo and not $$oldInfo{SubDirectory})))
  2091. {
  2092. # copy huge data blocks later instead of loading into memory
  2093. $oldValue = ''; # dummy empty value
  2094. # copy this value later unless writing a new value
  2095. unless ($set{$oldID}) {
  2096. my $pad = $oldSize & 0x01 ? 1 : 0;
  2097. # save block information to copy later (set directory offset later)
  2098. $oldImageData = [$base+$valuePtr+$dataPos, $oldSize, $pad];
  2099. }
  2100. } elsif ($raf) {
  2101. my $success = ($raf->Seek($base+$valuePtr+$dataPos, 0) and
  2102. $raf->Read($oldValue, $oldSize) == $oldSize);
  2103. if (defined $pos) {
  2104. $raf->Seek($pos, 0);
  2105. undef $raf;
  2106. # (sony A700 has 32-byte header on PreviewImage)
  2107. unless ($success and $oldValue =~ /^(\xff\xd8\xff|(.|.{33})\xd8\xff\xdb)/s) {
  2108. $invalidPreview = 1;
  2109. $success = 1; # continue writing directory anyway
  2110. }
  2111. }
  2112. unless ($success) {
  2113. return undef if $et->Error("Error reading value for $name entry $index", $inMakerNotes);
  2114. ++$index; $oldID = $newID; next; # drop this tag
  2115. }
  2116. } elsif (not $invalidPreview) {
  2117. return undef if $et->Error("Bad $name offset for $tagStr", $inMakerNotes);
  2118. ++$index; $oldID = $newID; next; # drop this tag
  2119. }
  2120. if ($invalidPreview) {
  2121. # set value for invalid preview
  2122. if ($$et{FILE_TYPE} eq 'JPEG') {
  2123. # define dummy value for preview (or Leica MakerNote) to write later
  2124. # (value must be larger than 4 bytes to generate PREVIEW_INFO,
  2125. # and an even number of bytes so it won't be padded)
  2126. $oldValue = 'LOAD_PREVIEW';
  2127. } else {
  2128. $oldValue = 'none';
  2129. $oldSize = length $oldValue;
  2130. }
  2131. $valuePtr = 0;
  2132. } else {
  2133. UpdateTiffEnd($et, $base+$valuePtr+$dataPos+$oldSize);
  2134. }
  2135. # update pointers for value just read from file
  2136. $valueDataPt = \$oldValue;
  2137. $valueDataPos = $valuePtr + $dataPos;
  2138. $valueDataLen = $oldSize;
  2139. $valuePtr = 0;
  2140. $readFromFile = 1;
  2141. }
  2142. if ($suspect) {
  2143. my $tagStr = $oldInfo ? $$oldInfo{Name} : sprintf('tag 0x%.4x', $oldID);
  2144. my $str = "Suspicious $name offset for $tagStr";
  2145. if ($inMakerNotes) {
  2146. $et->Warn($str, 1);
  2147. } else {
  2148. return undef if $et->Error($str, 1);
  2149. }
  2150. }
  2151. }
  2152. # read value if we haven't already
  2153. $oldValue = substr($$valueDataPt, $valuePtr, $oldSize) unless $readFromFile;
  2154. # get tagInfo using value if necessary
  2155. if (defined $oldInfo and not $oldInfo) {
  2156. my $unk = $et->Options(Unknown => 1);
  2157. $oldInfo = $et->GetTagInfo($tagTablePtr, $oldID, \$oldValue, $oldFormName, $oldCount);
  2158. $et->Options(Unknown => $unk);
  2159. # now that we have the value, we can resolve the Condition to finally
  2160. # determine whether we want to delete this tag or not
  2161. if ($mayDelete{$oldID} and $oldInfo and (not @newTags or $newTags[0] != $oldID)) {
  2162. my $nvHash = $et->GetNewValueHash($oldInfo, $dirName);
  2163. if (not $nvHash and $wrongDir) {
  2164. # delete from wrong directory if necessary
  2165. $nvHash = $et->GetNewValueHash($oldInfo, $wrongDir);
  2166. $nvHash and $xDelete{$oldID} = 1;
  2167. }
  2168. if ($nvHash) {
  2169. # we want to delete this tag after all, so insert it into our list
  2170. $set{$oldID} = $oldInfo;
  2171. unshift @newTags, $oldID;
  2172. }
  2173. }
  2174. }
  2175. # make sure we are handling the 'ifd' format properly
  2176. if (($oldFormat == 13 or $oldFormat == 18) and
  2177. (not $oldInfo or not $$oldInfo{SubIFD}))
  2178. {
  2179. my $str = sprintf('%s tag 0x%.4x IFD format not handled', $name, $oldID);
  2180. $et->Error($str, $inMakerNotes);
  2181. }
  2182. # override format we use to read the value if specified
  2183. if ($oldInfo) {
  2184. # check for tags which must be integers
  2185. if (($$oldInfo{IsOffset} or $$oldInfo{SubIFD}) and
  2186. not $intFormat{$oldFormName})
  2187. {
  2188. $et->Error("Invalid format ($oldFormName) for $name $$oldInfo{Name}", $inMakerNotes);
  2189. ++$index; $oldID = $newID; next; # drop this tag
  2190. }
  2191. if ($$oldInfo{Drop} and $$et{DROP_TAGS} and
  2192. ($$oldInfo{Drop} == 1 or $$oldInfo{Drop} < $oldSize))
  2193. {
  2194. ++$index; $oldID = $newID; next; # drop this tag
  2195. }
  2196. if ($$oldInfo{Format}) {
  2197. $readFormName = $$oldInfo{Format};
  2198. $readFormat = $formatNumber{$readFormName};
  2199. unless ($readFormat) {
  2200. # we aren't reading in a standard EXIF format, so rewrite in old format
  2201. $readFormName = $oldFormName;
  2202. $readFormat = $oldFormat;
  2203. }
  2204. # adjust number of items to read if format size changed
  2205. $readCount = $oldSize / $formatSize[$readFormat];
  2206. }
  2207. }
  2208. if ($oldID <= $lastTagID and not $inMakerNotes) {
  2209. my $str = $oldInfo ? "$$oldInfo{Name} tag" : sprintf('tag 0x%x',$oldID);
  2210. if ($oldID == $lastTagID) {
  2211. $et->Warn("Duplicate $str in $name");;
  2212. } else {
  2213. $et->Warn("\u$str out of sequence in $name");
  2214. }
  2215. }
  2216. $lastTagID = $oldID;
  2217. ++$index; # increment index for next time
  2218. } else {
  2219. undef $oldID; # no more existing entries
  2220. }
  2221. }
  2222. #
  2223. # write out all new tags, up to and including this one
  2224. #
  2225. $newID = $newTags[0];
  2226. my $isNew; # -1=tag is old, 0=tag same as existing, 1=tag is new
  2227. if (not defined $oldID) {
  2228. last unless defined $newID;
  2229. $isNew = 1;
  2230. } elsif (not defined $newID) {
  2231. # maker notes will have no new tags defined
  2232. if ($set{$oldID}) {
  2233. $newID = $oldID;
  2234. $isNew = 0;
  2235. } else {
  2236. $isNew = -1;
  2237. }
  2238. } else {
  2239. $isNew = $oldID <=> $newID;
  2240. }
  2241. my $newInfo = $oldInfo;
  2242. my $newFormat = $oldFormat;
  2243. my $newFormName = $oldFormName;
  2244. my $newCount = $oldCount;
  2245. my $ifdFormName;
  2246. my $newValue;
  2247. my $newValuePt = $isNew >= 0 ? \$newValue : \$oldValue;
  2248. my $isOverwriting;
  2249. if ($isNew >= 0) {
  2250. # add, edit or delete this tag
  2251. shift @newTags; # remove from list
  2252. if ($set{$newID}) {
  2253. #
  2254. # set the new tag value (or 'next' if deleting tag)
  2255. #
  2256. $newInfo = $set{$newID};
  2257. $newCount = $$newInfo{Count};
  2258. my ($val, $newVal, $n);
  2259. my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
  2260. if ($isNew > 0) {
  2261. # don't create new entry unless requested
  2262. if ($nvHash) {
  2263. next unless $$nvHash{IsCreating};
  2264. if ($$newInfo{IsOverwriting}) {
  2265. my $proc = $$newInfo{IsOverwriting};
  2266. $isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
  2267. } else {
  2268. $isOverwriting = $et->IsOverwriting($nvHash);
  2269. }
  2270. } else {
  2271. next if $xDelete{$newID}; # don't create if cross deleting
  2272. $newVal = $$mandatory{$newID}; # get value for mandatory tag
  2273. $isOverwriting = 1;
  2274. }
  2275. # convert using new format
  2276. if ($$newInfo{Format}) {
  2277. $newFormName = $$newInfo{Format};
  2278. # use Writable flag to specify IFD format code
  2279. $ifdFormName = $$newInfo{Writable};
  2280. } else {
  2281. $newFormName = $$newInfo{Writable};
  2282. unless ($newFormName) {
  2283. warn("No format for $name $$newInfo{Name}\n");
  2284. next;
  2285. }
  2286. }
  2287. $newFormat = $formatNumber{$newFormName};
  2288. } elsif ($nvHash or $xDelete{$newID}) {
  2289. unless ($nvHash) {
  2290. $nvHash = $et->GetNewValueHash($newInfo, $wrongDir);
  2291. }
  2292. # read value
  2293. if (length $oldValue >= $oldSize) {
  2294. $val = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
  2295. } else {
  2296. $val = '';
  2297. }
  2298. # determine write format (by default, use 'Writable' format)
  2299. my $writable = $$newInfo{Writable};
  2300. # (or use existing format if 'Writable' not specified)
  2301. $writable = $oldFormName unless $writable and $writable ne '1';
  2302. # (and override write format with 'Format' if specified)
  2303. my $writeForm = $$newInfo{Format} || $writable;
  2304. if ($writeForm ne $newFormName) {
  2305. # write in specified format
  2306. $newFormName = $writeForm;
  2307. $newFormat = $formatNumber{$newFormName};
  2308. # use different IFD format code if necessary
  2309. if ($inMakerNotes) {
  2310. # always preserve IFD format in maker notes
  2311. $ifdFormName = $oldFormName;
  2312. } elsif ($writable ne $newFormName) {
  2313. # use specified IFD format
  2314. $ifdFormName = $writable;
  2315. }
  2316. }
  2317. if ($inMakerNotes and $readFormName ne 'string' and $readFormName ne 'undef') {
  2318. # keep same size in maker notes unless string or binary
  2319. $newCount = $oldCount * $formatSize[$oldFormat] / $formatSize[$newFormat];
  2320. }
  2321. if ($$newInfo{IsOverwriting}) {
  2322. my $proc = $$newInfo{IsOverwriting};
  2323. $isOverwriting = &$proc($et, $nvHash, $val, \$newVal);
  2324. } else {
  2325. $isOverwriting = $et->IsOverwriting($nvHash, $val);
  2326. }
  2327. }
  2328. if ($isOverwriting) {
  2329. $newVal = $et->GetNewValue($nvHash) unless defined $newVal;
  2330. # value undefined if deleting this tag
  2331. # (also delete tag if cross-deleting and this isn't a date/time shift)
  2332. if (not defined $newVal or ($xDelete{$newID} and not defined $$nvHash{Shift})) {
  2333. if ($$newInfo{RawConvInv} and defined $$nvHash{Value}) {
  2334. # error in RawConvInv, so rewrite existing tag
  2335. goto NoOverwrite; # GOTO!
  2336. }
  2337. unless ($isNew) {
  2338. ++$$et{CHANGED};
  2339. $et->VerboseValue("- $dirName:$$newInfo{Name}", $val);
  2340. }
  2341. next;
  2342. }
  2343. if ($newCount and $newCount < 0) {
  2344. # set count to number of values if variable
  2345. my @vals = split ' ',$newVal;
  2346. $newCount = @vals;
  2347. }
  2348. # convert to binary format
  2349. $newValue = WriteValue($newVal, $newFormName, $newCount);
  2350. unless (defined $newValue) {
  2351. $et->Warn("Invalid value for $dirName:$$newInfo{Name}");
  2352. goto NoOverwrite; # GOTO!
  2353. }
  2354. if (length $newValue) {
  2355. # limit maximum value length in JPEG images
  2356. # (max segment size is 65533 bytes and the min EXIF size is 96 incl an additional IFD entry)
  2357. if ($$et{FILE_TYPE} eq 'JPEG' and length($newValue) > 65436 and
  2358. $$newInfo{Name} ne 'PreviewImage')
  2359. {
  2360. my $name = $$newInfo{MakerNotes} ? 'MakerNotes' : $$newInfo{Name};
  2361. $et->Warn("$name too large to write in JPEG segment");
  2362. goto NoOverwrite; # GOTO!
  2363. }
  2364. # re-code if necessary
  2365. if ($strEnc and $newFormName eq 'string') {
  2366. $newValue = $et->Encode($newValue, $strEnc);
  2367. }
  2368. } else {
  2369. $et->Warn("Can't write zero length $$newInfo{Name} in $$tagTablePtr{GROUPS}{1}");
  2370. goto NoOverwrite; # GOTO!
  2371. }
  2372. if ($isNew >= 0) {
  2373. $newCount = length($newValue) / $formatSize[$newFormat];
  2374. ++$$et{CHANGED};
  2375. if (defined $allMandatory) {
  2376. # not all mandatory if we are writing any tag specifically
  2377. if ($nvHash) {
  2378. undef $allMandatory;
  2379. undef $deleteAll;
  2380. } else {
  2381. ++$addMandatory; # count mandatory tags that we added
  2382. }
  2383. }
  2384. if ($verbose > 1) {
  2385. $et->VerboseValue("- $dirName:$$newInfo{Name}", $val) unless $isNew;
  2386. my $str = $nvHash ? '' : ' (mandatory)';
  2387. $et->VerboseValue("+ $dirName:$$newInfo{Name}", $newVal, $str);
  2388. }
  2389. }
  2390. } else {
  2391. NoOverwrite: next if $isNew > 0;
  2392. $isNew = -1; # rewrite existing tag
  2393. }
  2394. # set format for EXIF IFD if different than conversion format
  2395. if ($ifdFormName) {
  2396. $newFormName = $ifdFormName;
  2397. $newFormat = $formatNumber{$newFormName};
  2398. }
  2399. } elsif ($isNew > 0) {
  2400. #
  2401. # create new subdirectory
  2402. #
  2403. # newInfo may not be defined if we try to add a mandatory tag
  2404. # to a directory that doesn't support it (eg. IFD1 in RW2 images)
  2405. $newInfo = $$addDirs{$newID} or next;
  2406. # make sure we don't try to generate a new MakerNotes directory
  2407. # or a SubIFD
  2408. next if $$newInfo{MakerNotes} or $$newInfo{Name} eq 'SubIFD';
  2409. my $subTable;
  2410. if ($$newInfo{SubDirectory}{TagTable}) {
  2411. $subTable = Image::ExifTool::GetTagTable($$newInfo{SubDirectory}{TagTable});
  2412. } else {
  2413. $subTable = $tagTablePtr;
  2414. }
  2415. # create empty source directory
  2416. my %sourceDir = (
  2417. Parent => $dirName,
  2418. Fixup => new Image::ExifTool::Fixup,
  2419. );
  2420. $sourceDir{DirName} = $$newInfo{Groups}{1} if $$newInfo{SubIFD};
  2421. $newValue = $et->WriteDirectory(\%sourceDir, $subTable);
  2422. # only add new directory if it isn't empty
  2423. next unless defined $newValue and length($newValue);
  2424. # set the fixup start location
  2425. if ($$newInfo{SubIFD}) {
  2426. # subdirectory is referenced by an offset in value buffer
  2427. my $subdir = $newValue;
  2428. $newValue = Set32u(0xfeedf00d);
  2429. push @subdirs, {
  2430. DataPt => \$subdir,
  2431. Table => $subTable,
  2432. Fixup => $sourceDir{Fixup},
  2433. Offset => length($dirBuff) + 8,
  2434. Where => 'dirBuff',
  2435. };
  2436. $newFormName = 'int32u';
  2437. $newFormat = $formatNumber{$newFormName};
  2438. } else {
  2439. # subdirectory goes directly into value buffer
  2440. $sourceDir{Fixup}{Start} += length($valBuff);
  2441. # use Writable to set format, otherwise 'undef'
  2442. $newFormName = $$newInfo{Writable};
  2443. unless ($newFormName and $formatNumber{$newFormName}) {
  2444. $newFormName = 'undef';
  2445. }
  2446. $newFormat = $formatNumber{$newFormName};
  2447. push @valFixups, $sourceDir{Fixup};
  2448. }
  2449. } elsif ($$newInfo{Format} and $$newInfo{Writable} and $$newInfo{Writable} ne '1') {
  2450. # use specified write format
  2451. $newFormName = $$newInfo{Writable};
  2452. $newFormat = $formatNumber{$newFormName};
  2453. } elsif ($$addDirs{$newID} and $newInfo ne $$addDirs{$newID}) {
  2454. # this can happen if we are trying to add a directory that doesn't exist
  2455. # in this type of file (eg. try adding a SubIFD tag to an A100 image)
  2456. $isNew = -1;
  2457. }
  2458. }
  2459. if ($isNew < 0) {
  2460. # just rewrite existing tag
  2461. $newID = $oldID;
  2462. $newValue = $oldValue;
  2463. $newFormat = $oldFormat; # (just in case it changed)
  2464. $newFormName = $oldFormName;
  2465. # set offset of this entry in the directory so we can update the pointer
  2466. # and save block information to copy this large block later
  2467. if ($oldImageData) {
  2468. $$oldImageData[3] = $newStart + length($dirBuff) + 2;
  2469. push @imageData, $oldImageData;
  2470. $$origDirInfo{ImageData} = \@imageData;
  2471. }
  2472. }
  2473. if ($newInfo) {
  2474. #
  2475. # load necessary data for this tag (thumbnail image, etc)
  2476. #
  2477. if ($$newInfo{DataTag} and $isNew >= 0) {
  2478. my $dataTag = $$newInfo{DataTag};
  2479. # load data for this tag
  2480. unless (defined $offsetData{$dataTag} or $dataTag eq 'LeicaTrailer') {
  2481. # prefer tag from Composite table if it exists (otherwise
  2482. # PreviewImage data would be taken from Extra tag)
  2483. my $compInfo = $Image::ExifTool::Composite{$dataTag};
  2484. $offsetData{$dataTag} = $et->GetNewValue($compInfo || $dataTag);
  2485. my $err;
  2486. if (defined $offsetData{$dataTag}) {
  2487. my $len = length $offsetData{$dataTag};
  2488. if ($dataTag eq 'PreviewImage') {
  2489. # must set DEL_PREVIEW flag now if preview fit into IFD
  2490. $$et{DEL_PREVIEW} = 1 if $len <= 4;
  2491. } elsif ($$et{FILE_TYPE} eq 'JPEG' and $len > 60000) {
  2492. delete $offsetData{$dataTag};
  2493. $err = "$dataTag not written (too large for JPEG segment)";
  2494. }
  2495. } else {
  2496. $err = "$dataTag not found";
  2497. }
  2498. if ($err) {
  2499. $et->Warn($err) if $$newInfo{IsOffset};
  2500. delete $set{$newID}; # remove from list of tags we are setting
  2501. next;
  2502. }
  2503. }
  2504. }
  2505. #
  2506. # write maker notes
  2507. #
  2508. if ($$newInfo{MakerNotes}) {
  2509. # don't write new makernotes if we are deleting this group
  2510. if ($$et{DEL_GROUP}{MakerNotes} and
  2511. ($$et{DEL_GROUP}{MakerNotes} != 2 or $isNew <= 0))
  2512. {
  2513. if ($isNew <= 0) {
  2514. ++$$et{CHANGED};
  2515. $verbose and print $out " Deleting MakerNotes\n";
  2516. }
  2517. next;
  2518. }
  2519. my $saveOrder = GetByteOrder();
  2520. if ($isNew >= 0 and $set{$newID}) {
  2521. # we are writing a whole new maker note block
  2522. # --> add fixup information if necessary
  2523. my $nvHash = $et->GetNewValueHash($newInfo, $dirName);
  2524. if ($nvHash and $$nvHash{MAKER_NOTE_FIXUP}) {
  2525. # must clone fixup because we will be shifting it
  2526. my $makerFixup = $$nvHash{MAKER_NOTE_FIXUP}->Clone();
  2527. my $valLen = length($valBuff);
  2528. $$makerFixup{Start} += $valLen;
  2529. push @valFixups, $makerFixup;
  2530. }
  2531. } else {
  2532. # update maker notes if possible
  2533. my %subdirInfo = (
  2534. Base => $base,
  2535. DataPt => $valueDataPt,
  2536. DataPos => $valueDataPos,
  2537. DataLen => $valueDataLen,
  2538. DirStart => $valuePtr,
  2539. DirLen => $oldSize,
  2540. DirName => 'MakerNotes',
  2541. Name => $$newInfo{Name},
  2542. Parent => $dirName,
  2543. TagInfo => $newInfo,
  2544. RAF => $raf,
  2545. );
  2546. my ($subTable, $subdir, $loc, $writeProc, $notIFD);
  2547. if ($$newInfo{SubDirectory}) {
  2548. my $sub = $$newInfo{SubDirectory};
  2549. $subdirInfo{FixBase} = 1 if $$sub{FixBase};
  2550. $subdirInfo{FixOffsets} = $$sub{FixOffsets};
  2551. $subdirInfo{EntryBased} = $$sub{EntryBased};
  2552. $subdirInfo{NoFixBase} = 1 if defined $$sub{Base};
  2553. $subdirInfo{AutoFix} = $$sub{AutoFix};
  2554. }
  2555. # get the proper tag table for these maker notes
  2556. if ($oldInfo and $$oldInfo{SubDirectory}) {
  2557. $subTable = $$oldInfo{SubDirectory}{TagTable};
  2558. $subTable and $subTable = Image::ExifTool::GetTagTable($subTable);
  2559. $writeProc = $$oldInfo{SubDirectory}{WriteProc};
  2560. $notIFD = $$oldInfo{NotIFD};
  2561. } else {
  2562. $et->Warn('Internal problem getting maker notes tag table');
  2563. }
  2564. $writeProc or $writeProc = $$subTable{WRITE_PROC} if $subTable;
  2565. $subTable or $subTable = $tagTablePtr;
  2566. if ($writeProc and
  2567. $writeProc eq \&Image::ExifTool::MakerNotes::WriteUnknownOrPreview and
  2568. $oldValue =~ /^\xff\xd8\xff/)
  2569. {
  2570. $loc = 0;
  2571. } elsif (not $notIFD) {
  2572. # look for IFD-style maker notes
  2573. $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
  2574. }
  2575. if (defined $loc) {
  2576. # we need fixup data for this subdirectory
  2577. $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
  2578. # rewrite maker notes
  2579. my $changed = $$et{CHANGED};
  2580. $subdir = $et->WriteDirectory(\%subdirInfo, $subTable, $writeProc);
  2581. if ($changed == $$et{CHANGED} and $subdirInfo{Fixup}->IsEmpty()) {
  2582. # return original data if nothing changed and no fixups
  2583. undef $subdir;
  2584. }
  2585. } elsif ($$subTable{PROCESS_PROC} and
  2586. $$subTable{PROCESS_PROC} eq \&Image::ExifTool::ProcessBinaryData)
  2587. {
  2588. my $sub = $$oldInfo{SubDirectory};
  2589. if (defined $$sub{Start}) {
  2590. #### eval Start ($valuePtr)
  2591. my $start = eval $$sub{Start};
  2592. $loc = $start - $valuePtr;
  2593. $subdirInfo{DirStart} = $start;
  2594. $subdirInfo{DirLen} -= $loc;
  2595. } else {
  2596. $loc = 0;
  2597. }
  2598. # rewrite maker notes
  2599. $subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
  2600. } elsif ($notIFD) {
  2601. if ($writeProc) {
  2602. $loc = 0;
  2603. $subdir = $et->WriteDirectory(\%subdirInfo, $subTable);
  2604. }
  2605. } else {
  2606. my $msg = 'Maker notes could not be parsed';
  2607. if ($$et{FILE_TYPE} eq 'JPEG') {
  2608. $et->Warn($msg, 1);
  2609. } else {
  2610. $et->Error($msg, 1);
  2611. }
  2612. }
  2613. if (defined $subdir) {
  2614. next unless length $subdir;
  2615. my $valLen = length($valBuff);
  2616. # restore existing header and substitute the new
  2617. # maker notes for the old value
  2618. $newValue = substr($oldValue, 0, $loc) . $subdir;
  2619. my $makerFixup = $subdirInfo{Fixup};
  2620. my $previewInfo = $$et{PREVIEW_INFO};
  2621. if ($subdirInfo{Relative}) {
  2622. # apply a one-time fixup to $loc since offsets are relative
  2623. $$makerFixup{Start} += $loc;
  2624. # shift all offsets to be relative to new base
  2625. my $baseShift = $valueDataPos + $valuePtr + $base - $subdirInfo{Base};
  2626. $$makerFixup{Shift} += $baseShift;
  2627. $makerFixup->ApplyFixup(\$newValue);
  2628. if ($previewInfo) {
  2629. # remove all but PreviewImage fixup (since others shouldn't change)
  2630. foreach (keys %{$$makerFixup{Pointers}}) {
  2631. /_PreviewImage$/ or delete $$makerFixup{Pointers}{$_};
  2632. }
  2633. # zero pointer so we can see how it gets shifted later
  2634. $makerFixup->SetMarkerPointers(\$newValue, 'PreviewImage', 0);
  2635. # set the pointer to the start of the EXIF information
  2636. # add preview image fixup to list of value fixups
  2637. $$makerFixup{Start} += $valLen;
  2638. push @valFixups, $makerFixup;
  2639. $$previewInfo{BaseShift} = $baseShift;
  2640. $$previewInfo{Relative} = 1;
  2641. }
  2642. # don't shift anything if relative flag set to zero (Pentax patch)
  2643. } elsif (not defined $subdirInfo{Relative}) {
  2644. # shift offset base if shifted in the original image or if FixBase
  2645. # was used, but be careful of automatic FixBase with negative shifts
  2646. # since they may lead to negative (invalid) offsets (casio_edit_problem.jpg)
  2647. my $baseShift = $base - $subdirInfo{Base};
  2648. if ($subdirInfo{AutoFix}) {
  2649. $baseShift = 0;
  2650. } elsif ($subdirInfo{FixBase} and $baseShift < 0 and
  2651. # allow negative base shift if offsets are bigger (PentaxOptioWP.jpg)
  2652. (not $subdirInfo{MinOffset} or $subdirInfo{MinOffset} + $baseShift < 0))
  2653. {
  2654. my $fixBase = $et->Options('FixBase');
  2655. if (not defined $fixBase) {
  2656. my $str = $et->Options('IgnoreMinorErrors') ? 'ignored' : 'fix or ignore?';
  2657. $et->Error("MakerNotes offsets may be incorrect ($str)", 1);
  2658. } elsif ($fixBase eq '') {
  2659. $et->Warn('Fixed incorrect MakerNotes offsets');
  2660. $baseShift = 0;
  2661. }
  2662. }
  2663. $$makerFixup{Start} += $valLen + $loc;
  2664. $$makerFixup{Shift} += $baseShift;
  2665. # permanently fix makernote offset errors
  2666. $$makerFixup{Shift} += $subdirInfo{FixedBy} || 0;
  2667. push @valFixups, $makerFixup;
  2668. if ($previewInfo and not $$previewInfo{NoBaseShift}) {
  2669. $$previewInfo{BaseShift} = $baseShift;
  2670. }
  2671. }
  2672. $newValuePt = \$newValue; # write new value
  2673. }
  2674. }
  2675. SetByteOrder($saveOrder);
  2676. # process existing subdirectory unless we are overwriting it entirely
  2677. } elsif ($$newInfo{SubDirectory} and $isNew <= 0 and not $isOverwriting
  2678. # don't edit directory if Writable is set to 0
  2679. and (not defined $$newInfo{Writable} or $$newInfo{Writable}))
  2680. {
  2681. my $subdir = $$newInfo{SubDirectory};
  2682. if ($$newInfo{SubIFD}) {
  2683. #
  2684. # rewrite existing sub IFD's
  2685. #
  2686. my $subTable = $tagTablePtr;
  2687. if ($$subdir{TagTable}) {
  2688. $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
  2689. }
  2690. # determine directory name for this IFD
  2691. my $subdirName = $$newInfo{Groups}{1} || $$newInfo{Name};
  2692. # all makernotes directory names must be 'MakerNotes'
  2693. $subdirName = 'MakerNotes' if $$subTable{GROUPS}{0} eq 'MakerNotes';
  2694. # must handle sub-IFD's specially since the values
  2695. # are actually offsets to subdirectories
  2696. unless ($readCount) { # can't have zero count
  2697. return undef if $et->Error("$name entry $index has zero count", 2);
  2698. next;
  2699. }
  2700. my $writeCount = 0;
  2701. my $i;
  2702. $newValue = ''; # reset value because we regenerate it below
  2703. for ($i=0; $i<$readCount; ++$i) {
  2704. my $off = $i * $formatSize[$readFormat];
  2705. my $val = ReadValue($valueDataPt, $valuePtr + $off,
  2706. $readFormName, 1, $oldSize - $off);
  2707. my $subdirStart = $val - $dataPos;
  2708. my $subdirBase = $base;
  2709. my $hdrLen;
  2710. if (defined $$subdir{Start}) {
  2711. #### eval Start ($val)
  2712. my $newStart = eval $$subdir{Start};
  2713. unless (Image::ExifTool::IsInt($newStart)) {
  2714. $et->Error("Bad subdirectory start for $$newInfo{Name}");
  2715. next;
  2716. }
  2717. $newStart -= $dataPos;
  2718. $hdrLen = $newStart - $subdirStart;
  2719. $subdirStart = $newStart;
  2720. }
  2721. if ($$subdir{Base}) {
  2722. my $start = $subdirStart + $dataPos;
  2723. #### eval Base ($start,$base)
  2724. $subdirBase += eval $$subdir{Base};
  2725. }
  2726. # add IFD number if more than one
  2727. $subdirName =~ s/\d*$/$i/ if $i;
  2728. my %subdirInfo = (
  2729. Base => $subdirBase,
  2730. DataPt => $dataPt,
  2731. DataPos => $dataPos - $subdirBase + $base,
  2732. DataLen => $dataLen,
  2733. DirStart => $subdirStart,
  2734. DirName => $subdirName,
  2735. Name => $$newInfo{Name},
  2736. TagInfo => $newInfo,
  2737. Parent => $dirName,
  2738. Fixup => new Image::ExifTool::Fixup,
  2739. RAF => $raf,
  2740. Subdir => $subdir,
  2741. # set ImageData only for 1st level SubIFD's
  2742. ImageData=> $imageDataFlag eq 'Main' ? 'SubIFD' : undef,
  2743. );
  2744. # pass on header pointer only for certain sub IFD's
  2745. $subdirInfo{HeaderPtr} = $$dirInfo{HeaderPtr} if $$newInfo{SubIFD} == 2;
  2746. if ($$subdir{RelativeBase}) {
  2747. # apply one-time fixup if offsets are relative (Sony IDC hack)
  2748. delete $subdirInfo{Fixup};
  2749. delete $subdirInfo{ImageData};
  2750. }
  2751. # is the subdirectory outside our current data?
  2752. if ($subdirStart < 0 or $subdirStart + 2 > $dataLen) {
  2753. if ($raf) {
  2754. # reset SubDirectory buffer (we will load it later)
  2755. my $buff = '';
  2756. $subdirInfo{DataPt} = \$buff;
  2757. $subdirInfo{DataLen} = 0;
  2758. } else {
  2759. my @err = ("Can't read $subdirName data", $inMakerNotes);
  2760. if ($$subTable{VARS} and $$subTable{VARS}{MINOR_ERRORS}) {
  2761. $et->Warn($err[0] . '. Ignored.');
  2762. } elsif ($et->Error(@err)) {
  2763. return undef;
  2764. }
  2765. next Entry; # don't write this directory
  2766. }
  2767. }
  2768. my $subdirData = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
  2769. unless (defined $subdirData) {
  2770. # WriteDirectory should have issued an error, but check just in case
  2771. $et->Error("Error writing $subdirName") unless $$et{VALUE}{Error};
  2772. return undef;
  2773. }
  2774. # add back original header if necessary (eg. Ricoh GR)
  2775. if ($hdrLen and $hdrLen > 0 and $subdirStart <= $dataLen) {
  2776. $subdirData = substr($$dataPt, $subdirStart - $hdrLen, $hdrLen) . $subdirData;
  2777. $subdirInfo{Fixup}{Start} += $hdrLen;
  2778. }
  2779. unless (length $subdirData) {
  2780. next unless $inMakerNotes;
  2781. # don't delete MakerNote Sub-IFD's, write empty IFD instead
  2782. $subdirData = "\0" x 6;
  2783. # reset SubIFD ImageData and Fixup just to be safe
  2784. delete $subdirInfo{ImageData};
  2785. delete $subdirInfo{Fixup};
  2786. }
  2787. # handle data blocks that we will transfer later
  2788. if (ref $subdirInfo{ImageData}) {
  2789. push @imageData, @{$subdirInfo{ImageData}};
  2790. $$origDirInfo{ImageData} = \@imageData;
  2791. }
  2792. # temporarily set value to subdirectory index
  2793. # (will set to actual offset later when we know what it is)
  2794. $newValue .= Set32u(0xfeedf00d);
  2795. my ($offset, $where);
  2796. if ($readCount > 1) {
  2797. $offset = length($valBuff) + $i * 4;
  2798. $where = 'valBuff';
  2799. } else {
  2800. $offset = length($dirBuff) + 8;
  2801. $where = 'dirBuff';
  2802. }
  2803. # add to list of subdirectories we will append later
  2804. push @subdirs, {
  2805. DataPt => \$subdirData,
  2806. Table => $subTable,
  2807. Fixup => $subdirInfo{Fixup},
  2808. Offset => $offset,
  2809. Where => $where,
  2810. ImageData => $subdirInfo{ImageData},
  2811. };
  2812. ++$writeCount; # count number of subdirs written
  2813. }
  2814. next unless length $newValue;
  2815. # must change location of subdir offset if we deleted
  2816. # a directory and only one remains
  2817. if ($writeCount < $readCount and $writeCount == 1) {
  2818. $subdirs[-1]{Where} = 'dirBuff';
  2819. $subdirs[-1]{Offset} = length($dirBuff) + 8;
  2820. }
  2821. # set new format to int32u for IFD
  2822. $newFormName = $$newInfo{FixFormat} || 'int32u';
  2823. $newFormat = $formatNumber{$newFormName};
  2824. $newValuePt = \$newValue;
  2825. } elsif ((not defined $$subdir{Start} or
  2826. $$subdir{Start} =~ /\$valuePtr/) and
  2827. $$subdir{TagTable})
  2828. {
  2829. #
  2830. # rewrite other existing subdirectories ('$valuePtr' type only)
  2831. #
  2832. # set subdirectory Start and Base
  2833. my $subdirStart = $valuePtr;
  2834. if ($$subdir{Start}) {
  2835. #### eval Start ($valuePtr)
  2836. $subdirStart = eval $$subdir{Start};
  2837. # must adjust directory size if start changed
  2838. $oldSize -= $subdirStart - $valuePtr;
  2839. }
  2840. my $subdirBase = $base;
  2841. if ($$subdir{Base}) {
  2842. my $start = $subdirStart + $valueDataPos;
  2843. #### eval Base ($start,$base)
  2844. $subdirBase += eval $$subdir{Base};
  2845. }
  2846. my $subFixup = new Image::ExifTool::Fixup;
  2847. my %subdirInfo = (
  2848. Base => $subdirBase,
  2849. DataPt => $valueDataPt,
  2850. DataPos => $valueDataPos - $subdirBase + $base,
  2851. DataLen => $valueDataLen,
  2852. DirStart => $subdirStart,
  2853. DirName => $$subdir{DirName},
  2854. DirLen => $oldSize,
  2855. Parent => $dirName,
  2856. Fixup => $subFixup,
  2857. RAF => $raf,
  2858. TagInfo => $newInfo,
  2859. );
  2860. unless ($oldSize) {
  2861. # replace with dummy data if empty to prevent WriteDirectory
  2862. # routines from accessing data they shouldn't
  2863. my $tmp = '';
  2864. $subdirInfo{DataPt} = \$tmp;
  2865. $subdirInfo{DataLen} = 0;
  2866. $subdirInfo{DirStart} = 0;
  2867. $subdirInfo{DataPos} += $subdirStart;
  2868. }
  2869. my $subTable = Image::ExifTool::GetTagTable($$subdir{TagTable});
  2870. my $oldOrder = GetByteOrder();
  2871. SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
  2872. $newValue = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
  2873. SetByteOrder($oldOrder);
  2874. if (defined $newValue) {
  2875. my $hdrLen = $subdirStart - $valuePtr;
  2876. if ($hdrLen) {
  2877. $newValue = substr($$valueDataPt, $valuePtr, $hdrLen) . $newValue;
  2878. $$subFixup{Start} += $hdrLen;
  2879. }
  2880. $newValuePt = \$newValue;
  2881. } else {
  2882. $newValuePt = \$oldValue;
  2883. }
  2884. unless (length $$newValuePt) {
  2885. # don't delete a previously empty makernote directory
  2886. next if $oldSize or not $inMakerNotes;
  2887. }
  2888. if ($$subFixup{Pointers} and $subdirInfo{Base} == $base) {
  2889. $$subFixup{Start} += length $valBuff;
  2890. push @valFixups, $subFixup;
  2891. } else {
  2892. # apply fixup in case we added a header ($hdrLen above)
  2893. $subFixup->ApplyFixup(\$newValue);
  2894. }
  2895. }
  2896. } elsif ($$newInfo{OffsetPair}) {
  2897. #
  2898. # keep track of offsets
  2899. #
  2900. my $dataTag = $$newInfo{DataTag} || '';
  2901. if ($dataTag eq 'CanonVRD') {
  2902. # must decide now if we will write CanonVRD information
  2903. my $hasVRD;
  2904. if ($$et{NEW_VALUE}{$Image::ExifTool::Extra{CanonVRD}}) {
  2905. # adding or deleting as a block
  2906. $hasVRD = $et->GetNewValue('CanonVRD') ? 1 : 0;
  2907. } elsif ($$et{DEL_GROUP}{CanonVRD} or
  2908. $$et{DEL_GROUP}{Trailer})
  2909. {
  2910. $hasVRD = 0; # deleting as a group
  2911. } else {
  2912. $hasVRD = ($$newValuePt ne "\0\0\0\0");
  2913. }
  2914. if ($hasVRD) {
  2915. # add a fixup, and set this offset later
  2916. $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
  2917. } else {
  2918. # there is (or will soon be) no VRD information, so set pointer to zero
  2919. $newValue = "\0" x length($$newValuePt);
  2920. $newValuePt = \$newValue;
  2921. }
  2922. } elsif ($dataTag eq 'OriginalDecisionData') {
  2923. # handle Canon OriginalDecisionData (no associated length tag)
  2924. # - I'm going out of my way here to preserve data which is
  2925. # invalidated anyway by our edits
  2926. my $odd;
  2927. my $oddInfo = $Image::ExifTool::Composite{OriginalDecisionData};
  2928. if ($oddInfo and $$et{NEW_VALUE}{$oddInfo}) {
  2929. $odd = $et->GetNewValue($dataTag);
  2930. if ($verbose > 1) {
  2931. print $out " - $dirName:$dataTag\n" if $$newValuePt ne "\0\0\0\0";
  2932. print $out " + $dirName:$dataTag\n" if $odd;
  2933. }
  2934. ++$$et{CHANGED};
  2935. } elsif ($$newValuePt ne "\0\0\0\0") {
  2936. if (length($$newValuePt) == 4) {
  2937. require Image::ExifTool::Canon;
  2938. my $offset = Get32u($newValuePt,0);
  2939. # absolute offset in JPEG images only
  2940. $offset += $base unless $$et{FILE_TYPE} eq 'JPEG';
  2941. $odd = Image::ExifTool::Canon::ReadODD($et, $offset);
  2942. $odd = $$odd if ref $odd;
  2943. } else {
  2944. $et->Error("Invalid $$newInfo{Name}",1);
  2945. }
  2946. }
  2947. if ($odd) {
  2948. my $newOffset = length($valBuff);
  2949. # (ODD offset is absolute in JPEG, so add base offset!)
  2950. $newOffset += $base if $$et{FILE_TYPE} eq 'JPEG';
  2951. $newValue = Set32u($newOffset);
  2952. $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
  2953. $valBuff .= $odd; # add original decision data
  2954. } else {
  2955. $newValue = "\0\0\0\0";
  2956. }
  2957. $newValuePt = \$newValue;
  2958. } else {
  2959. my $offsetInfo = $offsetInfo[$ifd];
  2960. # save original values (for updating TIFF_END later)
  2961. my @vals;
  2962. if ($isNew <= 0) {
  2963. my $oldOrder = GetByteOrder();
  2964. # Minolta A200 stores these in the wrong byte order!
  2965. SetByteOrder($$newInfo{ByteOrder}) if $$newInfo{ByteOrder};
  2966. @vals = ReadValue(\$oldValue, 0, $readFormName, $readCount, $oldSize);
  2967. SetByteOrder($oldOrder);
  2968. }
  2969. # only support int32 pointers (for now)
  2970. if ($formatSize[$newFormat] != 4 and $$newInfo{IsOffset}) {
  2971. $isNew > 0 and warn("Internal error (Offset not int32)"), return undef;
  2972. $newCount != $readCount and warn("Wrong count!"), return undef;
  2973. # change to int32
  2974. $newFormName = 'int32u';
  2975. $newFormat = $formatNumber{$newFormName};
  2976. $newValue = WriteValue(join(' ',@vals), $newFormName, $newCount);
  2977. unless (defined $newValue) {
  2978. warn "Internal error writing offsets for $$newInfo{Name}\n";
  2979. return undef;
  2980. }
  2981. }
  2982. $offsetInfo or $offsetInfo = $offsetInfo[$ifd] = { };
  2983. # save location of valuePtr in new directory
  2984. # (notice we add 10 instead of 8 for valuePtr because
  2985. # we will put a 2-byte count at start of directory later)
  2986. my $ptr = $newStart + length($dirBuff) + 10;
  2987. $newCount or $newCount = 1; # make sure count is set for offsetInfo
  2988. # save value pointer and value count for each tag
  2989. $$offsetInfo{$newID} = [$newInfo, $ptr, $newCount, \@vals, $newFormat];
  2990. }
  2991. } elsif ($$newInfo{DataMember}) {
  2992. # save any necessary data members (Make, Model, etc)
  2993. my $formatStr = $newFormName;
  2994. my $count = $newCount;
  2995. # change to specified format if necessary
  2996. if ($$newInfo{Format} and $$newInfo{Format} ne $formatStr) {
  2997. $formatStr = $$newInfo{Format};
  2998. my $format = $formatNumber{$formatStr};
  2999. # adjust number of items for new format size
  3000. $count = int(length($$newValuePt) / $formatSize[$format]) if $format;
  3001. }
  3002. my $val = ReadValue($newValuePt,0,$formatStr,$count,length($$newValuePt));
  3003. my $conv = $$newInfo{RawConv};
  3004. if ($conv) {
  3005. # let the RawConv store the (possibly converted) data member
  3006. if (ref $conv eq 'CODE') {
  3007. &$conv($val, $et);
  3008. } else {
  3009. my ($self, $tag, $taginfo) = ($et, $$newInfo{Name}, $newInfo);
  3010. #### eval RawConv ($self, $val, $tag, $tagInfo)
  3011. eval $conv;
  3012. }
  3013. } else {
  3014. $$et{$$newInfo{DataMember}} = $val;
  3015. }
  3016. }
  3017. }
  3018. #
  3019. # write out the directory entry
  3020. #
  3021. my $newSize = length($$newValuePt);
  3022. my $fsize = $formatSize[$newFormat];
  3023. my $offsetVal;
  3024. $newCount = int(($newSize + $fsize - 1) / $fsize); # set proper count
  3025. if ($newSize > 4) {
  3026. # zero-pad to an even number of bytes (required by EXIF standard)
  3027. # and make sure we are a multiple of the format size
  3028. while ($newSize & 0x01 or $newSize < $newCount * $fsize) {
  3029. $$newValuePt .= "\0";
  3030. ++$newSize;
  3031. }
  3032. my $entryBased;
  3033. if ($$dirInfo{EntryBased} or ($newInfo and $$newInfo{EntryBased})) {
  3034. $entryBased = 1;
  3035. $offsetVal = Set32u(length($valBuff) - length($dirBuff));
  3036. } else {
  3037. $offsetVal = Set32u(length $valBuff);
  3038. }
  3039. my ($dataTag, $putFirst);
  3040. ($dataTag, $putFirst) = @$newInfo{'DataTag','PutFirst'} if $newInfo;
  3041. if ($dataTag) {
  3042. if ($dataTag eq 'PreviewImage' and ($$et{FILE_TYPE} eq 'JPEG' or
  3043. $$et{GENERATE_PREVIEW_INFO}))
  3044. {
  3045. # hold onto the PreviewImage until we can determine if it fits
  3046. $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
  3047. Data => $$newValuePt,
  3048. Fixup => new Image::ExifTool::Fixup,
  3049. };
  3050. $$et{PREVIEW_INFO}{ChangeBase} = 1 if $$newInfo{ChangeBase};
  3051. if ($$newInfo{IsOffset} and $$newInfo{IsOffset} eq '2') {
  3052. $$et{PREVIEW_INFO}{NoBaseShift} = 1;
  3053. }
  3054. # use original preview size if we will attempt to load it later
  3055. $newCount = $oldCount if $$newValuePt eq 'LOAD_PREVIEW';
  3056. $$newValuePt = '';
  3057. } elsif ($dataTag eq 'LeicaTrailer' and $$et{LeicaTrailer}) {
  3058. $$newValuePt = '';
  3059. }
  3060. }
  3061. if ($putFirst and $$dirInfo{HeaderPtr}) {
  3062. my $hdrPtr = $$dirInfo{HeaderPtr};
  3063. # place this value immediately after the TIFF header (eg. IIQ maker notes)
  3064. $offsetVal = Set32u(length $$hdrPtr);
  3065. $$hdrPtr .= $$newValuePt;
  3066. } else {
  3067. $valBuff .= $$newValuePt; # add value data to buffer
  3068. # must save a fixup pointer for every pointer in the directory
  3069. if ($entryBased) {
  3070. $entryBasedFixup or $entryBasedFixup = new Image::ExifTool::Fixup;
  3071. $entryBasedFixup->AddFixup(length($dirBuff) + 8, $dataTag);
  3072. } else {
  3073. $dirFixup->AddFixup(length($dirBuff) + 8, $dataTag);
  3074. }
  3075. }
  3076. } else {
  3077. $offsetVal = $$newValuePt; # save value in offset if 4 bytes or less
  3078. # must pad value with zeros if less than 4 bytes
  3079. $newSize < 4 and $offsetVal .= "\0" x (4 - $newSize);
  3080. }
  3081. # write the directory entry
  3082. $dirBuff .= Set16u($newID) . Set16u($newFormat) .
  3083. Set32u($newCount) . $offsetVal;
  3084. # update flag to keep track of mandatory tags
  3085. while (defined $allMandatory) {
  3086. if (defined $$mandatory{$newID}) {
  3087. # values must correspond to mandatory values
  3088. my $form = $$newInfo{Format} || $newFormName;
  3089. my $mandVal = WriteValue($$mandatory{$newID}, $form, $newCount);
  3090. if (defined $mandVal and $mandVal eq $$newValuePt) {
  3091. ++$allMandatory; # count mandatory tags
  3092. last;
  3093. }
  3094. }
  3095. undef $deleteAll;
  3096. undef $allMandatory;
  3097. }
  3098. }
  3099. if ($ignoreCount) {
  3100. my $y = $ignoreCount > 1 ? 'ies' : 'y';
  3101. my $verb = $$dirInfo{FixBase} ? 'Ignored' : 'Removed';
  3102. $et->Warn("$verb $ignoreCount invalid entr$y from $name", 1);
  3103. }
  3104. if ($fixCount) {
  3105. my $s = $fixCount > 1 ? 's' : '';
  3106. $et->Warn("Fixed invalid count$s for $fixCount $name tag$s", 1);
  3107. }
  3108. #..............................................................................
  3109. # write directory counts and nextIFD pointer and add value data to end of IFD
  3110. #
  3111. # determine now if there is or will be another IFD after this one
  3112. my $nextIfdOffset;
  3113. if ($dirEnd + 4 <= $dataLen) {
  3114. $nextIfdOffset = Get32u($dataPt, $dirEnd);
  3115. } else {
  3116. $nextIfdOffset = 0;
  3117. }
  3118. my $isNextIFD = ($$dirInfo{Multi} and ($nextIfdOffset or
  3119. # account for the case where we will create the next IFD
  3120. # (IFD1 only, but not in TIFF-format images)
  3121. ($dirName eq 'IFD0' and $$et{ADD_DIRS}{'IFD1'} and
  3122. $$et{FILE_TYPE} ne 'TIFF')));
  3123. # calculate number of entries in new directory
  3124. my $newEntries = length($dirBuff) / 12;
  3125. # delete entire directory if we deleted a tag and only mandatory tags remain or we
  3126. # attempted to create a directory with only mandatory tags and there is no nextIFD
  3127. if ($allMandatory and not $isNextIFD and ($newEntries < $numEntries or $numEntries == 0)) {
  3128. $newEntries = 0;
  3129. $dirBuff = '';
  3130. $valBuff = '';
  3131. undef $dirFixup; # no fixups in this directory
  3132. ++$deleteAll if defined $deleteAll;
  3133. $verbose > 1 and print $out " - $allMandatory mandatory tag(s)\n";
  3134. $$et{CHANGED} -= $addMandatory; # didn't change these after all
  3135. }
  3136. if ($ifd and not $newEntries) {
  3137. $verbose and print $out " Deleting IFD1\n";
  3138. last; # don't write IFD1 if empty
  3139. }
  3140. # apply one-time fixup for entry-based offsets
  3141. if ($entryBasedFixup) {
  3142. $$entryBasedFixup{Shift} = length($dirBuff) + 4;
  3143. $entryBasedFixup->ApplyFixup(\$dirBuff);
  3144. undef $entryBasedFixup;
  3145. }
  3146. # initialize next IFD pointer to zero
  3147. my $nextIFD = Set32u(0);
  3148. # some cameras use a different amount of padding after the makernote IFD
  3149. if ($dirName eq 'MakerNotes' and $$dirInfo{Parent} =~ /^(ExifIFD|IFD0)$/) {
  3150. my ($rel, $pad) = Image::ExifTool::MakerNotes::GetMakerNoteOffset($et);
  3151. $nextIFD = "\0" x $pad if defined $pad and ($pad==0 or ($pad>4 and $pad<=32));
  3152. }
  3153. # add directory entry count to start of IFD and next IFD pointer to end
  3154. $newData .= Set16u($newEntries) . $dirBuff . $nextIFD;
  3155. # get position of value data in newData
  3156. my $valPos = length($newData);
  3157. # go back now and set next IFD pointer if this isn't the first IFD
  3158. if ($nextIfdPos) {
  3159. # set offset to next IFD
  3160. Set32u($newStart, \$newData, $nextIfdPos);
  3161. $fixup->AddFixup($nextIfdPos,'NextIFD'); # add fixup for this offset in newData
  3162. }
  3163. # remember position of 'next IFD' pointer so we can set it next time around
  3164. $nextIfdPos = length($nextIFD) ? $valPos - length($nextIFD) : undef;
  3165. # add value data after IFD
  3166. $newData .= $valBuff;
  3167. #
  3168. # add any subdirectories, adding fixup information
  3169. #
  3170. if (@subdirs) {
  3171. my $subdir;
  3172. foreach $subdir (@subdirs) {
  3173. my $len = length($newData); # position of subdirectory in data
  3174. my $subdirFixup = $$subdir{Fixup};
  3175. if ($subdirFixup) {
  3176. $$subdirFixup{Start} += $len;
  3177. $fixup->AddFixup($subdirFixup);
  3178. }
  3179. my $imageData = $$subdir{ImageData};
  3180. my $blockSize = 0;
  3181. # must also update start position for ImageData fixups
  3182. if (ref $imageData) {
  3183. my $blockInfo;
  3184. foreach $blockInfo (@$imageData) {
  3185. my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
  3186. if ($subFix) {
  3187. $$subFix{Start} += $len;
  3188. # save expected image data offset for calculating shift later
  3189. $$subFix{BlockLen} = length(${$$subdir{DataPt}}) + $blockSize;
  3190. }
  3191. $blockSize += $size + $pad;
  3192. }
  3193. }
  3194. $newData .= ${$$subdir{DataPt}}; # add subdirectory to our data
  3195. undef ${$$subdir{DataPt}}; # free memory now
  3196. # set the pointer
  3197. my $offset = $$subdir{Offset};
  3198. # if offset is in valBuff, it was added to the end of dirBuff
  3199. # (plus 4 bytes for nextIFD pointer)
  3200. $offset += length($dirBuff) + 4 if $$subdir{Where} eq 'valBuff';
  3201. $offset += $newStart + 2; # get offset in newData
  3202. # check to be sure we got the right offset
  3203. unless (Get32u(\$newData, $offset) == 0xfeedf00d) {
  3204. $et->Error("Internal error while rewriting $name");
  3205. return undef;
  3206. }
  3207. # set the offset to the subdirectory data
  3208. Set32u($len, \$newData, $offset);
  3209. $fixup->AddFixup($offset); # add fixup for this offset in newData
  3210. }
  3211. }
  3212. # add fixup for all offsets in directory according to value data position
  3213. # (which is at the end of this directory)
  3214. if ($dirFixup) {
  3215. $$dirFixup{Start} = $newStart + 2;
  3216. $$dirFixup{Shift} = $valPos - $$dirFixup{Start};
  3217. $fixup->AddFixup($dirFixup);
  3218. }
  3219. # add valueData fixups, adjusting for position of value data
  3220. my $valFixup;
  3221. foreach $valFixup (@valFixups) {
  3222. $$valFixup{Start} += $valPos;
  3223. $fixup->AddFixup($valFixup);
  3224. }
  3225. # stop if no next IFD pointer
  3226. last unless $isNextIFD; # stop unless scanning for multiple IFD's
  3227. if ($nextIfdOffset) {
  3228. # continue with next IFD
  3229. $dirStart = $nextIfdOffset - $dataPos;
  3230. } else {
  3231. # create IFD1 if necessary
  3232. $verbose and print $out " Creating IFD1\n";
  3233. my $ifd1 = "\0" x 2; # empty IFD1 data (zero entry count)
  3234. $dataPt = \$ifd1;
  3235. $dirStart = 0;
  3236. $dirLen = $dataLen = 2;
  3237. }
  3238. # increment IFD name
  3239. my $ifdNum = $dirName =~ s/(\d+)$// ? $1 : 0;
  3240. $dirName .= $ifdNum + 1;
  3241. $name =~ s/\d+$//;
  3242. $name .= $ifdNum + 1;
  3243. $$et{DIR_NAME} = $$et{PATH}[-1] = $dirName;
  3244. next unless $nextIfdOffset;
  3245. # guard against writing the same directory twice
  3246. my $addr = $nextIfdOffset + $base;
  3247. if ($$et{PROCESSED}{$addr}) {
  3248. $et->Error("$name pointer references previous $$et{PROCESSED}{$addr} directory", 1);
  3249. last;
  3250. }
  3251. $$et{PROCESSED}{$addr} = $name;
  3252. if ($dirName eq 'SubIFD1' and not ValidateIFD($dirInfo, $dirStart)) {
  3253. if ($$et{TIFF_TYPE} eq 'TIFF') {
  3254. $et->Error('Ignored bad IFD linked from SubIFD', 1);
  3255. } elsif ($verbose) {
  3256. $et->Warn('Ignored bad IFD linked from SubIFD');
  3257. }
  3258. last; # don't write bad IFD
  3259. }
  3260. if ($$et{DEL_GROUP}{$dirName}) {
  3261. $verbose and print $out " Deleting $dirName\n";
  3262. $raf and $et->Error("Deleting $dirName also deletes subsequent" .
  3263. " IFD's and possibly image data", 1);
  3264. ++$$et{CHANGED};
  3265. if ($$et{DEL_GROUP}{$dirName} == 2 and
  3266. $$et{ADD_DIRS}{$dirName})
  3267. {
  3268. my $emptyIFD = "\0" x 2; # start with empty IFD
  3269. $dataPt = \$emptyIFD;
  3270. $dirStart = 0;
  3271. $dirLen = $dataLen = 2;
  3272. } else {
  3273. last; # don't write this IFD (or any subsequent IFD)
  3274. }
  3275. } else {
  3276. $verbose and print $out " Rewriting $name\n";
  3277. }
  3278. }
  3279. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  3280. # do our fixups now so we can more easily calculate offsets below
  3281. $fixup->ApplyFixup(\$newData);
  3282. #
  3283. # determine total block size for deferred data
  3284. #
  3285. my $numBlocks = scalar @imageData; # save this so we scan only existing blocks later
  3286. my $blockSize = 0; # total size of blocks to copy later
  3287. my $blockInfo;
  3288. foreach $blockInfo (@imageData) {
  3289. my ($pos, $size, $pad) = @$blockInfo;
  3290. $blockSize += $size + $pad;
  3291. }
  3292. #
  3293. # copy over image data for IFD's, starting with the last IFD first
  3294. #
  3295. if (@offsetInfo) {
  3296. my $ttwLen; # length of MRW TTW segment
  3297. my @writeLater; # write image data last
  3298. for ($ifd=$#offsetInfo; $ifd>=-1; --$ifd) {
  3299. # build list of offsets to process
  3300. my @offsetList;
  3301. if ($ifd >= 0) {
  3302. my $offsetInfo = $offsetInfo[$ifd] or next;
  3303. # patch Panasonic RAW/RW2 StripOffsets/StripByteCounts if necessary
  3304. my $stripOffsets = $$offsetInfo{0x111};
  3305. if ($stripOffsets and $$stripOffsets[0]{PanasonicHack}) {
  3306. require Image::ExifTool::PanasonicRaw;
  3307. my $err = Image::ExifTool::PanasonicRaw::PatchRawDataOffset($offsetInfo, $raf, $ifd);
  3308. $err and $et->Error($err);
  3309. }
  3310. my $tagID;
  3311. # loop through all tags in reverse order so we save thumbnail
  3312. # data before main image data if both exist in the same IFD
  3313. foreach $tagID (reverse sort keys %$offsetInfo) {
  3314. my $tagInfo = $$offsetInfo{$tagID}[0];
  3315. next unless $$tagInfo{IsOffset}; # handle byte counts with offsets
  3316. my $sizeInfo = $$offsetInfo{$$tagInfo{OffsetPair}};
  3317. $sizeInfo or $et->Error("No size tag for $dirName:$$tagInfo{Name}"), next;
  3318. my $dataTag = $$tagInfo{DataTag};
  3319. # write TIFF image data (strips or tiles) later if requested
  3320. if ($raf and defined $$origDirInfo{ImageData} and
  3321. ($tagID == 0x111 or $tagID == 0x144 or
  3322. # also defer writing of other big data such as JpgFromRaw in NEF
  3323. ($$sizeInfo[3][0] and
  3324. # (calculate approximate combined size of all blocks)
  3325. $$sizeInfo[3][0] * scalar(@{$$sizeInfo[3]}) > 1000000)) and
  3326. # but don't defer writing if replacing with new value
  3327. (not defined $dataTag or not defined $offsetData{$dataTag}))
  3328. {
  3329. push @writeLater, [ $$offsetInfo{$tagID}, $sizeInfo ];
  3330. } else {
  3331. push @offsetList, [ $$offsetInfo{$tagID}, $sizeInfo ];
  3332. }
  3333. }
  3334. } else {
  3335. last unless @writeLater;
  3336. @offsetList = @writeLater;
  3337. }
  3338. my $offsetPair;
  3339. foreach $offsetPair (@offsetList) {
  3340. my ($tagInfo, $offsets, $count, $oldOffset) = @{$$offsetPair[0]};
  3341. my ($cntInfo, $byteCounts, $count2, $oldSize, $format) = @{$$offsetPair[1]};
  3342. # must be the same number of offset and byte count values
  3343. unless ($count == $count2) {
  3344. $et->Error("Offsets/ByteCounts disagree on count for $$tagInfo{Name}");
  3345. return undef;
  3346. }
  3347. my $formatStr = $formatName[$format];
  3348. # follow pointer to value data if necessary
  3349. $count > 1 and $offsets = Get32u(\$newData, $offsets);
  3350. my $n = $count * $formatSize[$format];
  3351. $n > 4 and $byteCounts = Get32u(\$newData, $byteCounts);
  3352. if ($byteCounts < 0 or $byteCounts + $n > length($newData)) {
  3353. $et->Error("Error reading $$tagInfo{Name} byte counts");
  3354. return undef;
  3355. }
  3356. # get offset base and data pos (abnormal for some preview images)
  3357. my ($dbase, $dpos, $wrongBase, $subIfdDataFixup);
  3358. if ($$tagInfo{IsOffset} eq '2') {
  3359. $dbase = $firstBase;
  3360. $dpos = $dataPos + $base - $firstBase;
  3361. } else {
  3362. $dbase = $base;
  3363. $dpos = $dataPos;
  3364. }
  3365. # use different base if necessary for some offsets (Minolta A200)
  3366. if ($$tagInfo{WrongBase}) {
  3367. my $self = $et;
  3368. #### eval WrongBase ($self)
  3369. $wrongBase = eval $$tagInfo{WrongBase} || 0;
  3370. $dbase += $wrongBase;
  3371. $dpos -= $wrongBase;
  3372. } else {
  3373. $wrongBase = 0;
  3374. }
  3375. my $oldOrder = GetByteOrder();
  3376. my $dataTag = $$tagInfo{DataTag};
  3377. # use different byte order for values of this offset pair if required (Minolta A200)
  3378. SetByteOrder($$tagInfo{ByteOrder}) if $$tagInfo{ByteOrder};
  3379. # transfer the data referenced by all offsets of this tag
  3380. for ($n=0; $n<$count; ++$n) {
  3381. my ($oldEnd, $size);
  3382. if (@$oldOffset and @$oldSize) {
  3383. # calculate end offset of this block
  3384. $oldEnd = $$oldOffset[$n] + $$oldSize[$n];
  3385. # update TIFF_END as if we read this data from file
  3386. UpdateTiffEnd($et, $oldEnd + $dbase);
  3387. }
  3388. my $offsetPos = $offsets + $n * 4;
  3389. my $byteCountPos = $byteCounts + $n * $formatSize[$format];
  3390. if ($$tagInfo{PanasonicHack}) {
  3391. # use actual raw data length (may be different than StripByteCounts!)
  3392. $size = $$oldSize[$n];
  3393. } else {
  3394. # use size of new data
  3395. $size = ReadValue(\$newData, $byteCountPos, $formatStr, 1, 4);
  3396. }
  3397. my $offset = $$oldOffset[$n];
  3398. if (defined $offset) {
  3399. $offset -= $dpos;
  3400. } elsif ($size != 0xfeedfeed) {
  3401. $et->Error('Internal error (no offset)');
  3402. return undef;
  3403. }
  3404. my $newOffset = length($newData) - $wrongBase;
  3405. my $buff;
  3406. # look for 'feed' code to use our new data
  3407. if ($size == 0xfeedfeed) {
  3408. unless (defined $dataTag) {
  3409. $et->Error("No DataTag defined for $$tagInfo{Name}");
  3410. return undef;
  3411. }
  3412. unless (defined $offsetData{$dataTag}) {
  3413. $et->Error("Internal error (no $dataTag)");
  3414. return undef;
  3415. }
  3416. if ($count > 1) {
  3417. $et->Error("Can't modify $$tagInfo{Name} with count $count");
  3418. return undef;
  3419. }
  3420. $buff = $offsetData{$dataTag};
  3421. if ($formatSize[$format] != 4) {
  3422. $et->Error("$$cntInfo{Name} is not int32");
  3423. return undef;
  3424. }
  3425. # set the data size
  3426. $size = length($buff);
  3427. Set32u($size, \$newData, $byteCountPos);
  3428. } elsif ($ifd < 0) {
  3429. # pad if necessary (but don't pad contiguous image blocks)
  3430. my $pad = 0;
  3431. ++$pad if $size & 0x01 and ($n+1 >= $count or not $oldEnd or
  3432. $oldEnd != $$oldOffset[$n+1]);
  3433. # preserve original image padding if specified
  3434. if ($$origDirInfo{PreserveImagePadding} and $n+1 < $count and
  3435. $oldEnd and $$oldOffset[$n+1] > $oldEnd)
  3436. {
  3437. $pad = $$oldOffset[$n+1] - $oldEnd;
  3438. }
  3439. # copy data later
  3440. push @imageData, [$offset+$dbase+$dpos, $size, $pad];
  3441. $newOffset += $blockSize; # data comes after other deferred data
  3442. # create fixup for SubIFD ImageData
  3443. if ($imageDataFlag eq 'SubIFD' and not $subIfdDataFixup) {
  3444. $subIfdDataFixup = new Image::ExifTool::Fixup;
  3445. $imageData[-1][4] = $subIfdDataFixup;
  3446. }
  3447. $size += $pad; # account for pad byte if necessary
  3448. # return ImageData list
  3449. $$origDirInfo{ImageData} = \@imageData;
  3450. } elsif ($offset >= 0 and $offset+$size <= $dataLen) {
  3451. # take data from old dir data buffer
  3452. $buff = substr($$dataPt, $offset, $size);
  3453. } elsif ($$et{TIFF_TYPE} eq 'MRW') {
  3454. # TTW segment must be an even 4 bytes long, so pad now if necessary
  3455. my $n = length $newData;
  3456. $buff = ($n & 0x03) ? "\0" x (4 - ($n & 0x03)) : '';
  3457. $size = length($buff);
  3458. # data exists after MRW TTW segment
  3459. $ttwLen = length($newData) + $size unless defined $ttwLen;
  3460. $newOffset = $offset + $dpos + $ttwLen - $dataLen;
  3461. } elsif ($raf and $raf->Seek($offset+$dbase+$dpos,0) and
  3462. $raf->Read($buff,$size) == $size)
  3463. {
  3464. # (data was read OK)
  3465. # patch incorrect ThumbnailOffset in Sony A100 1.00 ARW images
  3466. if ($$et{TIFF_TYPE} eq 'ARW' and $$tagInfo{Name} eq 'ThumbnailOffset' and
  3467. $$et{Model} eq 'DSLR-A100' and $buff !~ /^\xff\xd8\xff/)
  3468. {
  3469. my $pos = $offset + $dbase + $dpos;
  3470. my $try;
  3471. if ($pos < 0x10000 and $raf->Seek($pos+0x10000,0) and
  3472. $raf->Read($try,$size) == $size and $try =~ /^\xff\xd8\xff/)
  3473. {
  3474. $buff = $try;
  3475. $et->Warn('Adjusted incorrect A100 ThumbnailOffset', 1);
  3476. } else {
  3477. $et->Error('Invalid ThumbnailImage');
  3478. }
  3479. }
  3480. } elsif ($$tagInfo{Name} eq 'ThumbnailOffset' and $offset>=0 and $offset<$dataLen) {
  3481. # Grrr. The Canon 350D writes the thumbnail with an incorrect byte count
  3482. my $diff = $offset + $size - $dataLen;
  3483. $et->Warn("ThumbnailImage runs outside EXIF data by $diff bytes (truncated)",1);
  3484. # set the size to the available data
  3485. $size -= $diff;
  3486. unless (WriteValue($size, $formatStr, 1, \$newData, $byteCountPos)) {
  3487. warn 'Internal error writing thumbnail size';
  3488. }
  3489. # get the truncated image
  3490. $buff = substr($$dataPt, $offset, $size);
  3491. } elsif ($$tagInfo{Name} eq 'PreviewImageStart' and $$et{FILE_TYPE} eq 'JPEG') {
  3492. # try to load the preview image using the specified offset
  3493. undef $buff;
  3494. my $r = $$et{RAF};
  3495. if ($r and not $raf) {
  3496. my $tell = $r->Tell();
  3497. # read and validate
  3498. undef $buff unless $r->Seek($offset+$base+$dataPos,0) and
  3499. $r->Read($buff,$size) == $size and
  3500. $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/s;
  3501. $r->Seek($tell, 0) or $et->Error('Seek error'), return undef;
  3502. }
  3503. # set flag if we must load PreviewImage
  3504. $buff = 'LOAD_PREVIEW' unless defined $buff;
  3505. } else {
  3506. my $dataName = $dataTag || $$tagInfo{Name};
  3507. return undef if $et->Error("Error reading $dataName data in $name", $inMakerNotes);
  3508. $buff = '';
  3509. }
  3510. if ($$tagInfo{Name} eq 'PreviewImageStart') {
  3511. if ($$et{FILE_TYPE} eq 'JPEG' and not $$tagInfo{MakerPreview}) {
  3512. # hold onto the PreviewImage until we can determine if it fits
  3513. $$et{PREVIEW_INFO} or $$et{PREVIEW_INFO} = {
  3514. Data => $buff,
  3515. Fixup => new Image::ExifTool::Fixup,
  3516. };
  3517. if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '2') {
  3518. $$et{PREVIEW_INFO}{NoBaseShift} = 1;
  3519. }
  3520. if ($offset >= 0 and $offset+$size <= $dataLen) {
  3521. # set flag indicating this preview wasn't in a trailer
  3522. $$et{PREVIEW_INFO}{WasContained} = 1;
  3523. }
  3524. $buff = '';
  3525. } elsif ($$et{TIFF_TYPE} eq 'ARW' and $$et{Model} eq 'DSLR-A100') {
  3526. # the A100 double-references the same preview, so ignore the
  3527. # second one (the offset and size will be patched later)
  3528. next if $$et{A100PreviewLength};
  3529. $$et{A100PreviewLength} = length $buff if defined $buff;
  3530. }
  3531. }
  3532. # update offset accordingly and add to end of new data
  3533. Set32u($newOffset, \$newData, $offsetPos);
  3534. # add a pointer to fix up this offset value (marked with DataTag name)
  3535. $fixup->AddFixup($offsetPos, $dataTag);
  3536. # also add to subIfdDataFixup if necessary
  3537. $subIfdDataFixup->AddFixup($offsetPos, $dataTag) if $subIfdDataFixup;
  3538. # must also (sometimes) update StripOffsets in Panasonic RW2 images
  3539. my $otherPos = $$offsetPair[0][5];
  3540. if ($otherPos and $$tagInfo{PanasonicHack}) {
  3541. Set32u($newOffset, \$newData, $otherPos);
  3542. $fixup->AddFixup($otherPos, $dataTag);
  3543. }
  3544. if ($ifd >= 0) {
  3545. # buff length must be even (Note: may have changed since $size was set)
  3546. $buff .= "\0" if length($buff) & 0x01;
  3547. $newData .= $buff; # add this strip to the data
  3548. } else {
  3549. $blockSize += $size; # keep track of total size
  3550. }
  3551. }
  3552. SetByteOrder($oldOrder);
  3553. }
  3554. }
  3555. # verify that nothing else got written after determining TTW length
  3556. if (defined $ttwLen and $ttwLen != length($newData)) {
  3557. $et->Error('Internal error writing MRW TTW');
  3558. }
  3559. }
  3560. #
  3561. # set offsets and generate fixups for tag values which were too large for memory
  3562. #
  3563. $blockSize = 0;
  3564. foreach $blockInfo (@imageData) {
  3565. my ($pos, $size, $pad, $entry, $subFix) = @$blockInfo;
  3566. if (defined $entry) {
  3567. my $format = Get16u(\$newData, $entry + 2);
  3568. if ($format < 1 or $format > 13) {
  3569. $et->Error('Internal error copying huge value');
  3570. last;
  3571. } else {
  3572. # set count and offset in directory entry
  3573. Set32u($size / $formatSize[$format], \$newData, $entry + 4);
  3574. Set32u(length($newData)+$blockSize, \$newData, $entry + 8);
  3575. $fixup->AddFixup($entry + 8);
  3576. # create special fixup for SubIFD data
  3577. if ($imageDataFlag eq 'SubIFD') {
  3578. my $subIfdDataFixup = new Image::ExifTool::Fixup;
  3579. $subIfdDataFixup->AddFixup($entry + 8);
  3580. # save fixup in imageData list
  3581. $$blockInfo[4] = $subIfdDataFixup;
  3582. }
  3583. # must reset entry pointer so we don't use it again in a parent IFD!
  3584. $$blockInfo[3] = undef;
  3585. }
  3586. }
  3587. # apply additional shift required for contained SubIFD image data offsets
  3588. if ($subFix and defined $$subFix{BlockLen} and $numBlocks > 0) {
  3589. # our offset expects the data at the end of the SubIFD block (BlockLen + Start),
  3590. # but it will actually be at length($newData) + $blockSize. So adjust
  3591. # accordingly (and subtract an extra Start because this shift is applied later)
  3592. $$subFix{Shift} += length($newData) - $$subFix{BlockLen} - 2 * $$subFix{Start} + $blockSize;
  3593. $subFix->ApplyFixup(\$newData);
  3594. }
  3595. $blockSize += $size + $pad;
  3596. --$numBlocks;
  3597. }
  3598. #
  3599. # apply final shift to new data position if this is the top level IFD
  3600. #
  3601. unless ($$dirInfo{Fixup}) {
  3602. my $hdrPtr = $$dirInfo{HeaderPtr};
  3603. my $newDataPos = $hdrPtr ? length $$hdrPtr : $$dirInfo{NewDataPos} || 0;
  3604. # adjust CanonVRD offset to point to end of regular TIFF if necessary
  3605. # (NOTE: This will be incorrect if multiple trailers exist,
  3606. # but it is unlikely that it could ever be correct in this case anyway.
  3607. # Also, this doesn't work for JPEG images (but CanonDPP doesn't set
  3608. # this when editing JPEG images anyway))
  3609. $fixup->SetMarkerPointers(\$newData, 'CanonVRD', length($newData) + $blockSize);
  3610. if ($newDataPos) {
  3611. $$fixup{Shift} += $newDataPos;
  3612. $fixup->ApplyFixup(\$newData);
  3613. }
  3614. # save fixup for adjusting Leica trailer offset if necessary
  3615. $$et{LeicaTrailer}{Fixup}->AddFixup($fixup) if $$et{LeicaTrailer};
  3616. # save fixup for PreviewImage in JPEG file if necessary
  3617. my $previewInfo = $$et{PREVIEW_INFO};
  3618. if ($previewInfo) {
  3619. my $pt = \$$previewInfo{Data}; # image data or 'LOAD_PREVIEW' flag
  3620. # now that we know the size of the EXIF data, first test to see if our new image fits
  3621. # inside the EXIF segment (remember about the TIFF and EXIF headers: 8+6 bytes)
  3622. if (($$pt ne 'LOAD_PREVIEW' and length($$pt) + length($newData) + 14 <= 0xfffd and
  3623. not $$previewInfo{IsTrailer}) or
  3624. $$previewInfo{IsShort}) # must fit in this segment if using short pointers
  3625. {
  3626. # It fits! (or must exist in EXIF segment), so fixup the
  3627. # PreviewImage pointers and stuff the preview image in here
  3628. my $newPos = length($newData) + $newDataPos;
  3629. $newPos += ($$previewInfo{BaseShift} || 0);
  3630. if ($$previewInfo{Relative}) {
  3631. # calculate our base by looking at how far the pointer got shifted
  3632. $newPos -= ($fixup->GetMarkerPointers(\$newData, 'PreviewImage') || 0);
  3633. }
  3634. $fixup->SetMarkerPointers(\$newData, 'PreviewImage', $newPos);
  3635. $newData .= $$pt;
  3636. # set flag to delete old preview unless it was contained in the EXIF
  3637. $$et{DEL_PREVIEW} = 1 unless $$et{PREVIEW_INFO}{WasContained};
  3638. delete $$et{PREVIEW_INFO}; # done with our preview data
  3639. } else {
  3640. # Doesn't fit, or we still don't know, so save fixup information
  3641. # and put the preview at the end of the file
  3642. $$previewInfo{Fixup} or $$previewInfo{Fixup} = new Image::ExifTool::Fixup;
  3643. $$previewInfo{Fixup}->AddFixup($fixup);
  3644. }
  3645. } elsif (defined $newData and $deleteAll) {
  3646. $newData = ''; # delete both IFD0 and IFD1 since only mandatory tags remain
  3647. } elsif ($$et{A100PreviewLength}) {
  3648. # save preview image start for patching A100 quirks later
  3649. $$et{A100PreviewStart} = $fixup->GetMarkerPointers(\$newData, 'PreviewImage');
  3650. }
  3651. # save location of last IFD for use in Canon RAW header
  3652. if ($newDataPos == 16) {
  3653. my @ifdPos = $fixup->GetMarkerPointers(\$newData,'NextIFD');
  3654. $$origDirInfo{LastIFD} = pop @ifdPos;
  3655. }
  3656. # recrypt SR2 SubIFD data if necessary
  3657. my $key = $$et{SR2SubIFDKey};
  3658. if ($key) {
  3659. my $start = $fixup->GetMarkerPointers(\$newData, 'SR2SubIFDOffset');
  3660. my $len = $$et{SR2SubIFDLength};
  3661. # (must subtract 8 for size of TIFF header)
  3662. if ($start and $start - 8 + $len <= length $newData) {
  3663. require Image::ExifTool::Sony;
  3664. Image::ExifTool::Sony::Decrypt(\$newData, $start - 8, $len, $key);
  3665. }
  3666. }
  3667. }
  3668. # return empty string if no entries in directory
  3669. # (could be up to 10 bytes and still be empty)
  3670. $newData = '' if defined $newData and length($newData) < 12;
  3671. return $newData; # return our directory data
  3672. }
  3673. 1; # end
  3674. __END__
  3675. =head1 NAME
  3676. Image::ExifTool::WriteExif.pl - Write EXIF meta information
  3677. =head1 SYNOPSIS
  3678. This file is autoloaded by Image::ExifTool::Exif.
  3679. =head1 DESCRIPTION
  3680. This file contains routines to write EXIF metadata.
  3681. =head1 AUTHOR
  3682. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  3683. This library is free software; you can redistribute it and/or modify it
  3684. under the same terms as Perl itself.
  3685. =head1 SEE ALSO
  3686. L<Image::ExifTool::Exif(3pm)|Image::ExifTool::Exif>,
  3687. L<Image::ExifTool(3pm)|Image::ExifTool>
  3688. =cut