1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636 |
- #------------------------------------------------------------------------------
- # File: ExifTool.pm
- #
- # Description: Read and write meta information
- #
- # URL: http://owl.phy.queensu.ca/~phil/exiftool/
- #
- # Revisions: Nov. 12/2003 - P. Harvey Created
- # (See html/history.html for revision history)
- #
- # Legal: Copyright (c) 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
- # This library is free software; you can redistribute it and/or
- # modify it under the same terms as Perl itself.
- #------------------------------------------------------------------------------
- package Image::ExifTool;
- use strict;
- require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do)
- require Exporter;
- use File::RandomAccess;
- use vars qw($VERSION $RELEASE @ISA @EXPORT_OK %EXPORT_TAGS $AUTOLOAD @fileTypes
- %allTables @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr
- $psAPP13hdr $psAPP13old @loadAllTables %UserDefined $evalWarning
- %noWriteFile %magicNumber @langs $defaultLang %langName %charsetName
- %mimeType $swapBytes $swapWords $currentByteOrder %unpackStd
- %jpegMarker %specialTags);
- $VERSION = '10.10';
- $RELEASE = '';
- @ISA = qw(Exporter);
- %EXPORT_TAGS = (
- # all public non-object-oriented functions:
- Public => [qw(
- ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
- GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
- AddUserDefinedTags
- )],
- # exports not part of the public API, but used by ExifTool modules:
- DataAccess => [qw(
- ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
- Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write
- WriteValue Tell Set8u Set8s Set16u Set32u
- )],
- Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)],
- Vars => [qw(%allTables @tableOrder @fileTypes)],
- );
- # set all of our EXPORT_TAGS in EXPORT_OK
- Exporter::export_ok_tags(keys %EXPORT_TAGS);
- # test for problems that can arise if encoding.pm is used
- { my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; }
- # The following functions defined in Image::ExifTool::Writer are declared
- # here so their prototypes will be available. These Writer routines will be
- # autoloaded when any of them is called.
- sub SetNewValue($;$$%);
- sub SetNewValuesFromFile($$;@);
- sub GetNewValue($$;$);
- sub GetNewValues($$;$);
- sub CountNewValues($);
- sub SaveNewValues($);
- sub RestoreNewValues($);
- sub WriteInfo($$;$$);
- sub SetFileModifyDate($$;$$$);
- sub SetFileName($$;$$);
- sub GetAllTags(;$);
- sub GetWritableTags(;$);
- sub GetAllGroups($);
- sub GetNewGroups($);
- sub GetDeleteGroups();
- sub AddUserDefinedTags($%);
- # non-public routines below
- sub InsertTagValues($$$;$);
- sub IsWritable($);
- sub GetNewFileName($$);
- sub LoadAllTables();
- sub GetNewTagInfoList($;$);
- sub GetNewTagInfoHash($@);
- sub GetLangInfo($$);
- sub Get64s($$);
- sub Get64u($$);
- sub GetExtended($$);
- sub DecodeBits($$;$);
- sub EncodeBits($$;$$);
- sub HexDump($;$%);
- sub DumpTrailer($$);
- sub DumpUnknownTrailer($$);
- sub VerboseInfo($$$%);
- sub VerboseDir($$;$$);
- sub VerboseValue($$$;$);
- sub VPrint($$@);
- sub Rationalize($;$);
- sub Write($@);
- sub WriteTrailerBuffer($$$);
- sub AddNewTrailers($;@);
- sub Tell($);
- sub WriteValue($$;$$$$);
- sub WriteDirectory($$$;$);
- sub WriteBinaryData($$$);
- sub CheckBinaryData($$$);
- sub WriteTIFF($$$);
- sub PackUTF8(@);
- sub UnpackUTF8($);
- sub SetPreferredByteOrder($);
- sub CopyBlock($$$);
- sub CopyFileAttrs($$);
- sub TimeNow(;$);
- sub NewGUID();
- # other subroutine definitions
- sub EncodeFileName($$;$);
- sub Open($*$;$);
- sub Exists($$);
- sub IsDirectory($$);
- sub Rename($$$);
- sub Unlink($@);
- sub SetFileTime($$;$$$);
- sub DoEscape($$);
- sub ConvertFileSize($);
- sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem)
- sub ReadValue($$$$$;$);
- # list of main tag tables to load in LoadAllTables() (sub-tables are recursed
- # automatically). Note: They will appear in this order in the documentation
- # unless tweaked in BuildTagLookup::GetTableOrder().
- @loadAllTables = qw(
- PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw Lytro MinoltaRaw PanasonicRaw
- SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 PICT PNG MNG DjVu DPX OpenEXR
- MIFF PGF PSP PhotoCD Radiance PDF PostScript Photoshop::Header FujiFilm::RAF
- FujiFilm::IFD Samsung::Trailer Sony::SRF2 Sony::SR2SubIFD Sony::PMP ITC ID3
- Vorbis Ogg APE APE::NewHeader APE::OldHeader Audible MPC MPEG::Audio
- MPEG::Video MPEG::Xing M2TS QuickTime QuickTime::ImageFile Matroska MOI MXF
- DV Flash Flash::FLV Real::Media Real::Audio Real::Metafile RIFF AIFF ASF
- DICOM MIE HTML XMP::SVG Palm Palm::MOBI Palm::EXTH Torrent EXE
- EXE::PEVersion EXE::PEString EXE::MachO EXE::PEF EXE::ELF EXE::CHM LNK Font
- VCard VCard::VCalendar RSRC Rawzor ZIP ZIP::GZIP ZIP::RAR RTF OOXML iWork
- FLIR::AFF FLIR::FPF
- );
- # alphabetical list of current Lang modules
- @langs = qw(cs de en en_ca en_gb es fi fr it ja ko nl pl ru sv tr zh_cn zh_tw);
- $defaultLang = 'en'; # default language
- # language names
- %langName = (
- cs => 'Czech (Čeština)',
- de => 'German (Deutsch)',
- en => 'English',
- en_ca => 'Canadian English',
- en_gb => 'British English',
- es => 'Spanish (Español)',
- fi => 'Finnish (Suomi)',
- fr => 'French (Français)',
- it => 'Italian (Italiano)',
- ja => 'Japanese (日本語)',
- ko => 'Korean (한국어)',
- nl => 'Dutch (Nederlands)',
- pl => 'Polish (Polski)',
- ru => 'Russian (Русский)',
- sv => 'Swedish (Svenska)',
- 'tr'=> 'Turkish (Türkçe)',
- zh_cn => 'Simplified Chinese (简体中文)',
- zh_tw => 'Traditional Chinese (繁體中文)',
- );
- # recognized file types, in the order we test unknown files
- # Notes: 1) There is no need to test for like types separately here
- # 2) Put types with weak file signatures at end of list to avoid false matches
- @fileTypes = qw(JPEG CRW DR4 TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP
- BMP PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG FLAC APE MPC
- MKV MXF DV PMP IND PGF ICC ITC FLIR FPF LFP HTML VRD RTF XCF DSS
- QTIF FPX PICT ZIP GZIP PLIST RAR BZ2 TAR RWZ EXE EXR HDR CHM LNK
- WMF AVC DEX DPX RAW Font RSRC M2TS PHP Torrent VCard AA PDB MOI
- MP3 DICOM PCD);
- # file types that we can write (edit)
- my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM
- EPS X3F PS PDF ICC VRD DR4 JP2 EXIF AI AIT IND MOV EXV);
- my %writeTypes; # lookup for writable file types (hash filled if required)
- # file extensions that we can't write for various base types
- %noWriteFile = (
- TIFF => [ qw(3FR DCR K25 KDC) ],
- XMP => [ 'SVG' ],
- JP2 => [ 'J2C', 'JPC' ],
- );
- # file types that we can create from scratch
- # - must update CanCreate() documentation if this list is changed!
- my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV);
- # file type lookup for all recognized file extensions
- # (if extension may be more than one type, the type is a list where
- # the writable type should come first if it exists)
- my %fileTypeLookup = (
- '3FR' => ['TIFF', 'Hasselblad RAW format'],
- '3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'],
- '3GP' => ['MOV', '3rd Gen. Partnership Project audio/video'],
- '3GP2'=> '3G2',
- '3GPP'=> '3GP',
- AA => ['AA', 'Audible Audiobook'],
- AAX => ['MOV', 'Audible Enhanced Audiobook'],
- ACR => ['DICOM','American College of Radiology ACR-NEMA'],
- ACFM => ['Font', 'Adobe Composite Font Metrics'],
- AFM => ['Font', 'Adobe Font Metrics'],
- AMFM => ['Font', 'Adobe Multiple Master Font Metrics'],
- AI => [['PDF','PS'], 'Adobe Illustrator'],
- AIF => 'AIFF',
- AIFC => ['AIFF', 'Audio Interchange File Format Compressed'],
- AIFF => ['AIFF', 'Audio Interchange File Format'],
- AIT => 'AI',
- APE => ['APE', "Monkey's Audio format"],
- ARW => ['TIFF', 'Sony Alpha RAW format'],
- ASF => ['ASF', 'Microsoft Advanced Systems Format'],
- AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID)
- AVI => ['RIFF', 'Audio Video Interleaved'],
- AZW => 'MOBI', # (see http://wiki.mobileread.com/wiki/AZW)
- AZW3 => 'MOBI',
- BMP => ['BMP', 'Windows Bitmap'],
- BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial)
- BZ2 => ['BZ2', 'BZIP2 archive'],
- CHM => ['CHM', 'Microsoft Compiled HTML format'],
- CIFF => ['CRW', 'Camera Image File Format'],
- COS => ['COS', 'Capture One Settings'],
- CR2 => ['TIFF', 'Canon RAW 2 format'],
- CRW => ['CRW', 'Canon RAW format'],
- CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'],
- DC3 => 'DICM',
- DCM => 'DICM',
- DCP => ['TIFF', 'DNG Camera Profile'],
- DCR => ['TIFF', 'Kodak Digital Camera RAW'],
- DEX => ['DEX', 'Dalvik Executable format'],
- DFONT=> ['Font', 'Macintosh Data fork Font'],
- DIB => ['BMP', 'Device Independent Bitmap'],
- DIC => 'DICM',
- DICM => ['DICOM','Digital Imaging and Communications in Medicine'],
- DIVX => ['ASF', 'DivX media format'],
- DJV => 'DJVU',
- DJVU => ['AIFF', 'DjVu image'],
- DLL => ['EXE', 'Windows Dynamic Link Library'],
- DNG => ['TIFF', 'Digital Negative'],
- DOC => ['FPX', 'Microsoft Word Document'],
- DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'],
- # Note: I have seen a password-protected DOCX file which was FPX-like, so I assume
- # that any other MS Office file could be like this too. The only difference is
- # that the ZIP and FPX formats are checked first, so if this is wrong, no biggie.
- DOCX => [['ZIP','FPX'], 'Office Open XML Document'],
- DOT => ['FPX', 'Microsoft Word Template'],
- DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'],
- DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'],
- DPX => ['DPX', 'Digital Picture Exchange' ],
- DR4 => ['DR4', 'Canon VRD version 4 Recipe'],
- DS2 => ['DSS', 'Digital Speech Standard 2'],
- DSS => ['DSS', 'Digital Speech Standard'],
- DV => ['DV', 'Digital Video'],
- DVB => ['MOV', 'Digital Video Broadcasting'],
- DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'],
- EIP => ['ZIP', 'Capture One Enhanced Image Package'],
- EPS => ['EPS', 'Encapsulated PostScript Format'],
- EPS2 => 'EPS',
- EPS3 => 'EPS',
- EPSF => 'EPS',
- EPUB => ['ZIP', 'Electronic Publication'],
- ERF => ['TIFF', 'Epson Raw Format'],
- EXE => ['EXE', 'Windows executable file'],
- EXR => ['EXR', 'Open EXR'],
- EXIF => ['EXIF', 'Exchangable Image File Metadata'],
- EXV => ['EXV', 'Exiv2 metadata'],
- F4A => ['MOV', 'Adobe Flash Player 9+ Audio'],
- F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'],
- F4P => ['MOV', 'Adobe Flash Player 9+ Protected'],
- F4V => ['MOV', 'Adobe Flash Player 9+ Video'],
- FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'],
- FLAC => ['FLAC', 'Free Lossless Audio Codec'],
- FLA => ['FPX', 'Macromedia/Adobe Flash project'],
- FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension)
- FLV => ['FLV', 'Flash Video'],
- FPF => ['FPF', 'FLIR Public image Format'],
- FPX => ['FPX', 'FlashPix'],
- GIF => ['GIF', 'Compuserve Graphics Interchange Format'],
- GZ => 'GZIP',
- GZIP => ['GZIP', 'GNU ZIP compressed archive'],
- HDP => ['TIFF', 'Windows HD Photo'],
- HDR => ['HDR', 'Radiance RGBE High Dynamic Range'],
- HTM => 'HTML',
- HTML => ['HTML', 'HyperText Markup Language'],
- ICAL => 'ICS',
- ICC => ['ICC', 'International Color Consortium'],
- ICM => 'ICC',
- ICS => ['VCard','iCalendar Schedule'],
- IDML => ['ZIP', 'Adobe InDesign Markup Language'],
- IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'],
- IND => ['IND', 'Adobe InDesign'],
- INDD => ['IND', 'Adobe InDesign Document'],
- INDT => ['IND', 'Adobe InDesign Template'],
- INX => ['XMP', 'Adobe InDesign Interchange'],
- ITC => ['ITC', 'iTunes Cover Flow'],
- J2C => ['JP2', 'JPEG 2000 codestream'],
- J2K => 'JP2',
- JNG => ['PNG', 'JPG Network Graphics'],
- JP2 => ['JP2', 'JPEG 2000 file'],
- # JP4? - looks like a JPEG but the image data is different
- JPC => 'J2C',
- JPE => 'JPEG',
- JPEG => ['JPEG', 'Joint Photographic Experts Group'],
- JPF => 'JP2',
- JPG => 'JPEG',
- JPM => ['JP2', 'JPEG 2000 compound image'],
- JPX => ['JP2', 'JPEG 2000 with extensions'],
- JXR => ['TIFF', 'JPEG XR'],
- K25 => ['TIFF', 'Kodak DC25 RAW'],
- KDC => ['TIFF', 'Kodak Digital Camera RAW'],
- KEY => ['ZIP', 'Apple Keynote presentation'],
- KTH => ['ZIP', 'Apple Keynote Theme'],
- LA => ['RIFF', 'Lossless Audio'],
- LFP => ['LFP', 'Lytro Light Field Picture'],
- LFR => 'LFP', # (Light Field RAW)
- LNK => ['LNK', 'Windows shortcut'],
- M2T => 'M2TS',
- M2TS => ['M2TS', 'MPEG-2 Transport Stream'],
- M2V => ['MPEG', 'MPEG-2 Video'],
- M4A => ['MOV', 'MPEG-4 Audio'],
- M4B => ['MOV', 'MPEG-4 audio Book'],
- M4P => ['MOV', 'MPEG-4 Protected'],
- M4V => ['MOV', 'MPEG-4 Video'],
- MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'],
- MIE => ['MIE', 'Meta Information Encapsulation format'],
- MIF => 'MIFF',
- MIFF => ['MIFF', 'Magick Image File Format'],
- MKA => ['MKV', 'Matroska Audio'],
- MKS => ['MKV', 'Matroska Subtitle'],
- MKV => ['MKV', 'Matroska Video'],
- MNG => ['PNG', 'Multiple-image Network Graphics'],
- MOBI => ['PDB', 'Mobipocket electronic book'],
- MODD => ['PLIST','Sony Picture Motion metadata'],
- MOI => ['MOI', 'MOD Information file'],
- MOS => ['TIFF', 'Creo Leaf Mosaic'],
- MOV => ['MOV', 'Apple QuickTime movie'],
- MP3 => ['MP3', 'MPEG-1 Layer 3 audio'],
- MP4 => ['MOV', 'MPEG-4 video'],
- MPC => ['MPC', 'Musepack Audio'],
- MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'],
- MPG => 'MPEG',
- MPO => ['JPEG', 'Extended Multi-Picture format'],
- MQV => ['MOV', 'Sony Mobile Quicktime Video'],
- MRW => ['MRW', 'Minolta RAW format'],
- MTS => 'M2TS',
- MXF => ['MXF', 'Material Exchange Format'],
- # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'],
- NEF => ['TIFF', 'Nikon (RAW) Electronic Format'],
- NEWER => 'COS',
- NMBTEMPLATE => ['ZIP','Apple Numbers Template'],
- NRW => ['TIFF', 'Nikon RAW (2)'],
- NUMBERS => ['ZIP','Apple Numbers spreadsheet'],
- ODB => ['ZIP', 'Open Document Database'],
- ODC => ['ZIP', 'Open Document Chart'],
- ODF => ['ZIP', 'Open Document Formula'],
- ODG => ['ZIP', 'Open Document Graphics'],
- ODI => ['ZIP', 'Open Document Image'],
- ODP => ['ZIP', 'Open Document Presentation'],
- ODS => ['ZIP', 'Open Document Spreadsheet'],
- ODT => ['ZIP', 'Open Document Text file'],
- OFR => ['RIFF', 'OptimFROG audio'],
- OGG => ['OGG', 'Ogg Vorbis audio file'],
- OGV => ['OGG', 'Ogg Video file'],
- ORF => ['ORF', 'Olympus RAW format'],
- OTF => ['Font', 'Open Type Font'],
- PAC => ['RIFF', 'Lossless Predictive Audio Compression'],
- PAGES => ['ZIP', 'Apple Pages document'],
- PBM => ['PPM', 'Portable BitMap'],
- PCD => ['PCD', 'Kodak Photo CD Image Pac'],
- PCT => 'PICT',
- PDB => ['PDB', 'Palm Database'],
- PDF => ['PDF', 'Adobe Portable Document Format'],
- PEF => ['TIFF', 'Pentax (RAW) Electronic Format'],
- PFA => ['Font', 'PostScript Font ASCII'],
- PFB => ['Font', 'PostScript Font Binary'],
- PFM => ['Font', 'Printer Font Metrics'],
- PGF => ['PGF', 'Progressive Graphics File'],
- PGM => ['PPM', 'Portable Gray Map'],
- PHP => ['PHP', 'PHP Hypertext Preprocessor'],
- PHP3 => 'PHP',
- PHP4 => 'PHP',
- PHP5 => 'PHP',
- PHPS => 'PHP',
- PHTML=> 'PHP',
- PICT => ['PICT', 'Apple PICTure'],
- PLIST=> ['PLIST','Apple Property List'],
- PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;)
- PNG => ['PNG', 'Portable Network Graphics'],
- POT => ['FPX', 'Microsoft PowerPoint Template'],
- POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'],
- POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'],
- PPM => ['PPM', 'Portable Pixel Map'],
- PPS => ['FPX', 'Microsoft PowerPoint Slideshow'],
- PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'],
- PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'],
- PPT => ['FPX', 'Microsoft PowerPoint Presentation'],
- PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'],
- PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'],
- PRC => ['PDB', 'Palm Database'],
- PS => ['PS', 'PostScript'],
- PS2 => 'PS',
- PS3 => 'PS',
- PSB => ['PSD', 'Photoshop Large Document'],
- PSD => ['PSD', 'Photoshop Document'],
- PSP => ['PSP', 'Paint Shop Pro'],
- PSPFRAME => 'PSP',
- PSPIMAGE => 'PSP',
- PSPSHAPE => 'PSP',
- PSPTUBE => 'PSP',
- QIF => 'QTIF',
- QT => 'MOV',
- QTI => 'QTIF',
- QTIF => ['QTIF', 'QuickTime Image File'],
- RA => ['Real', 'Real Audio'],
- RAF => ['RAF', 'FujiFilm RAW Format'],
- RAM => ['Real', 'Real Audio Metafile'],
- RAR => ['RAR', 'RAR Archive'],
- RAW => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'],
- RIF => 'RIFF',
- RIFF => ['RIFF', 'Resource Interchange File Format'],
- RM => ['Real', 'Real Media'],
- RMVB => ['Real', 'Real Media Variable Bitrate'],
- RPM => ['Real', 'Real Media Plug-in Metafile'],
- RSRC => ['RSRC', 'Mac OS Resource'],
- RTF => ['RTF', 'Rich Text Format'],
- RV => ['Real', 'Real Video'],
- RW2 => ['TIFF', 'Panasonic RAW 2'],
- RWL => ['TIFF', 'Leica RAW'],
- RWZ => ['RWZ', 'Rawzor compressed image'],
- SEQ => ['FLIR', 'FLIR image Sequence'],
- SO => ['EXE', 'Shared Object file'],
- SR2 => ['TIFF', 'Sony RAW Format 2'],
- SRF => ['TIFF', 'Sony RAW Format'],
- SRW => ['TIFF', 'Samsung RAW format'],
- SVG => ['XMP', 'Scalable Vector Graphics'],
- SWF => ['SWF', 'Shockwave Flash'],
- TAR => ['TAR', 'TAR archive'],
- THM => ['JPEG', 'Canon Thumbnail'],
- THMX => [['ZIP','FPX'], 'Office Open XML Theme'],
- TIF => 'TIFF',
- TIFF => ['TIFF', 'Tagged Image File Format'],
- TORRENT => ['Torrent', 'BitTorrent description file'],
- TS => 'M2TS',
- TTC => ['Font', 'True Type Font Collection'],
- TTF => ['Font', 'True Type Font'],
- TUB => 'PSP',
- VCARD=> ['VCard','Virtual Card'],
- VCF => 'VCARD',
- VOB => ['MPEG', 'Video Object'],
- VRD => ['VRD', 'Canon VRD Recipe Data'],
- VSD => ['FPX', 'Microsoft Visio Drawing'],
- WAV => ['RIFF', 'WAVeform (Windows digital audio)'],
- WDP => ['TIFF', 'Windows Media Photo'],
- WEBM => ['MKV', 'Google Web Movie'],
- WEBP => ['RIFF', 'Google Web Picture'],
- WMA => ['ASF', 'Windows Media Audio'],
- WMF => ['WMF', 'Windows Metafile Format'],
- WMV => ['ASF', 'Windows Media Video'],
- WV => ['RIFF', 'WavePack lossless audio'],
- X3F => ['X3F', 'Sigma RAW format'],
- XCF => ['XCF', 'GIMP native image format'],
- XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
- XLA => ['FPX', 'Microsoft Excel Add-in'],
- XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'],
- XLS => ['FPX', 'Microsoft Excel Spreadsheet'],
- XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'],
- XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'],
- XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'],
- XLT => ['FPX', 'Microsoft Excel Template'],
- XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'],
- XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'],
- XMP => ['XMP', 'Extensible Metadata Platform'],
- ZIP => ['ZIP', 'ZIP archive'],
- );
- # typical extension for each file type (if different than FileType)
- # - case is not significant
- my %fileTypeExt = (
- 'Canon 1D RAW' => 'tif',
- DICOM => 'dcm',
- FLIR => 'fff',
- GZIP => 'gz',
- JPEG => 'jpg',
- M2TS => 'mts',
- MPEG => 'mpg',
- TIFF => 'tif',
- VCard => 'vcf',
- );
- # descriptions for file types not found in above file extension lookup
- my %fileDescription = (
- DICOM => 'Digital Imaging and Communications in Medicine',
- XML => 'Extensible Markup Language',
- 'DJVU (multi-page)' => 'DjVu multi-page image',
- 'Win32 EXE' => 'Windows 32-bit Executable',
- 'Win32 DLL' => 'Windows 32-bit Dynamic Link Library',
- 'Win64 EXE' => 'Windows 64-bit Executable',
- 'Win64 DLL' => 'Windows 64-bit Dynamic Link Library',
- );
- # MIME types for applicable file types above
- # (missing entries default to 'application/unknown', but note that other MIME
- # types may be specified by some modules, eg. QuickTime.pm and RIFF.pm)
- %mimeType = (
- '3FR' => 'image/x-hasselblad-3fr',
- AA => 'audio/audible',
- AI => 'application/vnd.adobe.illustrator',
- AIFF => 'audio/x-aiff',
- APE => 'audio/x-monkeys-audio',
- ASF => 'video/x-ms-asf',
- ARW => 'image/x-sony-arw',
- BMP => 'image/bmp',
- BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html)
- BZ2 => 'application/bzip2',
- 'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension)
- CHM => 'application/x-chm',
- CR2 => 'image/x-canon-cr2',
- CRW => 'image/x-canon-crw',
- DCR => 'image/x-kodak-dcr',
- DEX => 'application/octet-stream',
- DFONT=> 'application/x-dfont',
- DICOM=> 'application/dicom',
- DIVX => 'video/divx',
- DJVU => 'image/vnd.djvu',
- DNG => 'image/x-adobe-dng',
- DOC => 'application/msword',
- DOCM => 'application/vnd.ms-word.document.macroEnabled',
- DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document',
- DOT => 'application/msword',
- DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate',
- DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template',
- DPX => 'image/x-dpx',
- DS2 => 'audio/x-ds2',
- DSS => 'audio/x-dss',
- DV => 'video/x-dv',
- EIP => 'application/x-captureone', #(NC)
- EPS => 'application/postscript',
- ERF => 'image/x-epson-erf',
- EXE => 'application/octet-stream',
- EXV => 'image/x-exv',
- FFF => 'image/x-hasselblad-fff',
- FLA => 'application/vnd.adobe.fla',
- FLAC => 'audio/flac',
- FLV => 'video/x-flv',
- Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM)
- FPX => 'image/vnd.fpx',
- GIF => 'image/gif',
- GZIP => 'application/x-gzip',
- HDP => 'image/vnd.ms-photo',
- HDR => 'image/vnd.radiance',
- HTML => 'text/html',
- ICC => 'application/vnd.iccprofile',
- ICS => 'text/calendar',
- IDML => 'application/vnd.adobe.indesign-idml-package',
- IIQ => 'image/x-raw',
- IND => 'application/x-indesign',
- INX => 'application/x-indesign-interchange', #PH (NC)
- ITC => 'application/itunes',
- JNG => 'image/jng',
- J2C => 'image/x-j2c', #PH (NC)
- JP2 => 'image/jp2',
- JPEG => 'image/jpeg',
- JPM => 'image/jpm',
- JPX => 'image/jpx',
- K25 => 'image/x-kodak-k25',
- KDC => 'image/x-kodak-kdc',
- LFP => 'image/x-lytro-lfp', #PH (NC)
- LNK => 'application/octet-stream',
- M2T => 'video/mpeg',
- M2TS => 'video/m2ts',
- MEF => 'image/x-mamiya-mef',
- MIE => 'application/x-mie',
- MIFF => 'application/x-magick-image',
- MKA => 'audio/x-matroska',
- MKS => 'application/x-matroska',
- MKV => 'video/x-matroska',
- MNG => 'video/mng',
- MOBI => 'application/x-mobipocket-ebook',
- MOS => 'image/x-raw',
- MOV => 'video/quicktime',
- MP3 => 'audio/mpeg',
- MP4 => 'video/mp4',
- MPC => 'audio/x-musepack',
- MPEG => 'video/mpeg',
- MRW => 'image/x-minolta-mrw',
- MXF => 'application/mxf',
- NEF => 'image/x-nikon-nef',
- NRW => 'image/x-nikon-nrw',
- ODB => 'application/vnd.oasis.opendocument.database',
- ODC => 'application/vnd.oasis.opendocument.chart',
- ODF => 'application/vnd.oasis.opendocument.formula',
- ODG => 'application/vnd.oasis.opendocument.graphics',
- ODI => 'application/vnd.oasis.opendocument.image',
- ODP => 'application/vnd.oasis.opendocument.presentation',
- ODS => 'application/vnd.oasis.opendocument.spreadsheet',
- ODT => 'application/vnd.oasis.opendocument.text',
- OGG => 'audio/x-ogg',
- OGV => 'video/x-ogg',
- EXR => 'image/x-exr',
- ORF => 'image/x-olympus-orf',
- OTF => 'application/x-font-otf',
- PBM => 'image/x-portable-bitmap',
- PCD => 'image/x-photo-cd',
- PDB => 'application/vnd.palm',
- PDF => 'application/pdf',
- PEF => 'image/x-pentax-pef',
- PFA => 'application/x-font-type1', # (needed if handled by PostScript module)
- PGF => 'image/pgf',
- PGM => 'image/x-portable-graymap',
- PHP => 'application/x-httpd-php',
- PICT => 'image/pict',
- PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time)
- PNG => 'image/png',
- POT => 'application/vnd.ms-powerpoint',
- POTM => 'application/vnd.ms-powerpoint.template.macroEnabled',
- POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template',
- PPM => 'image/x-portable-pixmap',
- PPS => 'application/vnd.ms-powerpoint',
- PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled',
- PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow',
- PPT => 'application/vnd.ms-powerpoint',
- PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled',
- PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation',
- PS => 'application/postscript',
- PSD => 'application/vnd.adobe.photoshop',
- PSP => 'image/x-paintshoppro', #(NC)
- QTIF => 'image/x-quicktime',
- RA => 'audio/x-pn-realaudio',
- RAF => 'image/x-fujifilm-raf',
- RAM => 'audio/x-pn-realaudio',
- RAR => 'application/x-rar-compressed',
- RAW => 'image/x-raw',
- RM => 'application/vnd.rn-realmedia',
- RMVB => 'application/vnd.rn-realmedia-vbr',
- RPM => 'audio/x-pn-realaudio-plugin',
- RSRC => 'application/ResEdit',
- RTF => 'text/rtf',
- RV => 'video/vnd.rn-realvideo',
- RW2 => 'image/x-panasonic-rw2',
- RWL => 'image/x-leica-rwl',
- RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm)
- SR2 => 'image/x-sony-sr2',
- SRF => 'image/x-sony-srf',
- SRW => 'image/x-samsung-srw',
- SVG => 'image/svg+xml',
- SWF => 'application/x-shockwave-flash',
- TAR => 'application/x-tar',
- THMX => 'application/vnd.ms-officetheme',
- TIFF => 'image/tiff',
- Torrent => 'application/x-bittorrent',
- TTC => 'application/x-font-ttf',
- TTF => 'application/x-font-ttf',
- VCard=> 'text/vcard',
- VSD => 'application/x-visio',
- WDP => 'image/vnd.ms-photo',
- WEBM => 'video/webm',
- WMA => 'audio/x-ms-wma',
- WMF => 'application/x-wmf',
- WMV => 'video/x-ms-wmv',
- X3F => 'image/x-sigma-x3f',
- XCF => 'image/x-xcf',
- XLA => 'application/vnd.ms-excel',
- XLAM => 'application/vnd.ms-excel.addin.macroEnabled',
- XLS => 'application/vnd.ms-excel',
- XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled',
- XLSM => 'application/vnd.ms-excel.sheet.macroEnabled',
- XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
- XLT => 'application/vnd.ms-excel',
- XLTM => 'application/vnd.ms-excel.template.macroEnabled',
- XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template',
- XML => 'application/xml',
- XMP => 'application/rdf+xml',
- ZIP => 'application/zip',
- );
- # module names for processing routines of each file type
- # - undefined entries default to same module name as file type
- # - module name '' defaults to Image::ExifTool
- # - module name '0' indicates a recognized but unsupported file
- my %moduleName = (
- AA => 'Audible',
- AVC => 0,
- BTF => 'BigTIFF',
- BZ2 => 0,
- CRW => 'CanonRaw',
- CHM => 'EXE',
- COS => 'CaptureOne',
- DEX => 0,
- DOCX => 'OOXML',
- DR4 => 'CanonVRD',
- DSS => 'Olympus',
- EPS => 'PostScript',
- EXIF => '',
- EXR => 'OpenEXR',
- EXV => '',
- ICC => 'ICC_Profile',
- IND => 'InDesign',
- FLV => 'Flash',
- FPF => 'FLIR',
- FPX => 'FlashPix',
- GZIP => 'ZIP',
- HDR => 'Radiance',
- JP2 => 'Jpeg2000',
- JPEG => '',
- LFP => 'Lytro',
- MOV => 'QuickTime',
- MKV => 'Matroska',
- MP3 => 'ID3',
- MRW => 'MinoltaRaw',
- OGG => 'Ogg',
- ORF => 'Olympus',
- PDB => 'Palm',
- PCD => 'PhotoCD',
- PHP => 0,
- PMP => 'Sony',
- PS => 'PostScript',
- PSD => 'Photoshop',
- QTIF => 'QuickTime',
- RAF => 'FujiFilm',
- RAR => 'ZIP',
- RAW => 'KyoceraRaw',
- RWZ => 'Rawzor',
- SWF => 'Flash',
- TAR => 0,
- TIFF => '',
- VRD => 'CanonVRD',
- WMF => 0,
- X3F => 'SigmaRaw',
- XCF => 'GIMP',
- );
- # quick "magic number" file test used to avoid loading module unnecessarily:
- # - regular expression evaluated on first 1024 bytes of file
- # - must match beginning at first byte in file
- # - this test must not be more stringent than module logic
- %magicNumber = (
- AA => '.{4}\x57\x90\x75\x36',
- AIFF => '(FORM....AIF[FC]|AT&TFORM)',
- APE => '(MAC |APETAGEX|ID3)',
- ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c',
- AVC => '\+A\+V\+C\+',
- Torrent => 'd\d+:\w+',
- BMP => 'BM',
- BTF => '(II\x2b\0|MM\0\x2b)',
- BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59',
- CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec',
- CRW => '(II|MM).{4}HEAP(CCDR|JPGM)',
- DEX => "dex\n035\0",
- DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)',
- DOCX => 'PK\x03\x04',
- DPX => '(SDPX|XPDS)',
- DR4 => 'IIII\x04\0\x04\0',
- DSS => '(\x02dss|\x03ds2)',
- DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized)
- EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
- EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)',
- EXIF => '(II\x2a\0|MM\0\x2a)',
- EXR => '\x76\x2f\x31\x01',
- EXV => '\xff\x01Exiv2',
- FLAC => '(fLaC|ID3)',
- FLIR => '[AF]FF\0',
- FLV => 'FLV\x01',
- Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' .
- '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics)',
- FPF => 'FPF Public Image Format\0',
- FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1',
- GIF => 'GIF8[79]a',
- GZIP => '\x1f\x8b\x08',
- HDR => '#\?(RADIANCE|RGBE)\x0a',
- HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive)
- ICC => '.{12}(scnr|mntr|prtr|link|spac|abst|nmcl|nkpf)(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR){2}',
- IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d',
- ITC => '.{4}itch',
- JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)',
- JPEG => '\xff(\xd8\xff|\x01Exiv2)', # (includes EXV so we don't have to add EXV to @fileTypes)
- LFP => '\x89LFP\x0d\x0a\x1a\x0a',
- LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46',
- M2TS => '(....)?\x47',
- MIE => '~[\x10\x18]\x04.0MIE',
- MIFF => 'id=ImageMagick',
- MKV => '\x1a\x45\xdf\xa3',
- MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!)
- # MP3 => difficult to rule out
- MPC => '(MP\+|ID3)',
- MOI => 'V6',
- MPEG => '\0\0\x01[\xb0-\xbf]',
- MRW => '\0MR[MI]',
- MXF => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized)
- OGG => '(OggS|ID3)',
- ORF => '(II|MM)',
- PDB => '.{60}(\.pdfADBE|TEXtREAd|BVokBDIC|DB99DBOS|PNRdPPrs|DataPPrs|vIMGView|PmDBPmDB|InfoINDB|ToGoToGo|SDocSilX|JbDbJBas|JfDbJFil|DATALSdb|Mdb1Mdb1|BOOKMOBI|DataPlkr|DataSprd|SM01SMem|TEXtTlDc|InfoTlIf|DataTlMl|DataTlPt|dataTDBP|TdatTide|ToRaTRPW|zTXTGPlm|BDOCWrdS)',
- # PCD => signature is at byte 2048
- PDF => '%PDF-\d+\.\d+',
- PGF => 'PGF',
- PHP => '<\?php\s',
- PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)',
- PLIST=> '(bplist0|\s*<|\xfe\xff\x00)',
- PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb',
- PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n',
- PPM => 'P[1-6]\s+',
- PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
- PSD => '8BPS\0[\x01\x02]',
- PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}',
- QTIF => '.{4}(idsc|idat|iicc)',
- RAF => 'FUJIFILM',
- RAR => 'Rar!\x1a\x07\0',
- RAW => '(.{25}ARECOYK|II|MM)',
- Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)',
- RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk)', # RIFF plus other variants
- RSRC => '(....)?\0\0\x01\0',
- RTF => '[\n\r]*\\{[\n\r]*\\\\rtf',
- RWZ => 'rawzor',
- SWF => '[FC]WS[^\0]',
- TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files)
- TIFF => '(II|MM)', # don't test magic number (some raw formats are different)
- VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n',
- VRD => 'CANON OPTIONAL DATA\0',
- WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)',
- X3F => 'FOVb',
- XCF => 'gimp xcf ',
- XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<',
- ZIP => 'PK\x03\x04',
- );
- # file types with weak magic number recognition
- my %weakMagic = ( MP3 => 1 );
- # file types that are determined by the process proc when FastScan == 3
- # (when done, the process proc must exit after SetFileType if FastScan is 3)
- my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard);
- # lookup for valid character set names (keys are all lower case)
- %charsetName = (
- # Charset setting alias(es)
- # ------------------------- --------------------------------------------
- utf8 => 'UTF8', cp65001 => 'UTF8', 'utf-8' => 'UTF8',
- latin => 'Latin', cp1252 => 'Latin', latin1 => 'Latin',
- latin2 => 'Latin2', cp1250 => 'Latin2',
- cyrillic => 'Cyrillic', cp1251 => 'Cyrillic', russian => 'Cyrillic',
- greek => 'Greek', cp1253 => 'Greek',
- turkish => 'Turkish', cp1254 => 'Turkish',
- hebrew => 'Hebrew', cp1255 => 'Hebrew',
- arabic => 'Arabic', cp1256 => 'Arabic',
- baltic => 'Baltic', cp1257 => 'Baltic',
- vietnam => 'Vietnam', cp1258 => 'Vietnam',
- thai => 'Thai', cp874 => 'Thai',
- macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman',
- maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2',
- maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic',
- macgreek => 'MacGreek', cp10006 => 'MacGreek',
- macturkish => 'MacTurkish', cp10081 => 'MacTurkish',
- macromanian => 'MacRomanian', cp10010 => 'MacRomanian',
- maciceland => 'MacIceland', cp10079 => 'MacIceland',
- maccroatian => 'MacCroatian', cp10082 => 'MacCroatian',
- );
- # default group priority for writing
- # (NOTE: tags in groups not specified here will not be written unless
- # overridden by the module or specified when writing)
- my @defaultWriteGroups = qw(EXIF IPTC XMP MakerNotes Photoshop ICC_Profile CanonVRD Adobe);
- # group hash for ExifTool-generated tags
- my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' );
- # special tag names (not used for tag info)
- %specialTags = map { $_ => 1 } qw(
- TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC
- GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV
- WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR
- EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY
- WRITE_GROUP LANG_INFO VARS DATAMEMBER SET_GROUP1
- );
- # headers for various segment types
- $exifAPP1hdr = "Exif\0\0";
- $xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0";
- $xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0";
- $psAPP13hdr = "Photoshop 3.0\0";
- $psAPP13old = 'Adobe_Photoshop2.5:';
- sub DummyWriteProc { return 1; }
- # lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses
- %Image::ExifTool::userLens = ( );
- # queued plug-in tags to add to lookup
- @Image::ExifTool::pluginTags = ( );
- %Image::ExifTool::pluginTags = ( );
- my %systemTagsNotes = (
- Notes => q{
- extracted only if specifically requested or the SystemTags or RequestAll API
- option is set
- },
- );
- # tag information for preview image -- this should be used for all
- # PreviewImage tags so they are handled properly when reading/writing
- %Image::ExifTool::previewImageTagInfo = (
- Name => 'PreviewImage',
- Writable => 'undef',
- # a value of 'none' is ok...
- WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)',
- DataTag => 'PreviewImage',
- # accept either scalar or scalar reference
- RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
- # we allow preview image to be set to '', but we don't want a zero-length value
- # in the IFD, so set it temorarily to 'none'. Note that the length is <= 4,
- # so this value will fit in the IFD so the preview fixup won't be generated.
- ValueConvInv => '$val eq "" and $val="none"; $val',
- );
- # extra tags that aren't truly EXIF tags, but are generated by the script
- # Note: any tag in this list with a name corresponding to a Group0 name is
- # used to write the entire corresponding directory as a block.
- %Image::ExifTool::Extra = (
- GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
- VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
- WRITE_PROC => \&DummyWriteProc,
- Error => {
- Priority => 0,
- Groups => \%allGroupsExifTool,
- Notes => q{
- returns errors that may have occurred while reading or writing a file. Any
- Error will prevent the file from being processed. Minor errors may be
- downgraded to warnings with the -m or IgnoreMinorErrors option
- },
- },
- Warning => {
- Priority => 0,
- Groups => \%allGroupsExifTool,
- Notes => q{
- returns warnings that may have occurred while reading or writing a file.
- Use the -a or Duplicates option to see all warnings if more than one
- occurred. Minor warnings may be ignored with the -m or IgnoreMinorErrors
- option. Minor warnings with a capital "M" in the "[Minor]" designation
- indicate that the processing is affected by ignoring the warning
- },
- },
- Comment => {
- Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
- Writable => 1,
- WriteGroup => 'Comment',
- Priority => 0, # to preserve order of JPEG COM segments
- },
- Directory => {
- Groups => { 1 => 'System' },
- Notes => q{
- the directory of the file as specified in the call to ExifTool, or "." if no
- directory was specified. May be written to move the file to another
- directory that will be created if doesn't already exist
- },
- Writable => 1,
- Protected => 1,
- RawConv => '$self->ConvertFileName($val)',
- # translate backslashes in directory names and add trailing '/'
- ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_',
- },
- FileName => {
- Groups => { 1 => 'System' },
- Writable => 1,
- Protected => 1,
- Notes => q{
- may be written with a full path name to set FileName and Directory in one
- operation. This is such a powerful feature that a TestName tag is provided
- to allow dry-run tests before actually writing the file name. See
- L<filename.html|../filename.html> for more information on writing the
- FileName, Directory and TestName tags
- },
- RawConv => '$self->ConvertFileName($val)',
- ValueConvInv => '$self->InverseFileName($val)',
- },
- FilePath => {
- Groups => { 1 => 'System' },
- Notes => q{
- absolute path of source file. Not generated unless specifically requested or
- the RequestAll API option is set
- },
- },
- TestName => {
- Writable => 1,
- WriteOnly => 1,
- Notes => q{
- this write-only tag may be used instead of FileName for dry-run tests of the
- file renaming feature. Writing this tag prints the old and new file names
- to the console, but does not affect the file itself
- },
- ValueConvInv => '$self->InverseFileName($val)',
- },
- FileSequence => {
- Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
- Notes => q{
- sequence number for each source file when extracting or copying information,
- including files that fail the -if condition of the command-line application,
- beginning at 0 for the first file. Not generated unless specifically
- requested or the RequestAll API option is set
- },
- },
- FileSize => {
- Groups => { 1 => 'System' },
- Notes => q{
- note that the print conversion for this tag uses historic prefixes: 1 kB =
- 1024 bytes, etc.
- },
- PrintConv => \&ConvertFileSize,
- },
- ResourceForkSize => {
- Groups => { 1 => 'System' },
- Notes => q{
- size of the file's resource fork if it contains data. Mac OS only. If this
- tag is generated the ExtractEmbedded option may be used to extract
- resource-fork information as a sub-document. When writing, the resource
- fork is preserved by default, but it may be deleted with C<-rsrc:all=> on
- the command line
- },
- PrintConv => \&ConvertFileSize,
- },
- FileType => {
- Notes => q{
- a short description of the file type. For many file types this is the just
- the uppercase file extension
- },
- },
- FileTypeExtension => {
- Notes => q{
- a common lowercase extension for this file type, or uppercase with the -n
- option
- },
- PrintConv => 'lc $val',
- },
- FileModifyDate => {
- Description => 'File Modification Date/Time',
- Notes => q{
- the filesystem modification date/time. Note that ExifTool may not be able
- to handle filesystem dates before 1970 depending on the limitations of the
- system's standard libraries
- },
- Groups => { 1 => 'System', 2 => 'Time' },
- Writable => 1,
- # all writable pseudo-tags must be protected so -tagsfromfile fails with
- # unrecognized files unless a pseudo tag is specified explicitly
- Protected => 1,
- Shift => 'Time',
- ValueConv => 'ConvertUnixTime($val,1)',
- ValueConvInv => 'GetUnixTime($val,1)',
- PrintConv => '$self->ConvertDateTime($val)',
- PrintConvInv => '$self->InverseDateTime($val)',
- },
- FileAccessDate => {
- Description => 'File Access Date/Time',
- Notes => q{
- the date/time of last access of the file. Note that this access time is
- updated whenever any software, including ExifTool, reads the file
- },
- Groups => { 1 => 'System', 2 => 'Time' },
- ValueConv => 'ConvertUnixTime($val,1)',
- PrintConv => '$self->ConvertDateTime($val)',
- },
- FileCreateDate => {
- Description => 'File Creation Date/Time',
- Notes => q{
- the filesystem creation date/time. Windows only. Requires Win32API::File
- and Win32::API for writing. Note that although ExifTool does not currently
- support FileCreateDate on other systems, the OS X file creation date may be
- accessed via the MDItemFSCreationDate tag when the MDItemTags API option is
- set, and may be written indirectly via the FileModifyDate tag by following
- these steps: 1. Rewrite the file to set the filesystem creation and
- modification times to the current time, 2. Set FileModifyDate to the desired
- creation time, then 3. Restore FileModifyDate to its original value
- },
- Groups => { 1 => 'System', 2 => 'Time' },
- Writable => 1,
- Protected => 1, # all writable pseudo-tags must be protected!
- Shift => 'Time',
- ValueConv => 'ConvertUnixTime($val,1)',
- ValueConvInv => q{
- if ($^O ne 'MSWin32') {
- warn "This tag is Windows only\n";
- return undef;
- }
- return GetUnixTime($val,1);
- },
- PrintConv => '$self->ConvertDateTime($val)',
- PrintConvInv => '$self->InverseDateTime($val)',
- },
- FileInodeChangeDate => {
- Description => 'File Inode Change Date/Time',
- Notes => q{
- the date/time when the file's directory information was last changed.
- Non-Windows systems only
- },
- Groups => { 1 => 'System', 2 => 'Time' },
- ValueConv => 'ConvertUnixTime($val,1)',
- PrintConv => '$self->ConvertDateTime($val)',
- },
- FilePermissions => {
- Groups => { 1 => 'System' },
- Notes => q{
- r=read, w=write and x=execute permissions for the file owner, group and
- others. The ValueConv value is an octal number so bit test operations on
- this value should be done in octal, eg. 'oct($filePermissions#) & 0200'
- },
- ValueConv => 'sprintf("%.3o", $val & 0777)',
- PrintConv => sub {
- my ($mask, $str, $val) = (0400, '', oct(shift));
- while ($mask) {
- foreach (qw(r w x)) {
- $str .= $val & $mask ? $_ : '-';
- $mask >>= 1;
- }
- }
- return $str;
- },
- },
- FileAttributes => {
- Groups => { 1 => 'System' },
- Notes => q{
- extracted only if specifically requested or the SystemTags or RequestAll API
- option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows
- attribute bits if Win32API::File is available
- },
- PrintHex => 1,
- PrintConvColumns => 2,
- PrintConv => [{ # stat device types (bitmask 0xf000)
- 0x0000 => 'Unknown',
- 0x1000 => 'FIFO',
- 0x2000 => 'Character',
- 0x3000 => 'Mux Character',
- 0x4000 => 'Directory',
- 0x5000 => 'XENIX Named',
- 0x6000 => 'Block',
- 0x7000 => 'Mux Block',
- 0x8000 => 'Regular',
- 0x9000 => 'VxFS Compressed',
- 0xa000 => 'Symbolic Link',
- 0xb000 => 'Solaris Shadow Inode',
- 0xc000 => 'Socket',
- 0xd000 => 'Solaris Door',
- 0xe000 => 'BSD Whiteout',
- },{ BITMASK => { # stat attribute bits (bitmask 0x0e00)
- 9 => 'Sticky',
- 10 => 'Set Group ID',
- 11 => 'Set User ID',
- }},{ BITMASK => { # Windows attribute bits
- 0 => 'Read Only',
- 1 => 'Hidden',
- 2 => 'System',
- 3 => 'Volume Label',
- 4 => 'Directory',
- 5 => 'Archive',
- 6 => 'Device',
- 7 => 'Normal',
- 8 => 'Temporary',
- 9 => 'Sparse File',
- 10 => 'Reparse Point',
- 11 => 'Compressed',
- 12 => 'Offline',
- 13 => 'Not Content Indexed',
- 14 => 'Encrypted',
- }}],
- },
- FileDeviceID => {
- Groups => { 1 => 'System' },
- %systemTagsNotes,
- PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor)
- },
- FileDeviceNumber => { Groups => { 1 => 'System' }, %systemTagsNotes },
- FileInodeNumber => { Groups => { 1 => 'System' }, %systemTagsNotes },
- FileHardLinks => { Groups => { 1 => 'System' }, %systemTagsNotes },
- FileUserID => { Groups => { 1 => 'System' }, %systemTagsNotes, PrintConv => 'eval { getpwuid($val) } || $val' },
- FileGroupID => { Groups => { 1 => 'System' }, %systemTagsNotes, PrintConv => 'eval { getgrgid($val) } || $val' },
- FileBlockSize => { Groups => { 1 => 'System' }, %systemTagsNotes },
- FileBlockCount => { Groups => { 1 => 'System' }, %systemTagsNotes },
- HardLink => {
- Writable => 1,
- WriteOnly => 1,
- Protected => 1,
- Notes => q{
- this write-only tag is used to create a hard link to the file. If the file
- is edited, copied, renamed or moved in the same operation as writing
- HardLink, then the link is made to the updated file. Note that subsequent
- editing of either the linked file or the original by the exiftool
- application will break the link unless the -overwrite_original_in_place
- option is used
- },
- ValueConvInv => '$val=~tr/\\\\/\//; $val',
- },
- MIMEType => { Notes => 'the MIME type of the source file' },
- ImageWidth => { Notes => 'the width of the image in number of pixels' },
- ImageHeight => { Notes => 'the height of the image in number of pixels' },
- XResolution => { Notes => 'the horizontal pixel resolution' },
- YResolution => { Notes => 'the vertical pixel resolution' },
- MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' },
- EXIF => {
- Notes => 'the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images',
- Groups => { 0 => 'EXIF', 1 => 'EXIF' },
- Flags => ['Writable' ,'Protected', 'Binary'],
- WriteCheck => q{
- return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/;
- return 'Invalid EXIF data';
- },
- },
- IPTC => {
- Notes => 'the full IPTC data block',
- Groups => { 0 => 'IPTC', 1 => 'IPTC' },
- Flags => ['Writable', 'Protected', 'Binary'],
- Priority => 0, # so main IPTC (which hopefully comes first) takes priority
- WriteCheck => q{
- return undef if $val =~ /^(\x1c|\0+$)/;
- return 'Invalid IPTC data';
- },
- },
- XMP => {
- Notes => q{
- the XMP data block, but note that extended XMP in JPEG images may be split
- into multiple blocks
- },
- Groups => { 0 => 'XMP', 1 => 'XMP' },
- Flags => ['Writable', 'Protected', 'Binary'],
- Priority => 0, # so main xmp (which usually comes first) takes priority
- WriteCheck => q{
- require Image::ExifTool::XMP;
- return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val);
- },
- },
- ICC_Profile => {
- Notes => 'the full ICC_Profile data block',
- Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' },
- Flags => ['Writable' ,'Protected', 'Binary'],
- WriteCheck => q{
- require Image::ExifTool::ICC_Profile;
- return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
- },
- },
- CanonVRD => {
- Notes => 'the full Canon DPP VRD trailer block',
- Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
- Flags => ['Writable' ,'Protected', 'Binary'],
- Permanent => 0, # (this is 1 by default for MakerNotes tags)
- WriteCheck => q{
- return undef if $val =~ /^CANON OPTIONAL DATA\0/;
- return 'Invalid CanonVRD data';
- },
- },
- CanonDR4 => {
- Notes => 'the full Canon DPP version 4 DR4 block',
- Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
- Flags => ['Writable' ,'Protected', 'Binary'],
- Permanent => 0, # (this is 1 by default for MakerNotes tags)
- WriteCheck => q{
- return undef if $val =~ /^IIII\x04\0\x04\0/;
- return 'Invalid CanonDR4 data';
- },
- },
- Adobe => {
- Notes => q{
- the JPEG APP14 Adobe segment. Extracted only if specified. See the
- L<JPEG Adobe Tags|JPEG.html#Adobe> for more information
- },
- Groups => { 0 => 'APP14', 1 => 'Adobe' },
- WriteGroup => 'Adobe',
- Flags => ['Writable' ,'Protected', 'Binary'],
- },
- CurrentIPTCDigest => {
- Notes => q{
- MD5 digest of existing IPTC data. All zeros if IPTC exists but Digest::MD5
- is not installed. Only calculated for IPTC in the standard location as
- specified by the L<MWG|http://www.metadataworkinggroup.org/>. ExifTool
- automates the handling of this tag in the MWG module -- see the
- L<MWG Composite Tags|MWG.html> for details
- },
- ValueConv => 'unpack("H*", $val)',
- },
- PreviewImage => {
- Notes => 'JPEG-format embedded preview image',
- Groups => { 2 => 'Preview' },
- Writable => 1,
- WriteCheck => '$self->CheckImage(\$val)',
- # can't delete, so set to empty string and return no error
- DelCheck => '$val = ""; return undef',
- # accept either scalar or scalar reference
- RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
- },
- PreviewPNG => {
- Groups => { 2 => 'Preview' },
- Notes => 'PNG-format embedded preview image',
- Binary => 1,
- },
- PreviewWMF => {
- Groups => { 2 => 'Preview' },
- Notes => 'WMF-format embedded preview image',
- Binary => 1,
- },
- ExifByteOrder => {
- Writable => 1,
- Notes => q{
- represents the byte order of EXIF information. May be written to set the
- byte order only for newly created EXIF segments
- },
- PrintConv => {
- II => 'Little-endian (Intel, II)',
- MM => 'Big-endian (Motorola, MM)',
- },
- },
- ExifUnicodeByteOrder => {
- Writable => 1,
- WriteOnly => 1,
- Notes => q{
- specifies the byte order to use when writing EXIF Unicode text. The EXIF
- specification is particularly vague about this byte ordering, and different
- applications use different conventions. By default ExifTool writes Unicode
- text in EXIF byte order, but this write-only tag may be used to force a
- specific order
- },
- PrintConv => {
- II => 'Little-endian (Intel, II)',
- MM => 'Big-endian (Motorola, MM)',
- },
- },
- ExifToolVersion => {
- Description => 'ExifTool Version Number',
- Groups => \%allGroupsExifTool,
- Notes => 'the version of ExifTool currently running',
- },
- ProcessingTime => {
- Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
- Notes => q{
- the clock time in seconds taken by ExifTool to extract information from this
- file. Not generated unless specifically requested or the RequestAll API
- option is set. Requires Time::HiRes
- },
- PrintConv => 'sprintf("%.3f s", $val)',
- },
- RAFVersion => { Notes => 'RAF file version number' },
- JPEGDigest => {
- Notes => q{
- an MD5 digest of the JPEG quantization tables is combined with the component
- sub-sampling values to generate the value of this tag. The result is
- compared to known values in an attempt to deduce the originating software
- based only on the JPEG image data. For performance reasons, this tag is
- generated only if specifically requested
- },
- },
- JPEGQualityEstimate => {
- Notes => q{
- an estimate of the IJG JPEG quality setting for the image, calculated from
- the quantization tables. For performance reasons, this tag is generated
- only if specifically requested
- },
- },
- Now => {
- Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' },
- Notes => q{
- the current date/time. Useful when setting the tag values, eg.
- C<"-modifydate<now">. Not generated unless specifically requested or the
- RequestAll API option is set
- },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- NewGUID => {
- Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
- Notes => q{
- generates a new, random GUID with format
- YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour,
- M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and
- R=random hex number; without dashes with the -n option. Not generated
- unless specifically requested or the RequestAll API option is set
- },
- PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val',
- },
- ID3Size => { Notes => 'size of the ID3 data block' },
- Geotag => {
- Writable => 1,
- WriteOnly => 1,
- AllowGroup => '(exif|gps|xmp|xmp-exif)',
- Notes => q{
- this write-only tag is used to define the GPS track log data or track log
- file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL,
- KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus
- Beacon text, and Bramor gEO log files. See L<geotag.html|../geotag.html>
- for details
- },
- DelCheck => q{
- require Image::ExifTool::Geotag;
- # delete associated tags
- Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
- },
- ValueConvInv => q{
- require Image::ExifTool::Geotag;
- # always warn because this tag is never set (warning is "\n" on success)
- my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val);
- return '' if not defined $result; # deleting geo tags
- return $result if ref $result; # geotag data hash reference
- warn "$result\n"; # error string
- },
- },
- Geotime => {
- Writable => 1,
- WriteOnly => 1,
- AllowGroup => '(exif|gps|xmp|xmp-exif)',
- Notes => q{
- this write-only tag is used to define a date/time for interpolating a
- position in the GPS track specified by the Geotag tag. Writing this tag
- causes GPS information to be written into the EXIF or XMP of the target
- files. The local system timezone is assumed if the date/time value does not
- contain a timezone. May be deleted to delete associated GPS tags. A group
- name of 'EXIF' or 'XMP' may be specified to write or delete only EXIF or XMP
- GPS tags. The Geotag tag must be assigned before this tag
- },
- DelCheck => q{
- require Image::ExifTool::Geotag;
- # delete associated tags
- Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
- },
- ValueConvInv => q{
- require Image::ExifTool::Geotag;
- warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n";
- return undef;
- },
- },
- Geosync => {
- Writable => 1,
- WriteOnly => 1,
- AllowGroup => '(exif|gps|xmp|xmp-exif)',
- Shift => 'Time', # enables "+=" syntax as well as "=+"
- Notes => q{
- this write-only tag specifies a time difference to add to Geotime for
- synchronization with the GPS clock. For example, set this to "-12" if the
- camera clock is 12 seconds faster than GPS time. Input format is
- "[+-][[[DD ]HH:]MM:]SS[.ss]". Must be set before Geotime to be effective.
- Additional features allow calculation of time differences and time drifts,
- and extraction of synchronization times from image files. See the
- L<geotagging documentation|../geotag.html> for details
- },
- ValueConvInv => q{
- require Image::ExifTool::Geotag;
- return Image::ExifTool::Geotag::ConvertGeosync($self, $val);
- },
- },
- MDItemTags => {
- Groups => { 1 => 'System', 2 => 'Other' },
- Notes => q{
- not a real tag. On OS X, a whole range of system-specific metadata tags
- with names starting with "MDItem" may be extracted if specifically
- requested, or if the MDItemTags API option is set. Requires that the "mdls"
- utility is available
- },
- },
- );
- # YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP)
- %Image::ExifTool::JPEG::yCbCrSubSampling = (
- '1 1' => 'YCbCr4:4:4 (1 1)', #PH
- '2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm
- '2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm
- '4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm
- '4 2' => 'YCbCr4:1:0 (4 2)', #PH
- '1 2' => 'YCbCr4:4:0 (1 2)', #PH
- '1 4' => 'YCbCr4:4:1 (1 4)', #JD
- '2 4' => 'YCbCr4:2:1 (2 4)', #JD
- );
- # define common JPEG segments here to avoid overhead of loading JPEG module
- # JPEG SOF (start of frame) tags
- # (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf)
- %Image::ExifTool::JPEG::SOF = (
- GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
- NOTES => 'This information is extracted from the JPEG Start Of Frame segment.',
- VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
- EncodingProcess => {
- PrintHex => 1,
- PrintConv => {
- 0x0 => 'Baseline DCT, Huffman coding',
- 0x1 => 'Extended sequential DCT, Huffman coding',
- 0x2 => 'Progressive DCT, Huffman coding',
- 0x3 => 'Lossless, Huffman coding',
- 0x5 => 'Sequential DCT, differential Huffman coding',
- 0x6 => 'Progressive DCT, differential Huffman coding',
- 0x7 => 'Lossless, Differential Huffman coding',
- 0x9 => 'Extended sequential DCT, arithmetic coding',
- 0xa => 'Progressive DCT, arithmetic coding',
- 0xb => 'Lossless, arithmetic coding',
- 0xd => 'Sequential DCT, differential arithmetic coding',
- 0xe => 'Progressive DCT, differential arithmetic coding',
- 0xf => 'Lossless, differential arithmetic coding',
- }
- },
- BitsPerSample => { },
- ImageHeight => { },
- ImageWidth => { },
- ColorComponents => { },
- YCbCrSubSampling => {
- Notes => 'calculated from components table',
- PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling,
- },
- );
- # JPEG JFIF APP0 definitions
- %Image::ExifTool::JFIF::Main = (
- PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
- WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
- CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
- GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
- DATAMEMBER => [ 2, 3, 5 ],
- 0 => {
- Name => 'JFIFVersion',
- Format => 'int8u[2]',
- PrintConv => 'sprintf("%d.%.2d", split(" ",$val))',
- Mandatory => 1,
- },
- 2 => {
- Name => 'ResolutionUnit',
- Writable => 1,
- RawConv => '$$self{JFIFResolutionUnit} = $val',
- PrintConv => {
- 0 => 'None',
- 1 => 'inches',
- 2 => 'cm',
- },
- Priority => -1,
- Mandatory => 1,
- },
- 3 => {
- Name => 'XResolution',
- Format => 'int16u',
- Writable => 1,
- Priority => -1,
- RawConv => '$$self{JFIFXResolution} = $val',
- Mandatory => 1,
- },
- 5 => {
- Name => 'YResolution',
- Format => 'int16u',
- Writable => 1,
- Priority => -1,
- RawConv => '$$self{JFIFYResolution} = $val',
- Mandatory => 1,
- },
- );
- %Image::ExifTool::JFIF::Extension = (
- GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
- 0x10 => {
- Name => 'ThumbnailImage',
- Groups => { 2 => 'Preview' },
- RawConv => '$self->ValidateImage(\$val,$tag)',
- },
- );
- # Composite tags (accumulation of all Composite tag tables)
- %Image::ExifTool::Composite = (
- GROUPS => { 0 => 'Composite', 1 => 'Composite' },
- TABLE_NAME => 'Image::ExifTool::Composite',
- SHORT_NAME => 'Composite',
- VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags
- WRITE_PROC => \&DummyWriteProc,
- );
- # static private ExifTool variables
- %allTables = ( ); # list of all tables loaded (except Composite tags)
- @tableOrder = ( ); # order the tables were loaded
- #------------------------------------------------------------------------------
- # Warning handler routines (warning string stored in $evalWarning)
- #
- # Set warning message
- # Inputs: 0) warning string (undef to reset warning)
- sub SetWarning($) { $evalWarning = $_[0]; }
- # Get warning message
- sub GetWarning() { return $evalWarning; }
- # Clean unnecessary information (line number, LF) from warning
- # Inputs: 0) warning string or undef to use current warning
- # Returns: cleaned warning
- sub CleanWarning(;$)
- {
- my $str = shift;
- unless (defined $str) {
- return undef unless defined $evalWarning;
- $str = $evalWarning;
- }
- $str = $1 if $str =~ /(.*) at /s;
- $str =~ s/\s+$//s;
- return $str;
- }
- #==============================================================================
- # New - create new ExifTool object
- # Inputs: 0) reference to exiftool object or ExifTool class name
- # Returns: blessed ExifTool object ref
- sub new
- {
- local $_;
- my $that = shift;
- my $class = ref($that) || $that || 'Image::ExifTool';
- my $self = bless {}, $class;
- # make sure our main Exif tag table has been loaded
- GetTagTable("Image::ExifTool::Exif::Main");
- $self->ClearOptions(); # create default options hash
- $$self{VALUE} = { }; # must initialize this for warning messages
- $$self{DEL_GROUP} = { }; # lookup for groups to delete when writing
- $$self{SAVE_COUNT} = 0; # count calls to SaveNewValues()
- $$self{FILE_SEQUENCE} = 0; # sequence number for files when reading
- # initialize our new groups for writing
- $self->SetNewGroups(@defaultWriteGroups);
- return $self;
- }
- #------------------------------------------------------------------------------
- # ImageInfo - return specified information from image file
- # Inputs: 0) [optional] ExifTool object reference
- # 1) filename, file reference, or scalar data reference
- # 2-N) list of tag names to find (or tag list reference or options reference)
- # Returns: reference to hash of tag/value pairs (with "Error" entry on error)
- # Notes:
- # - if no tags names are specified, the values of all tags are returned
- # - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv
- # - can pass a reference to list of tags to find, in which case the list will
- # be updated with the tags found in the proper case and in the specified order.
- # - can pass reference to hash specifying options
- # - returned tag values may be scalar references indicating binary data
- # - see ClearOptions() below for a list of options and their default values
- # Examples:
- # use Image::ExifTool 'ImageInfo';
- # my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize');
- # - or -
- # my $et = new Image::ExifTool;
- # my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} );
- sub ImageInfo($;@)
- {
- local $_;
- # get our ExifTool object ($self) or create one if necessary
- my $self;
- if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) {
- $self = shift;
- } else {
- $self = new Image::ExifTool;
- }
- my %saveOptions = %{$$self{OPTIONS}}; # save original options
- # initialize file information
- $$self{FILENAME} = $$self{RAF} = undef;
- $self->ParseArguments(@_); # parse our function arguments
- $self->ExtractInfo(undef); # extract meta information from image
- my $info = $self->GetInfo(undef); # get requested information
- $$self{OPTIONS} = \%saveOptions; # restore original options
- return $info; # return requested information
- }
- #------------------------------------------------------------------------------
- # Get/set ExifTool options
- # Inputs: 0) ExifTool object reference,
- # 1) Parameter name (case insensitive), 2) Value to set the option
- # 3-N) More parameter/value pairs
- # Returns: original value of last option specified
- sub Options($$;@)
- {
- local $_;
- my $self = shift;
- my $options = $$self{OPTIONS};
- my $oldVal;
- while (@_) {
- my $param = shift;
- # fix parameter case if necessary
- unless (exists $$options{$param}) {
- my ($fixed) = grep /^$param$/i, keys %$options;
- if ($fixed) {
- $param = $fixed;
- } else {
- $param =~ s/^Group(\d*)$/Group$1/i;
- }
- }
- $oldVal = $$options{$param};
- last unless @_;
- my $newVal = shift;
- if ($param eq 'Lang') {
- # allow this to be set to undef to select the default language
- $newVal = $defaultLang unless defined $newVal;
- if ($newVal eq $defaultLang) {
- $$options{$param} = $newVal;
- delete $$self{CUR_LANG};
- # make sure the language is available
- } elsif (eval "require Image::ExifTool::Lang::$newVal") {
- my $xlat = "Image::ExifTool::Lang::${newVal}::Translate";
- no strict 'refs';
- if (%$xlat) {
- $$self{CUR_LANG} = \%$xlat;
- $$options{$param} = $newVal;
- }
- } # else don't change Lang
- } elsif ($param eq 'Exclude' and defined $newVal) {
- # clone Exclude list and expand shortcuts
- my @exclude;
- if (ref $newVal eq 'ARRAY') {
- @exclude = @$newVal;
- } else {
- @exclude = ($newVal);
- }
- ExpandShortcuts(\@exclude, 1); # (also remove '#' suffix)
- $$options{$param} = \@exclude;
- } elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') {
- # only allow valid character sets to be set
- if ($newVal) {
- my $charset = $charsetName{lc $newVal};
- if ($charset) {
- $$options{$param} = $charset;
- # maintain backward-compatibility with old IPTCCharset option
- $$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset';
- } else {
- warn "Invalid Charset $newVal\n";
- }
- } elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName') {
- $$options{$param} = $newVal; # only CharsetEXIF and CharsetFileName may be set to a false value
- } elsif ($param eq 'CharsetQuickTime') {
- $$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman
- } else {
- $$options{$param} = 'Latin'; # all others default to Latin
- }
- } elsif ($param eq 'UserParam') {
- # allow initialization of entire UserParam hash
- ref $newVal eq 'HASH' and $$options{$param} = { %$newVal }, next;
- # set/reset single UserParam parameter
- if ($newVal =~ /(.*?)=(.*)/s) {
- $param = lc $1;
- $newVal = $2;
- } else {
- $param = lc $newVal;
- undef $newVal;
- }
- $oldVal = $$options{UserParam}{$param};
- if (defined $newVal) {
- if (length $newVal) {
- $$options{UserParam}{$param} = $newVal;
- } else {
- delete $$options{UserParam}{$param};
- }
- }
- } elsif ($param eq 'RequestTags') {
- if (defined $newVal) {
- # parse list from delimited string if necessary
- my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /(?:[-\w]+:)*[-\w?*]+/g);
- ExpandShortcuts(\@reqList);
- # add to existing list
- $$options{$param} or $$options{$param} = [ ];
- foreach (@reqList) {
- push @{$$options{$param}}, lc($2) if /(^|:)([-\w?*]+)#?$/;
- }
- } else {
- $$options{$param} = undef; # clear the list
- }
- } else {
- if ($param eq 'Escape') {
- # set ESCAPE_PROC
- if (defined $newVal and $newVal eq 'XML') {
- require Image::ExifTool::XMP;
- $$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML;
- } elsif (defined $newVal and $newVal eq 'HTML') {
- require Image::ExifTool::HTML;
- $$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML;
- } else {
- delete $$self{ESCAPE_PROC};
- }
- # must forget saved values since they depend on Escape method
- $$self{BOTH} = { };
- }
- $$options{$param} = $newVal;
- }
- }
- return $oldVal;
- }
- #------------------------------------------------------------------------------
- # ClearOptions - set options to default values
- # Inputs: 0) ExifTool object reference
- sub ClearOptions($)
- {
- local $_;
- my $self = shift;
- # create options hash with default values
- # +-----------------------------------------------------+
- # ! DON'T FORGET!! When adding any new option, must !
- # ! decide how it is handled in SetNewValuesFromFile() !
- # +-----------------------------------------------------+
- # (Note: All options must exist in this lookup, even if undefined,
- # to facilitate case-insensitive options. 'Group#' is handled specially)
- $$self{OPTIONS} = {
- Binary => undef, # flag to extract binary values even if tag not specified
- ByteOrder => undef, # default byte order when creating EXIF information
- Charset => 'UTF8', # character set for converting Unicode characters
- CharsetEXIF => undef, # internal EXIF "ASCII" string encoding
- CharsetFileName => undef, # external encoding for file names
- CharsetID3 => 'Latin', # internal ID3v1 character set
- CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet
- CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names
- CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding
- Compact => undef, # compact XMP and IPTC data
- Composite => 1, # flag to calculate Composite tags
- Compress => undef, # flag to write new values as compressed if possible
- CoordFormat => undef, # GPS lat/long coordinate format
- DateFormat => undef, # format for date/time
- Duplicates => 1, # flag to save duplicate tag values
- Escape => undef, # escape special characters
- Exclude => undef, # tags to exclude
- ExtendedXMP => 1, # strategy for reading extended XMP
- ExtractEmbedded =>undef,# flag to extract information from embedded documents
- FastScan => undef, # flag to avoid scanning for trailer
- Filter => undef, # output filter for all tag values
- FixBase => undef, # fix maker notes base offsets
- GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs)
- GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs)
- GeoMaxHDOP => undef, # geotag maximum HDOP
- GeoMaxPDOP => undef, # geotag maximum PDOP
- GeoMinSats => undef, # geotag minimum satellites
- GlobalTimeShift => undef, # apply time shift to all extracted date/time values
- # Group# => undef, # return tags for specified groups in family #
- HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit)
- HtmlDumpBase => undef, # base address for HTML dump
- IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
- Lang => $defaultLang,# localized language for descriptions etc
- LargeFileSupport => undef, # flag indicating support of 64-bit file offsets
- List => undef, # extract lists of PrintConv values into arrays
- ListItem => undef, # used to return a specific item from lists
- ListSep => ', ', # list item separator
- ListSplit => undef, # regex for splitting list-type tag values when writing
- MakerNotes => undef, # extract maker notes as a block
- MDItemTags => undef, # extract OS X metadata item tags
- MissingTagValue =>undef,# value for missing tags when expanded in expressions
- NoPDFList => undef, # flag to avoid splitting PDF List-type tag values
- Password => undef, # password for password-protected PDF documents
- PNGEarlyXMP => undef, # write XMP in PNG images before IDAT chunk
- PrintConv => 1, # flag to enable print conversion
- QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC
- RequestAll => undef, # extract all tags that must be specifically requested
- RequestTags => undef, # extra tags to request (on top of those in the tag list)
- SavePath => undef, # (undocumented) save family 5 location path
- ScanForXMP => undef, # flag to scan for XMP information in all files
- Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#)
- Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr)
- StrictDate => undef, # flag to return undef for invalid date conversions
- Struct => undef, # return structures as hash references
- SystemTags => undef, # extract additional File System tags
- TextOut => \*STDOUT,# file for Verbose/HtmlDump output
- Unknown => 0, # flag to get values of unknown tags (0-2)
- UserParam => { }, # user parameters for InsertTagValues()
- Verbose => 0, # print verbose messages (0-5, higher # = more verbose)
- WriteMode => 'wcg', # enable all write modes by default
- XMPAutoConv => 1, # automatic conversion of unknown XMP tag values
- };
- # keep necessary member variables in sync with options
- delete $$self{CUR_LANG};
- delete $$self{ESCAPE_PROC};
- # load user-defined default options
- if (%Image::ExifTool::UserDefined::Options) {
- foreach (keys %Image::ExifTool::UserDefined::Options) {
- $self->Options($_, $Image::ExifTool::UserDefined::Options{$_});
- }
- }
- }
- #------------------------------------------------------------------------------
- # Extract meta information from image
- # Inputs: 0) ExifTool object reference
- # 1-N) Same as ImageInfo()
- # Returns: 1 if this was a valid image, 0 otherwise
- # Notes: pass an undefined value to avoid parsing arguments
- # Internal 'ReEntry' option allows this routine to be called recursively
- sub ExtractInfo($;@)
- {
- local $_;
- my $self = shift;
- my $options = $$self{OPTIONS}; # pointer to current options
- my $fast = $$options{FastScan};
- my (%saveOptions, $reEntry, $rsize, $type, @startTime);
- # check for internal ReEntry option to allow recursive calls to ExtractInfo
- if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and
- (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB'))
- {
- # save necessary members for restoring later
- $reEntry = {
- RAF => $$self{RAF},
- PROCESSED => $$self{PROCESSED},
- EXIF_DATA => $$self{EXIF_DATA},
- EXIF_POS => $$self{EXIF_POS},
- FILE_TYPE => $$self{FILE_TYPE},
- };
- $$self{RAF} = new File::RandomAccess($_[0]);
- $$self{PROCESSED} = { };
- delete $$self{EXIF_DATA};
- delete $$self{EXIF_POS};
- } else {
- if (defined $_[0] or $$options{HtmlDump}) {
- %saveOptions = %$options; # save original options
- # require duplicates for html dump
- $self->Options(Duplicates => 1) if $$options{HtmlDump};
- if (defined $_[0]) {
- # only initialize filename if called with arguments
- $$self{FILENAME} = undef; # name of file (or '' if we didn't open it)
- $$self{RAF} = undef; # RandomAccess object reference
- $self->ParseArguments(@_); # initialize from our arguments
- }
- }
- # initialize ExifTool object members
- $self->Init();
- delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes
- delete $$self{MAKER_NOTE_BYTE_ORDER};
- # return our version number
- my $reqAll = $$options{RequestAll};
- $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
- $self->FoundTag('Now', TimeNow()) if $$self{REQ_TAG_LOOKUP}{now} or $reqAll;
- $self->FoundTag('NewGUID', NewGUID()) if $$self{REQ_TAG_LOOKUP}{newguid} or $reqAll;
- # generate sequence number if necessary
- if ($$self{REQ_TAG_LOOKUP}{filesequence} or $reqAll) {
- $self->FoundTag('FileSequence', $$self{FILE_SEQUENCE});
- }
- if ($$self{REQ_TAG_LOOKUP}{processingtime} or $reqAll) {
- eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() };
- if (not @startTime and $$self{REQ_TAG_LOOKUP}{processingtime}) {
- $self->WarnOnce('Install Time::HiRes to generate ProcessingTime');
- }
- }
- ++$$self{FILE_SEQUENCE}; # count files read
- }
- my $filename = $$self{FILENAME}; # image file name ('' if already open)
- my $raf = $$self{RAF}; # RandomAccess object
- local *EXIFTOOL_FILE; # avoid clashes with global namespace
- my $realname = $filename;
- unless ($raf) {
- # save file name
- if (defined $filename and $filename ne '') {
- unless ($filename eq '-') {
- # extract file name from pipe if necessary
- $realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s;
- my ($dir, $name);
- if (eval { require File::Basename }) {
- $dir = File::Basename::dirname($realname);
- $name = File::Basename::basename($realname);
- } else {
- ($name = $realname) =~ tr/\\/\//;
- # remove path
- $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///;
- }
- $self->FoundTag('FileName', $name);
- $self->FoundTag('Directory', $dir) if defined $dir and length $dir;
- if ($$self{REQ_TAG_LOOKUP}{filepath} or
- ($$options{RequestAll} and not $$self{EXCL_TAG_LOOKUP}{filepath}))
- {
- local $SIG{'__WARN__'} = \&SetWarning;
- if (eval { require Cwd }) {
- my $path = eval { Cwd::abs_path($filename) };
- $self->FoundTag('FilePath', $path) if defined $path;
- } elsif ($$self{REQ_TAG_LOOKUP}{filepath}) {
- $self->WarnOnce('The Perl Cwd module must be installed to use FilePath');
- }
- }
- # get size of resource fork on Mac OS
- $rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};
- }
- # open the file
- if ($self->Open(\*EXIFTOOL_FILE, $filename)) {
- # create random access file object
- $raf = new File::RandomAccess(\*EXIFTOOL_FILE);
- # patch to force pipe to be buffered because seek returns success
- # in Windows cmd shell pipe even though it really failed
- $$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/;
- $$self{RAF} = $raf;
- } else {
- $self->Error('Error opening file');
- }
- } else {
- $self->Error('No file specified');
- }
- }
- if ($raf) {
- my @stat;
- if ($reEntry) {
- # we already set these tags
- } elsif (not $$raf{FILE_PT}) {
- # get file size from image in memory
- $self->FoundTag('FileSize', length ${$$raf{BUFF_PT}});
- } elsif (-f $$raf{FILE_PT}) {
- # get file tags if this is a plain file
- my $fileSize = -s _;
- @stat = stat _;
- my ($aTime, $mTime, $cTime) = $self->GetFileTime($$raf{FILE_PT});
- $self->FoundTag('FileSize', $fileSize) if defined $fileSize;
- $self->FoundTag('ResourceForkSize', $rsize) if $rsize;
- $self->FoundTag('FileModifyDate', $mTime) if defined $mTime;
- $self->FoundTag('FileAccessDate', $aTime) if defined $aTime;
- my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate';
- $self->FoundTag($cTag, $cTime) if defined $cTime;
- $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2];
- } else {
- @stat = stat $$raf{FILE_PT};
- }
- # extract more system info if SystemTags option is set
- if (@stat) {
- my $sys = $$options{SystemTags} || ($$options{RequestAll} and not defined $$options{SystemTags});
- my $req = $$self{REQ_TAG_LOOKUP};
- if ($sys or $$req{fileattributes}) {
- my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00);
- # add Windows file attributes if available
- if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') {
- local $SIG{'__WARN__'} = \&SetWarning;
- if (eval { require Win32API::File }) {
- my $wattr;
- my $file = $filename;
- if ($self->EncodeFileName($file)) {
- $wattr = eval { Win32API::File::GetFileAttributesW($file) };
- } else {
- $wattr = eval { Win32API::File::GetFileAttributes($file) };
- }
- push @attr, $wattr if defined $wattr and $wattr != 0xffffffff;
- }
- }
- $self->FoundTag('FileAttributes', "@attr");
- }
- $self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber};
- $self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber};
- $self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks};
- $self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid};
- $self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid};
- $self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid};
- $self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize};
- $self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount};
- }
- # extract MDItem tags if requested (not extracted with RequestAll for performance reasons)
- if ($^O eq 'darwin' and ($$options{MDItemTags} || grep /^mditem/i, keys %{$$self{REQ_TAG_LOOKUP}}) and
- defined $filename and $filename ne '' and $filename ne '-')
- {
- my ($fn, $tag, $val);
- local $SIG{'__WARN__'} = \&SetWarning;
- undef $evalWarning;
- ($fn = $filename) =~ s/([`"\$\\])/\\$1/g; # escape necessary characters
- my @mdls = eval {`mdls "$fn" 2> /dev/null`}; # get OS X metadata
- unless ($evalWarning) {
- my $extra = GetTagTable('Image::ExifTool::Extra');
- foreach (@mdls) {
- chomp;
- if (ref $val ne 'ARRAY') {
- s/^k(MDItem\w+)\s*= // or next;
- $tag = $1;
- $_ eq '(' and $val = [ ], next; # (start of a list)
- $_ = '' if $_ eq '(null)';
- s/^"// and s/"$//; # remove quotes if they exist
- $val = $_;
- } elsif ($_ eq ')') { # (end of a list)
- $_ = $$val[0];
- next unless defined $_;
- } else {
- # add item to list
- s/^ //; # remove leading spaces
- s/,$//; # remove trailing comma
- $_ = '' if $_ eq '(null)';
- s/^"// and s/"$//; # remove quotes if they exist
- push @$val, $_;
- next;
- }
- # add to Extra tags if not done already
- unless ($$extra{$tag}) {
- # check for a date/time format
- my %tagInfo = /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}/ ? (
- Groups => { 1 => 'System', 2 => 'Time' },
- ValueConv => '$val=~tr/-/:/; $val=~s/ ([-+])/$1/; $val',
- PrintConv => '$self->ConvertDateTime($val)',
- ) : ( Groups => { 1 => 'System', 2 => 'Other' } );
- $tagInfo{Name} = $tag;
- $tagInfo{List} = 1 if ref $val eq 'ARRAY';
- $tagInfo{Groups}{2} = 'Audio' if $tag =~ /Audio/;
- $tagInfo{Groups}{2} = 'Author' if $tag =~ /(Copyright|Author)/;
- AddTagToTable($extra, $tag, \%tagInfo);
- }
- $self->FoundTag($tag, $val);
- undef $val;
- }
- }
- }
- # get list of file types to check
- my ($tiffType, %noMagic, $recognizedExt);
- my $ext = $$self{FILE_EXT} = GetFileExtension($realname);
- # set $recognizedExt if this file type is recognized by extension only
- $recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and
- defined $moduleName{$ext} and not $moduleName{$ext};
- my @fileTypeList = GetFileType($realname);
- if (@fileTypeList) {
- # add remaining types to end of list so we test them all
- my $pat = join '|', @fileTypeList;
- push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
- $tiffType = $$self{FILE_EXT};
- unless ($fast and $fast == 3) {
- $noMagic{MXF} = 1; # don't do magic number test on MXF or DV files
- $noMagic{DV} = 1;
- }
- } else {
- # scan through all recognized file types
- @fileTypeList = @fileTypes;
- $tiffType = 'TIFF';
- }
- push @fileTypeList, ''; # end of list marker
- # initialize the input file for seeking in binary data
- $raf->BinMode(); # set binary mode before we start reading
- my $pos = $raf->Tell(); # get file position so we can rewind
- my %dirInfo = ( RAF => $raf, Base => $pos );
- # loop through list of file types to test
- my ($buff, $seekErr);
- # read first 1024 bytes of file for testing
- $raf->Read($buff, 1024) or $buff = '';
- $raf->Seek($pos, 0) or $seekErr = 1;
- until ($seekErr) {
- $type = shift @fileTypeList;
- if ($type) {
- # do quick test for this file type to avoid loading module unnecessarily
- next if $magicNumber{$type} and $buff !~ /^$magicNumber{$type}/s and
- not $noMagic{$type};
- next if $weakMagic{$type} and defined $recognizedExt;
- } elsif (not defined $type) {
- last;
- } elsif ($recognizedExt) {
- $type = $recognizedExt; # set type from recognized file extension only
- } else {
- # last ditch effort to scan past unknown header for JPEG/TIFF
- next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g;
- $type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF';
- my $skip = pos($buff) - length($1);
- $dirInfo{Base} = $pos + $skip;
- $raf->Seek($pos + $skip, 0) or $seekErr = 1, last;
- $self->Warn("Skipped unknown $skip byte header");
- }
- # save file type in member variable
- $$self{FILE_TYPE} = $type;
- $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
- # don't process the file when FastScan == 3
- if ($fast and $fast == 3 and not $processType{$type}) {
- unless ($weakMagic{$type} and (not $ext or $ext ne $type)) {
- $self->SetFileType($dirInfo{Parent});
- }
- last;
- }
- my $module = $moduleName{$type};
- $module = $type unless defined $module;
- my $func = "Process$type";
- # load module if necessary
- if ($module) {
- require "Image/ExifTool/$module.pm";
- $func = "Image::ExifTool::${module}::$func";
- } elsif ($module eq '0') {
- $self->SetFileType();
- $self->Warn('Unsupported file type');
- last;
- }
- push @{$$self{PATH}}, $type; # save file type in metadata PATH
- # process the file
- no strict 'refs';
- my $result = &$func($self, \%dirInfo);
- use strict 'refs';
- pop @{$$self{PATH}};
- last if $result; # all done if successful
- # seek back to try again from the same position in the file
- $raf->Seek($pos, 0) or $seekErr = 1, last;
- }
- if ($seekErr) {
- $self->Error('Error seeking in file');
- } elsif ($self->Options('ScanForXMP') and (not defined $type or
- (not $fast and not $$self{FoundXMP})))
- {
- # scan for XMP
- $raf->Seek($pos, 0);
- require Image::ExifTool::XMP;
- Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = '';
- }
- if (not defined $type and not $$self{DOC_NUM}) {
- # if we were given a single image with a known type there
- # must be a format error since we couldn't read it, otherwise
- # it is likely we don't support images of this type
- my $fileType = GetFileType($realname);
- my $err;
- if (not $fileType) {
- $err = 'Unknown file type';
- } elsif ($fileType eq 'RAW') {
- $err = 'Unsupported RAW file type';
- } else {
- $err = 'File format error';
- }
- $self->Error($err);
- }
- # extract binary EXIF data block only if requested
- if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and
- ($$self{REQ_TAG_LOOKUP}{exif} or
- # (not extracted normally, so check TAGS_FROM_FILE)
- ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif})))
- {
- $self->FoundTag('EXIF', $$self{EXIF_DATA});
- }
- unless ($reEntry) {
- $$self{PATH} = [ ]; # reset PATH
- # calculate Composite tags
- $self->BuildCompositeTags() if $$options{Composite};
- # do our HTML dump if requested
- if ($$self{HTML_DUMP}) {
- $raf->Seek(0, 2); # seek to end of file
- $$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
- my $pos = $$options{HtmlDumpBase};
- $pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos;
- my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef;
- undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS};
- my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos,
- $$options{TextOut}, $$options{HtmlDump},
- $$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump');
- $self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0;
- }
- }
- if ($filename) {
- $raf->Close(); # close the file if we opened it
- # process the resource fork as an embedded file on Mac filesystems
- if ($rsize and $$options{ExtractEmbedded}) {
- local *RESOURCE_FILE;
- if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) {
- $$self{DOC_NUM} = $$self{DOC_COUNT} + 1;
- $$self{IN_RESOURCE} = 1;
- $self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 });
- close RESOURCE_FILE;
- delete $$self{IN_RESOURCE};
- } else {
- $self->Warn('Error opening resource fork');
- }
- }
- }
- }
- @startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime));
- # restore original options
- %saveOptions and $$self{OPTIONS} = \%saveOptions;
- if ($reEntry) {
- # restore necessary members when exiting re-entrant code
- $$self{$_} = $$reEntry{$_} foreach keys %$reEntry;
- }
- # ($type may be undef without an Error when processing sub-documents)
- return 0 if not defined $type or exists $$self{VALUE}{Error};
- return 1;
- }
- #------------------------------------------------------------------------------
- # Get hash of extracted meta information
- # Inputs: 0) ExifTool object reference
- # 1-N) options hash reference, tag list reference or tag names
- # Returns: Reference to information hash
- # Notes: - pass an undefined value to avoid parsing arguments
- # - If groups are specified, first groups take precedence if duplicate
- # tags found but Duplicates option not set.
- # - tag names may end in '#' to extract ValueConv value
- sub GetInfo($;@)
- {
- local $_;
- my $self = shift;
- my %saveOptions;
- unless (@_ and not defined $_[0]) {
- %saveOptions = %{$$self{OPTIONS}}; # save original options
- # must set FILENAME so it isn't parsed from the arguments
- $$self{FILENAME} = '' unless defined $$self{FILENAME};
- $self->ParseArguments(@_);
- }
- # get reference to list of tags for which we will return info
- my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags();
- # build hash of tag information
- my (%info, %ignored);
- my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
- foreach (@$rtnTags) {
- my $val = $self->GetValue($_, $conv);
- defined $val or $ignored{$_} = 1, next;
- $info{$_} = $val;
- }
- # override specified tags with ValueConv value if necessary
- if (@$byValue) {
- # first determine the number of times each non-ValueConv value is used
- my %nonVal;
- $nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags;
- --$nonVal{$$rtnTags[$_]} foreach @$byValue;
- # loop through ValueConv tags, updating tag keys and returned values
- foreach (@$byValue) {
- my $tag = $$rtnTags[$_];
- my $val = $self->GetValue($tag, 'ValueConv');
- next unless defined $val;
- my $vtag = $tag;
- # generate a new tag key like "Tag #" or "Tag #(1)"
- $vtag =~ s/( |$)/ #/;
- unless (defined $$self{VALUE}{$vtag}) {
- $$self{VALUE}{$vtag} = $$self{VALUE}{$tag};
- $$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag};
- $$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag};
- $$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag};
- # remove existing PrintConv entry unless we are using it too
- delete $info{$tag} unless $nonVal{$tag};
- }
- $$rtnTags[$_] = $vtag; # store ValueConv value with new tag key
- $info{$vtag} = $val; # return ValueConv value
- }
- }
- # remove ignored tags from the list
- my $reqTags = $$self{REQUESTED_TAGS} || [ ];
- if (%ignored) {
- if (not @$reqTags) {
- my @goodTags;
- foreach (@$rtnTags) {
- push @goodTags, $_ unless $ignored{$_};
- }
- $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
- } elsif (@$wildTags) {
- # only remove tags specified by wildcard
- my @goodTags;
- my $i = 0;
- foreach (@$rtnTags) {
- if (@$wildTags and $i == $$wildTags[0]) {
- shift @$wildTags;
- push @goodTags, $_ unless $ignored{$_};
- } else {
- push @goodTags, $_;
- }
- ++$i;
- }
- $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
- }
- }
- # return sorted tag list if provided with a list reference
- if ($$self{IO_TAG_LIST}) {
- # use file order by default if no tags specified
- # (no such thing as 'Input' order in this case)
- my $sort = $$self{OPTIONS}{Sort};
- $sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input');
- # return tags in specified sort order
- @{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2});
- }
- # restore original options
- %saveOptions and $$self{OPTIONS} = \%saveOptions;
- return \%info;
- }
- #------------------------------------------------------------------------------
- # Combine information from a list of info hashes
- # Unless Duplicates is enabled, first entry found takes priority
- # Inputs: 0) ExifTool object reference, 1-N) list of info hash references
- # Returns: Combined information hash reference
- sub CombineInfo($;@)
- {
- local $_;
- my $self = shift;
- my (%combinedInfo, $info, $tag, %haveInfo);
- if ($$self{OPTIONS}{Duplicates}) {
- while ($info = shift) {
- foreach $tag (keys %$info) {
- $combinedInfo{$tag} = $$info{$tag};
- }
- }
- } else {
- while ($info = shift) {
- foreach $tag (keys %$info) {
- my $tagName = GetTagName($tag);
- next if $haveInfo{$tagName};
- $haveInfo{$tagName} = 1;
- $combinedInfo{$tag} = $$info{$tag};
- }
- }
- }
- return \%combinedInfo;
- }
- #------------------------------------------------------------------------------
- # Inputs: 0) ExifTool object reference
- # 1) [optional] reference to info hash or tag list ref (default is found tags)
- # 2) [optional] sort order ('File', 'Input', ...)
- # 3) [optional] secondary sort order
- # Returns: List of tags in specified order
- sub GetTagList($;$$$)
- {
- local $_;
- my ($self, $info, $sort, $sort2) = @_;
- my $foundTags;
- if (ref $info eq 'HASH') {
- my @tags = keys %$info;
- $foundTags = \@tags;
- } elsif (ref $info eq 'ARRAY') {
- $foundTags = $info;
- }
- my $fileOrder = $$self{FILE_ORDER};
- if ($foundTags) {
- # make sure a FILE_ORDER entry exists for all tags
- # (note: already generated bogus entries for FOUND_TAGS case below)
- foreach (@$foundTags) {
- next if defined $$fileOrder{$_};
- $$fileOrder{$_} = 999;
- }
- } else {
- $sort = $info if $info and not $sort;
- $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
- }
- $sort or $sort = $$self{OPTIONS}{Sort};
- # return original list if no sort order specified
- return @$foundTags unless $sort and $sort ne 'Input';
- if ($sort eq 'Tag' or $sort eq 'Alpha') {
- return sort @$foundTags;
- } elsif ($sort =~ /^Group(\d*(:\d+)*)/) {
- my $family = $1 || 0;
- # want to maintain a basic file order with the groups
- # ordered in the way they appear in the file
- my (%groupCount, %groupOrder);
- my $numGroups = 0;
- my $tag;
- foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) {
- my $group = $self->GetGroup($tag, $family);
- my $num = $groupCount{$group};
- $num or $num = $groupCount{$group} = ++$numGroups;
- $groupOrder{$tag} = $num;
- }
- $sort2 or $sort2 = $$self{OPTIONS}{Sort2};
- if ($sort2) {
- if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') {
- return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags;
- } elsif ($sort2 eq 'Descr') {
- my $desc = $self->GetDescriptions($foundTags);
- return sort { $groupOrder{$a} <=> $groupOrder{$b} or
- $$desc{$a} cmp $$desc{$b} } @$foundTags;
- }
- }
- return sort { $groupOrder{$a} <=> $groupOrder{$b} or
- $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
- } elsif ($sort eq 'Descr') {
- my $desc = $self->GetDescriptions($foundTags);
- return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags;
- } else {
- return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
- }
- }
- #------------------------------------------------------------------------------
- # Get list of found tags in specified sort order
- # Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...)
- # 2) secondary sort order
- # Returns: List of tag keys in specified order
- # Notes: If not specified, sort order is taken from OPTIONS
- sub GetFoundTags($;$$)
- {
- local $_;
- my ($self, $sort, $sort2) = @_;
- my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
- return $self->GetTagList($foundTags, $sort, $sort2);
- }
- #------------------------------------------------------------------------------
- # Get list of requested tags
- # Inputs: 0) ExifTool object reference
- # Returns: List of requested tag keys
- sub GetRequestedTags($)
- {
- local $_;
- return @{$_[0]{REQUESTED_TAGS}};
- }
- #------------------------------------------------------------------------------
- # Get tag value
- # Inputs: 0) ExifTool object reference
- # 1) tag key (or flattened tagInfo for getting field values, not part of public API)
- # 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default
- # is PrintConv or ValueConv, depending on the PrintConv option setting
- # 3) raw field value (not part of public API)
- # Returns: Scalar context: tag value or undefined
- # List context: list of values or empty list
- sub GetValue($$;$)
- {
- local $_;
- my ($self, $tag, $type) = @_; # plus: ($fieldValue)
- my (@convTypes, $tagInfo, $valueConv, $both);
- # figure out what conversions to do
- if ($type) {
- return $$self{RATIONAL}{$tag} if $type eq 'Rational';
- } else {
- $type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
- }
- # start with the raw value
- my $value = $$self{VALUE}{$tag};
- if (not defined $value) {
- return wantarray ? () : undef unless ref $tag;
- # get the value of a structure field
- $tagInfo = $tag;
- $tag = $$tagInfo{Name};
- $value = $_[3];
- # (note: type "Both" is not allowed for structure fields)
- if ($type ne 'Raw') {
- push @convTypes, 'ValueConv';
- push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
- }
- } else {
- $tagInfo = $$self{TAG_INFO}{$tag};
- if ($$tagInfo{Struct} and ref $value) {
- # must load XMPStruct.pl just in case (should already be loaded if
- # a structure was extracted, but we could also arrive here if a simple
- # list of values was stored incorrectly in a Struct tag)
- require 'Image/ExifTool/XMPStruct.pl';
- # convert strucure field values
- unless ($type eq 'Both') {
- # (note: ConvertStruct handles the filtering and escaping too if necessary)
- return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type);
- }
- $valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv');
- $value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv');
- # (must not save these in $$self{BOTH} because the values may have been escaped)
- return ($valueConv, $value);
- }
- if ($type ne 'Raw') {
- # use values we calculated already if we stored them
- $both = $$self{BOTH}{$tag};
- if ($both) {
- if ($type eq 'PrintConv') {
- $value = $$both[1];
- } elsif ($type eq 'ValueConv') {
- $value = $$both[0];
- $value = $$both[1] unless defined $value;
- } else {
- ($valueConv, $value) = @$both;
- }
- } else {
- push @convTypes, 'ValueConv';
- push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
- }
- }
- }
- # do the conversions
- my (@val, @prt, @raw, $convType);
- foreach $convType (@convTypes) {
- # don't convert a scalar reference or structure
- last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary};
- my $conv = $$tagInfo{$convType};
- unless (defined $conv) {
- if ($convType eq 'ValueConv') {
- next unless $$tagInfo{Binary};
- $conv = '\$val'; # return scalar reference for binary values
- } else {
- # use PRINT_CONV from tag table if PrintConv doesn't exist
- next unless defined($conv = $$tagInfo{Table}{PRINT_CONV});
- next if exists $$tagInfo{$convType};
- }
- }
- # save old ValueConv value if we want Both
- $valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv';
- my ($i, $val, $vals, @values, $convList);
- # split into list if conversion is an array
- if (ref $conv eq 'ARRAY') {
- $convList = $conv;
- $conv = $$convList[0];
- my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value;
- # reorganize list if specified (Note: The writer currently doesn't
- # relist values, so they may be grouped but the order must not change)
- my $relist = $$tagInfo{Relist};
- if ($relist) {
- my (@newList, $oldIndex);
- foreach $oldIndex (@$relist) {
- my ($newVal, @join);
- if (ref $oldIndex) {
- foreach (@$oldIndex) {
- push @join, $valList[$_] if defined $valList[$_];
- }
- $newVal = join(' ', @join) if @join;
- } else {
- $newVal = $valList[$oldIndex];
- }
- push @newList, $newVal if defined $newVal;
- }
- $value = \@newList;
- } else {
- $value = \@valList;
- }
- return wantarray ? () : undef unless @$value;
- }
- # initialize array so we can iterate over values in list
- if (ref $value eq 'ARRAY') {
- if (defined $$tagInfo{RawJoin}) {
- $val = join ' ', @$value;
- } else {
- $i = 0;
- $vals = $value;
- $val = $$vals[0];
- }
- } else {
- $val = $value;
- }
- # loop through all values in list
- for (;;) {
- if (defined $conv) {
- # get values of required tags if this is a Composite tag
- if (ref $val eq 'HASH' and not @val) {
- # disable escape of source values so we don't double escape them
- my $oldEscape = $$self{ESCAPE_PROC};
- delete $$self{ESCAPE_PROC};
- # temporarily delete filter so it isn't applied to the Require'd values
- my $oldFilter = $$self{OPTIONS}{Filter};
- delete $$self{OPTIONS}{Filter};
- foreach (keys %$val) {
- $raw[$_] = $$self{VALUE}{$$val{$_}};
- ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
- next if defined $val[$_] or not $$tagInfo{Require}{$_};
- $$self{ESCAPE_PROC} = $oldEscape;
- return wantarray ? () : undef;
- }
- $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter;
- $$self{ESCAPE_PROC} = $oldEscape;
- # set $val to $val[0], or \@val for a CODE ref conversion
- $val = ref $conv eq 'CODE' ? \@val : $val[0];
- }
- if (ref $conv eq 'HASH') {
- # look up converted value in hash
- my $lc;
- if (defined($value = $$conv{$val})) {
- # override with our localized language PrintConv if available
- if ($$self{CUR_LANG} and $convType eq 'PrintConv' and
- # (no need to check for lang-alt tag names -- they won't have a PrintConv)
- ref($lc = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
- ($lc = $$lc{PrintConv}) and ($lc = $$lc{$value}))
- {
- $value = $self->Decode($lc, 'UTF8');
- }
- } else {
- if ($$conv{BITMASK}) {
- $value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord});
- # override with localized language strings
- if (defined $value and $$self{CUR_LANG} and $convType eq 'PrintConv' and
- ref($lc = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
- ($lc = $$lc{PrintConv}))
- {
- my @vals = split ', ', $value;
- foreach (@vals) {
- $_ = $$lc{$_} if defined $$lc{$_};
- }
- $value = join ', ', @vals;
- }
- } elsif (not $$conv{OTHER} or
- # use alternate conversion routine if available
- not defined($value = &{$$conv{OTHER}}($val, undef, $conv)))
- {
- if (($$tagInfo{PrintHex} or
- ($$tagInfo{Mask} and not defined $$tagInfo{PrintHex}))
- and $val and IsInt($val) and $convType eq 'PrintConv')
- {
- $val = sprintf('0x%x',$val);
- }
- $value = "Unknown ($val)";
- }
- }
- } else {
- # call subroutine or do eval to convert value
- local $SIG{'__WARN__'} = \&SetWarning;
- undef $evalWarning;
- if (ref $conv eq 'CODE') {
- $value = &$conv($val, $self);
- } else {
- #### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw)
- $value = eval $conv;
- $@ and $evalWarning = $@;
- }
- $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
- }
- } else {
- $value = $val;
- }
- last unless $vals;
- # must store a separate copy of each binary data value in the list
- if (ref $value eq 'SCALAR') {
- my $tval = $$value;
- $value = \$tval;
- }
- # save this converted value and step to next value in list
- push @values, $value if defined $value;
- if (++$i >= scalar(@$vals)) {
- $value = \@values if @values;
- last;
- }
- $val = $$vals[$i];
- $conv = $$convList[$i] if $convList;
- }
- # return undefined now if no value
- return wantarray ? () : undef unless defined $value;
- # join back into single value if split for conversion list
- if ($convList and ref $value eq 'ARRAY') {
- $value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value);
- }
- }
- if ($type eq 'Both') {
- # save both (unescaped) values because we often need them again
- # (Composite tags need "Both" and often Require one tag for various Composite tags)
- $$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both;
- # escape values if necessary
- if ($$self{ESCAPE_PROC}) {
- DoEscape($value, $$self{ESCAPE_PROC});
- if (defined $valueConv) {
- DoEscape($valueConv, $$self{ESCAPE_PROC});
- } else {
- $valueConv = $value;
- }
- } elsif (not defined $valueConv) {
- # $valueConv is undefined if there was no print conversion done
- $valueConv = $value;
- }
- $self->Filter(\$value) if defined $$self{OPTIONS}{Filter};
- # return Both values as a list (ValueConv, PrintConv)
- return ($valueConv, $value);
- }
- # escape value if necessary
- DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
- # filter if necessary
- $self->Filter(\$value) if defined $$self{OPTIONS}{Filter} and $type eq 'PrintConv';
- if (ref $value eq 'ARRAY') {
- if (defined $$self{OPTIONS}{ListItem}) {
- $value = $$value[$$self{OPTIONS}{ListItem}];
- } elsif (wantarray) {
- # return array if requested
- return @$value;
- } elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) {
- # join PrintConv values in comma-separated string if List option not used
- # and list contains simple scalars (otherwise return ARRAY ref)
- $value = join $$self{OPTIONS}{ListSep}, @$value;
- }
- }
- return $value;
- }
- #------------------------------------------------------------------------------
- # Get tag identification number
- # Inputs: 0) ExifTool object reference, 1) tag key
- # Returns: Scalar context: Tag ID if available, otherwise ''
- # List context: 0) Tag ID (or ''), 1) language code (or undef)
- sub GetTagID($$)
- {
- my ($self, $tag) = @_;
- my $tagInfo = $$self{TAG_INFO}{$tag};
- return '' unless $tagInfo and defined $$tagInfo{TagID};
- return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray;
- return $$tagInfo{TagID};
- }
- #------------------------------------------------------------------------------
- # Get tag table name
- # Inputs: 0) ExifTool object reference, 1) tag key
- # Returns: Table name if available, otherwise ''
- sub GetTableName($$)
- {
- my ($self, $tag) = @_;
- my $tagInfo = $$self{TAG_INFO}{$tag} or return '';
- return $$tagInfo{Table}{SHORT_NAME};
- }
- #------------------------------------------------------------------------------
- # Get tag index number
- # Inputs: 0) ExifTool object reference, 1) tag key
- # Returns: Table index number, or undefined if this tag isn't indexed
- sub GetTagIndex($$)
- {
- my ($self, $tag) = @_;
- my $tagInfo = $$self{TAG_INFO}{$tag} or return undef;
- return $$tagInfo{Index};
- }
- #------------------------------------------------------------------------------
- # Get description for specified tag
- # Inputs: 0) ExifTool object reference, 1) tag key
- # Returns: Tag description
- # Notes: Will always return a defined value, even if description isn't available
- sub GetDescription($$)
- {
- local $_;
- my ($self, $tag) = @_;
- my ($desc, $name);
- my $tagInfo = $$self{TAG_INFO}{$tag};
- # ($tagInfo won't be defined for missing tags extracted with -f)
- if ($tagInfo) {
- # use alternate language description if available
- while ($$self{CUR_LANG}) {
- $desc = $$self{CUR_LANG}{$$tagInfo{Name}};
- if ($desc) {
- # must look up Description if this tag also has a PrintConv
- $desc = $$desc{Description} or last if ref $desc;
- } else {
- # look up default language of lang-alt tag
- last unless $$tagInfo{LangCode} and
- ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and
- $desc = $$self{CUR_LANG}{$name};
- $desc = $$desc{Description} or last if ref $desc;
- $desc .= " ($$tagInfo{LangCode})";
- }
- # escape description if necessary
- DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
- # return description in proper Charset
- return $self->Decode($desc, 'UTF8');
- }
- $desc = $$tagInfo{Description};
- }
- # just make the tag more readable if description doesn't exist
- unless ($desc) {
- $desc = MakeDescription(GetTagName($tag));
- # save description in tag information
- $$tagInfo{Description} = $desc if $tagInfo;
- }
- return $desc;
- }
- #------------------------------------------------------------------------------
- # Get group name for specified tag
- # Inputs: 0) ExifTool object reference
- # 1) tag key (or reference to tagInfo hash, not part of the public API)
- # 2) [optional] group family (-1 to get extended group list, or multiple
- # families separated by colons to return multiple groups as a string)
- # Returns: Scalar context: Group name (for family 0 if not otherwise specified)
- # Array context: Group name if family specified, otherwise list of
- # group names for each family. Returns '' for undefined tag.
- # Notes: Mutiple families may be specified with ':' in family argument (eg. '1:2')
- sub GetGroup($$;$)
- {
- local $_;
- my ($self, $tag, $family) = @_;
- my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex);
- if (ref $tag eq 'HASH') {
- $tagInfo = $tag;
- $tag = $$tagInfo{Name};
- # set flag so we don't get extra information for an extracted tag
- $byTagInfo = 1;
- } else {
- $tagInfo = $$self{TAG_INFO}{$tag} || { };
- $ex = $$self{TAG_EXTRA}{$tag};
- }
- my $groups = $$tagInfo{Groups};
- # fill in default groups unless already done
- # (after this, Groups 0-2 in tagInfo are guaranteed to be defined)
- unless ($$tagInfo{GotGroups}) {
- my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } };
- # construct our group list
- $groups or $groups = $$tagInfo{Groups} = { };
- # fill in default groups
- foreach (0..2) {
- $$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_};
- }
- # set flag indicating group list was built
- $$tagInfo{GotGroups} = 1;
- }
- if (defined $family and $family ne '-1') {
- if ($family =~ /[^\d]/) {
- @families = ($family =~ /\d+/g);
- return(($ex && $$ex{G0}) || $$groups{0}) unless @families;
- $simplify = 1 unless $family =~ /^:/;
- undef $family;
- foreach (0..2) { $groups[$_] = $$groups{$_}; }
- } else {
- return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2;
- $groups[1] = $$groups{1};
- }
- } else {
- return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray;
- foreach (0..2) { $groups[$_] = $$groups{$_}; }
- }
- $groups[3] = 'Main';
- $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : '';
- # handle dynamic group names if necessary
- if ($ex and not $byTagInfo) {
- $groups[0] = $$ex{G0} if $$ex{G0};
- $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1};
- $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3};
- $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5};
- }
- if ($family) {
- return $groups[$family] || '' if $family > 0;
- # add additional matching group names to list
- # eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
- # and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc
- if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) {
- push @groups, 'MIE' . ($1 || '1');
- push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3";
- push @groups, "MIE$1-$2" . ($3 ? '' : '1');
- push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1');
- }
- }
- if (@families) {
- my @grps;
- # create list of group names (without identical adjacent groups if simplifying)
- foreach (@families) {
- my $grp = $groups[$_] or next;
- push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1];
- }
- # remove leading "Main:" if simplifying
- shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main';
- # return colon-separated string of group names
- return join ':', @grps;
- }
- return @groups;
- }
- #------------------------------------------------------------------------------
- # Get group names for specified tags
- # Inputs: 0) ExifTool object reference
- # 1) [optional] information hash reference (default all extracted info)
- # 2) [optional] group family (default 0)
- # Returns: List of group names in alphabetical order
- sub GetGroups($;$$)
- {
- local $_;
- my $self = shift;
- my $info = shift;
- my $family;
- # figure out our arguments
- if (ref $info ne 'HASH') {
- $family = $info;
- $info = $$self{VALUE};
- } else {
- $family = shift;
- }
- $family = 0 unless defined $family;
- # get a list of all groups in specified information
- my ($tag, %groups);
- foreach $tag (keys %$info) {
- $groups{ $self->GetGroup($tag, $family) } = 1;
- }
- return sort keys %groups;
- }
- #------------------------------------------------------------------------------
- # Set priority for group where new values are written
- # Inputs: 0) ExifTool object reference,
- # 1-N) group names (reset to default if no groups specified)
- sub SetNewGroups($;@)
- {
- local $_;
- my ($self, @groups) = @_;
- @groups or @groups = @defaultWriteGroups;
- my $count = @groups;
- my %priority;
- foreach (@groups) {
- $priority{lc($_)} = $count--;
- }
- $priority{file} = 10; # 'File' group is always written (Comment)
- $priority{composite} = 10; # 'Composite' group is always written
- # set write priority (higher # is higher priority)
- $$self{WRITE_PRIORITY} = \%priority;
- $$self{WRITE_GROUPS} = \@groups;
- }
- #------------------------------------------------------------------------------
- # Build Composite tags from Require'd/Desire'd tags
- # Inputs: 0) ExifTool object reference
- # Note: Tag values are calculated in alphabetical order unless a tag Require's
- # or Desire's another Composite tag, in which case the calculation is
- # deferred until after the other tag is calculated.
- sub BuildCompositeTags($)
- {
- local $_;
- my $self = shift;
- $$self{BuildingComposite} = 1;
- # first, add user-defined Composite tags if necessary
- if (%UserDefined and $UserDefined{'Image::ExifTool::Composite'}) {
- AddCompositeTags($UserDefined{'Image::ExifTool::Composite'}, 1);
- delete $UserDefined{'Image::ExifTool::Composite'};
- }
- my @tagList = sort keys %Image::ExifTool::Composite;
- my %tagsUsed;
- my $rawValue = $$self{VALUE};
- for (;;) {
- my %notBuilt;
- $notBuilt{$_} = 1 foreach @tagList;
- my @deferredTags;
- my $tag;
- COMPOSITE_TAG:
- foreach $tag (@tagList) {
- next if $specialTags{$tag};
- my $tagInfo = $self->GetTagInfo(\%Image::ExifTool::Composite, $tag);
- next unless $tagInfo;
- # put required tags into array and make sure they all exist
- my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT});
- my $require = $$tagInfo{Require} || { };
- my $desire = $$tagInfo{Desire} || { };
- my $inhibit = $$tagInfo{Inhibit} || { };
- # loop through sub-documents if necessary
- my $doc;
- for (;;) {
- my (%tagKey, $found, $index);
- # save Require'd and Desire'd tag values in list
- for ($index=0; ; ++$index) {
- my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index};
- unless ($reqTag) {
- # allow Composite with no Require'd or Desire'd tags
- $found = 1 if $index == 0;
- last;
- }
- # add family 3 group if generating Composite tags for sub-documents
- # (unless tag already begins with family 3 group name)
- if ($subDoc and $reqTag !~ /^(Main|Doc\d+):/) {
- $reqTag = ($doc ? "Doc$doc:" : 'Main:') . $reqTag;
- }
- # allow tag group to be specified
- if ($reqTag =~ /^(.*):(.+)/) {
- my ($reqGroup, $name) = ($1, $2);
- if ($reqGroup eq 'Composite' and $notBuilt{$name}) {
- push @deferredTags, $tag;
- next COMPOSITE_TAG;
- }
- # (CAREFUL! keys may not be sequential if one was deleted)
- my ($i, @keys);
- my $key = $name;
- my $last = ($$self{DUPL_TAG}{$name} || 0);
- for ($i=0;;) {
- push @keys, $key if defined $$rawValue{$key};
- last if ++$i > $last;
- $key = "$name ($i)";
- }
- # find first matching tag
- $key = $self->GroupMatches($reqGroup, \@keys);
- $reqTag = $key if $key;
- } elsif ($notBuilt{$reqTag}) {
- # calculate this tag later if it relies on another
- # Composite tag which hasn't been calculated yet
- push @deferredTags, $tag;
- next COMPOSITE_TAG;
- }
- if (defined $$rawValue{$reqTag}) {
- if ($$inhibit{$index}) {
- $found = 0;
- last;
- } else {
- $found = 1;
- }
- } elsif ($$require{$index}) {
- $found = 0;
- last; # don't continue since we require this tag
- }
- $tagKey{$index} = $reqTag;
- }
- if ($doc) {
- if ($found) {
- $$self{DOC_NUM} = $doc;
- $self->FoundTag($tagInfo, \%tagKey);
- delete $$self{DOC_NUM};
- }
- next if ++$doc <= $$self{DOC_COUNT};
- last;
- } elsif ($found) {
- delete $notBuilt{$tag}; # this tag is OK to build now
- # keep track of all Require'd tag keys
- foreach (keys %tagKey) {
- # only tag keys with same name as a Composite tag
- # can be replaced (also eliminates keys with
- # instance numbers which can't be replaced either)
- next unless $Image::ExifTool::Composite{$tagKey{$_}};
- my $keyRef = \$tagKey{$_};
- $tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ];
- push @{$tagsUsed{$$keyRef}}, $keyRef;
- }
- # save reference to tag key lookup as value for Composite tag
- my $key = $self->FoundTag($tagInfo, \%tagKey);
- # check to see if we just replaced one of the tag keys we Require'd
- if (defined $key and $tagsUsed{$key}) {
- foreach (@{$tagsUsed{$key}}) {
- $$_ = $$self{MOVED_KEY}; # replace with new tag key
- }
- delete $tagsUsed{$key}; # can't be replaced again
- }
- } elsif (not defined $found) {
- delete $notBuilt{$tag}; # tag can't be built anyway
- }
- last unless $subDoc;
- $doc = 1; # continue to process the 1st sub-document
- }
- }
- last unless @deferredTags;
- if (@deferredTags == @tagList) {
- # everything was deferred in the last pass,
- # must be a circular dependency
- warn "Circular dependency in Composite tags\n";
- last;
- }
- @tagList = @deferredTags; # calculate deferred tags now
- }
- delete $$self{BuildingComposite};
- }
- #------------------------------------------------------------------------------
- # Get tag name (removes copy index)
- # Inputs: 0) Tag key
- # Returns: Tag name
- sub GetTagName($)
- {
- local $_;
- $_[0] =~ /^(\S+)/;
- return $1;
- }
- #------------------------------------------------------------------------------
- # Get list of shortcuts
- # Returns: Shortcut list (sorted alphabetically)
- sub GetShortcuts()
- {
- local $_;
- require Image::ExifTool::Shortcuts;
- return sort keys %Image::ExifTool::Shortcuts::Main;
- }
- #------------------------------------------------------------------------------
- # Get file type for specified extension
- # Inputs: 0) file name or extension (case is not significant),
- # or FileType value if a description is requested
- # 1) flag to return long description instead of type ('0' to return any recognized type)
- # Returns: File type (or desc) or undef if extension not supported or if
- # description is the same as the input FileType. In array context,
- # may return more than one file type if the file may be different formats.
- # Returns list of all supported extensions if no file specified
- sub GetFileType(;$$)
- {
- local $_;
- my ($file, $desc) = @_;
- unless (defined $file) {
- my @types;
- if (defined $desc and $desc eq '0') {
- # return all recognized types
- @types = sort keys %fileTypeLookup;
- } else {
- # return all supported types
- foreach (sort keys %fileTypeLookup) {
- my $module = $moduleName{$_};
- $module = $moduleName{$fileTypeLookup{$_}} unless defined $module;
- push @types, $_ unless defined $module and $module eq '0';
- }
- }
- return @types;
- }
- my $fileType;
- my $fileExt = GetFileExtension($file);
- $fileExt = uc($file) unless $fileExt;
- $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type
- $fileType = $fileTypeLookup{$fileType} if $fileType and not ref $fileType;
- # return description if specified
- # (allow input $file to be a FileType for this purpose)
- if ($desc) {
- return $fileType ? $$fileType[1] : $fileDescription{$file};
- } elsif ($fileType and (not defined $desc or $desc ne '0')) {
- # return only supported file types
- my $mod = $moduleName{$$fileType[0]};
- undef $fileType if defined $mod and $mod eq '0';
- }
- $fileType or return wantarray ? () : undef;
- $fileType = $$fileType[0]; # get file type (or list of types)
- if (wantarray) {
- return @$fileType if ref $fileType eq 'ARRAY';
- } elsif ($fileType) {
- $fileType = $fileExt if ref $fileType eq 'ARRAY';
- }
- return $fileType;
- }
- #------------------------------------------------------------------------------
- # Return true if we can write the specified file type
- # Inputs: 0) file name or ext
- # Returns: true if writable, 0 if not writable, undef if unrecognized
- sub CanWrite($)
- {
- local $_;
- my $file = shift or return undef;
- my ($type) = GetFileType($file) or return undef;
- if ($noWriteFile{$type}) {
- # can't write TIFF files with certain extensions (various RAW formats)
- my $ext = GetFileExtension($file) || uc($file);
- return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext;
- }
- unless (%writeTypes) {
- $writeTypes{$_} = 1 foreach @writeTypes;
- }
- return $writeTypes{$type};
- }
- #------------------------------------------------------------------------------
- # Return true if we can create the specified file type
- # Inputs: 0) file name or ext
- # Returns: true if creatable, 0 if not writable, undef if unrecognized
- sub CanCreate($)
- {
- local $_;
- my $file = shift or return undef;
- my $ext = GetFileExtension($file) || uc($file);
- my $type = GetFileType($file) or return undef;
- return 1 if $createTypes{$ext} or $createTypes{$type};
- return 0;
- }
- #==============================================================================
- # Functions below this are not part of the public API
- # Initialize member variables for reading or writing a new file
- # Inputs: 0) ExifTool object reference
- sub Init($)
- {
- local $_;
- my $self = shift;
- # delete all DataMember variables (lower-case names)
- foreach (keys %$self) {
- /[a-z]/ and delete $$self{$_};
- }
- delete $$self{FOUND_TAGS}; # list of found tags
- delete $$self{EXIF_DATA}; # the EXIF data block
- delete $$self{EXIF_POS}; # EXIF position in file
- delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file
- delete $$self{HTML_DUMP}; # html dump information
- delete $$self{SET_GROUP0}; # group0 name override
- delete $$self{SET_GROUP1}; # group1 name override
- delete $$self{DOC_NUM}; # current embedded document number
- $$self{DOC_COUNT} = 0; # count of embedded documents processed
- $$self{BASE} = 0; # base for offsets from start of file
- $$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key)
- $$self{VALUE} = { }; # * hash of raw tag values
- $$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags
- $$self{RATIONAL} = { }; # * hash of original rational components
- $$self{TAG_INFO} = { }; # * hash of tag information
- $$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names)
- $$self{PRIORITY} = { }; # * priority of current tags
- $$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags
- $$self{PROCESSED} = { }; # hash of processed directory start positions
- $$self{DIR_COUNT} = { }; # count various types of directories
- $$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys
- $$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued
- $$self{WRITTEN} = { }; # list of tags written (selected tags only)
- $$self{PATH} = [ ]; # current subdirectory path in file when reading
- $$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates)
- $$self{CHANGED} = 0; # number of tags changed (writer only)
- $$self{INDENT} = ' '; # initial indent for verbose messages
- $$self{PRIORITY_DIR} = ''; # the priority directory name
- $$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories
- $$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...)
- $$self{Make} = ''; # camera make
- $$self{Model} = ''; # camera model
- $$self{CameraType} = ''; # Olympus camera type
- if ($self->Options('HtmlDump')) {
- require Image::ExifTool::HtmlDump;
- $$self{HTML_DUMP} = new Image::ExifTool::HtmlDump;
- }
- # make sure our TextOut is a file reference
- $$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut};
- }
- #------------------------------------------------------------------------------
- # Get tag key for next existing tag
- # Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name
- # Returns: Key of next existing tag, or undef if no more
- # Notes: This routine is provided for iterating through duplicate tags in the
- # ValueConv of Composite tags.
- sub NextTagKey($$)
- {
- my ($self, $tag) = @_;
- my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1;
- $tag = "$tag ($i)";
- return $tag if defined $$self{VALUE}{$tag};
- return undef;
- }
- #------------------------------------------------------------------------------
- # Encode file name for calls to system i/o routines
- # Inputs: 0) ExifTool ref, 1) file name, 2) flag to force conversion
- # Returns: true if Windows Unicode routines should be used (in which case
- # the file name will be encoded as a null-terminated UTF-16LE string)
- sub EncodeFileName($$;$)
- {
- my ($self, $file, $force) = @_;
- my $enc = $$self{OPTIONS}{CharsetFileName};
- if ($enc and ($file =~ /[\x80-\xff]/ or $force)) {
- # encode for use in Windows Unicode functions if necessary
- if ($^O eq 'MSWin32') {
- local $SIG{'__WARN__'} = \&SetWarning;
- if (eval { require Win32API::File }) {
- # recode as UTF-16LE and add null terminator
- $_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0";
- return 1;
- }
- $self->WarnOnce('Install Win32API::File for Windows Unicode file support');
- } else {
- # recode as UTF-8 for other platforms if necessary
- $_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8';
- }
- } elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/) {
- require Image::ExifTool::XMP;
- if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) {
- $self->WarnOnce('FileName encoding not specified');
- }
- }
- return 0;
- }
- #------------------------------------------------------------------------------
- # Modified perl open() routine to properly handle special characters in file names
- # Inputs: 0) ExifTool ref, 1) filehandle, 2) filename,
- # 3) mode: '<' or undef = read, '>' = write, '+<' = update
- # Returns: true on success
- # Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid
- # "unopened filehandle" errors due to a change in scope of the filehandle
- sub Open($*$;$)
- {
- my ($self, $fh, $file, $mode) = @_;
- $file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand
- # default to read mode ('<') unless input is a pipe
- $mode = ($file =~ /\|$/ ? '' : '<') unless $mode;
- if ($mode) {
- if ($self->EncodeFileName($file)) {
- # handle Windows Unicode file name
- local $SIG{'__WARN__'} = \&SetWarning;
- my ($access, $create);
- if ($mode eq '>') {
- eval {
- $access = Win32API::File::GENERIC_WRITE();
- $create = Win32API::File::CREATE_ALWAYS();
- }
- } else {
- eval {
- $access = Win32API::File::GENERIC_READ();
- $access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update
- $create = Win32API::File::OPEN_EXISTING();
- }
- }
- my $wh = eval { Win32API::File::CreateFileW($file, $access, 0, [], $create, 0, []) };
- return undef unless $wh;
- my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) };
- if (not defined $fd or $fd < 0) {
- eval { Win32API::File::CloseHandle($wh) };
- return undef;
- }
- $file = "&=$fd"; # specify file by descriptor
- } else {
- # add leading space to protect against leading characters like '>'
- # in file name, and trailing "\0" to protect trailing spaces
- $file = " $file\0";
- }
- }
- return open $fh, "$mode$file";
- }
- #------------------------------------------------------------------------------
- # Check to see if a file exists (with Windows Unicode support)
- # Inputs: 0) ExifTool ref, 1) file name
- # Returns: true if file exists
- sub Exists($$)
- {
- my ($self, $file) = @_;
- if ($self->EncodeFileName($file)) {
- local $SIG{'__WARN__'} = \&SetWarning;
- my $wh = eval { Win32API::File::CreateFileW($file,
- Win32API::File::GENERIC_READ(), 0, [],
- Win32API::File::OPEN_EXISTING(), 0, []) };
- return 0 unless $wh;
- eval { Win32API::File::CloseHandle($wh) };
- } else {
- return -e $file;
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # Return true if file is a directory (with Windows Unicode support)
- # Inputs: 0) ExifTool ref, 1) file name
- # Returns: true if file is a directory (false if file isn't, or doesn't exist)
- sub IsDirectory($$)
- {
- my ($et, $file) = @_;
- if ($et->EncodeFileName($file)) {
- local $SIG{'__WARN__'} = \&SetWarning;
- my $attrs = eval { Win32API::File::GetFileAttributesW($file) };
- my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0;
- return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit;
- } else {
- return -d $file;
- }
- return 0;
- }
- #------------------------------------------------------------------------------
- # Get file times (Unix seconds since the epoch)
- # Inputs: 0) ExifTool ref, 1) file name or ref
- # Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error)
- my $k32GetFileTime;
- sub GetFileTime($$)
- {
- my ($self, $file) = @_;
- # open file by name if necessary
- unless (ref $file) {
- local *FH;
- $self->Open(\*FH, $file) or $self->Warn("GetFileTime error for '$file'"), return ();
- $file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope)
- }
- # on Windows, try to work around incorrect file times when daylight saving time is in effect
- if ($^O eq 'MSWin32') {
- if (not eval { require Win32::API }) {
- $self->WarnOnce('Install Win32::API for proper handling of Windows file times');
- } elsif (not eval { require Win32API::File }) {
- $self->WarnOnce('Install Win32API::File for proper handling of Windows file times');
- } else {
- # get Win32 handle, needed for GetFileTime
- my $win32Handle = eval { Win32API::File::GetOsFHandle($file) };
- unless ($win32Handle) {
- $self->Warn("Win32API::File::GetOsFHandle returned invalid handle");
- return ();
- }
- # get FILETIME structs
- my ($atime, $mtime, $ctime, $time);
- $atime = $mtime = $ctime = pack 'LL', 0, 0;
- unless ($k32GetFileTime) {
- return () if defined $k32GetFileTime;
- $k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I');
- unless ($k32GetFileTime) {
- $self->Warn('Error calling Win32::API::GetFileTime');
- $k32GetFileTime = 0;
- return ();
- }
- }
- unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) {
- $self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError());
- return ();
- }
- # convert FILETIME structs to Unix seconds
- foreach $time ($atime, $mtime, $ctime) {
- my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct
- # FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601
- # (89 leap years between 1601 and 1970)
- $time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600);
- }
- return ($atime, $mtime, $ctime);
- }
- }
- # other os (or Windows fallback)
- return (stat $file)[8, 9, 10];
- }
- #------------------------------------------------------------------------------
- # Parse function arguments and set member variables accordingly
- # Inputs: Same as ImageInfo()
- # - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS
- sub ParseArguments($;@)
- {
- my $self = shift;
- my $options = $$self{OPTIONS};
- my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}};
- my (@exclude, $wasExcludeOpt);
- $$self{REQUESTED_TAGS} = [ ];
- $$self{REQ_TAG_LOOKUP} = { };
- $$self{EXCL_TAG_LOOKUP} = { };
- $$self{IO_TAG_LIST} = undef;
- # handle our input arguments
- while (@_) {
- my $arg = shift;
- if (ref $arg) {
- if (ref $arg eq 'ARRAY') {
- $$self{IO_TAG_LIST} = $arg;
- foreach (@$arg) {
- if (/^-(.*)/) {
- push @exclude, $1;
- } else {
- push @{$$self{REQUESTED_TAGS}}, $_;
- }
- }
- } elsif (ref $arg eq 'HASH') {
- my $opt;
- foreach $opt (keys %$arg) {
- # a single new group option overrides all old group options
- if (@oldGroupOpts and $opt =~ /^Group/) {
- foreach (@oldGroupOpts) {
- delete $$options{$_};
- }
- undef @oldGroupOpts;
- }
- $self->Options($opt, $$arg{$opt});
- $opt eq 'Exclude' and $wasExcludeOpt = 1;
- }
- } elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) {
- next if defined $$self{RAF};
- # convert image data from UTF-8 to character stream if necessary
- # (patches RHEL 3 UTF8 LANG problem)
- if (ref $arg eq 'SCALAR' and $] >= 5.006 and
- (eval { require Encode; Encode::is_utf8($$arg) } or $@))
- {
- # repack by hand if Encode isn't available
- my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg);
- $arg = \$buff;
- }
- $$self{RAF} = new File::RandomAccess($arg);
- # set filename to empty string to indicate that
- # we have a file but we didn't open it
- $$self{FILENAME} = '';
- } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) {
- $$self{RAF} = $arg;
- $$self{FILENAME} = '';
- } else {
- warn "Don't understand ImageInfo argument $arg\n";
- }
- } elsif (defined $$self{FILENAME}) {
- if ($arg =~ /^-(.*)/) {
- push @exclude, $1;
- } else {
- push @{$$self{REQUESTED_TAGS}}, $arg;
- }
- } else {
- $$self{FILENAME} = $arg;
- }
- }
- # add additional requested tags to lookup
- if ($$options{RequestTags}) {
- $$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}};
- }
- # expand shortcuts in tag arguments if provided
- if (@{$$self{REQUESTED_TAGS}}) {
- ExpandShortcuts($$self{REQUESTED_TAGS});
- # initialize lookup for requested tags
- foreach (@{$$self{REQUESTED_TAGS}}) {
- /(^|:)([-\w?*]+)#?$/ and $$self{REQ_TAG_LOOKUP}{lc($2)} = 1;
- }
- }
- if (@exclude or $wasExcludeOpt) {
- # must add existing excluded tags
- push @exclude, @{$$options{Exclude}} if $$options{Exclude};
- $$options{Exclude} = \@exclude;
- # expand shortcuts in new exclude list
- ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix)
- }
- # generate lookup for excluded tags
- if ($$options{Exclude}) {
- foreach (@{$$options{Exclude}}) {
- /([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc($1)} = 1;
- }
- # exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set
- undef $$options{Exclude} if $$self{TAGS_FROM_FILE};
- }
- }
- #------------------------------------------------------------------------------
- # Get list of tags in specified group
- # Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys
- # Returns: list of matching tags in list context, or first match in scalar context
- # Notes: Group spec may contain multiple groups separated by colons, each
- # possibly with a leading family number
- sub GroupMatches($$$)
- {
- my ($self, $group, $tagList) = @_;
- $tagList = [ $tagList ] unless ref $tagList;
- my ($tag, @matches);
- if ($group =~ /:/) {
- # check each group name individually (eg. "Author:1IPTC")
- my @grps = split ':', lc $group;
- my (@fmys, $g);
- for ($g=0; $g<@grps; ++$g) {
- $fmys[$g] = $1 if $grps[$g] =~ s/^(\d+)//;
- }
- foreach $tag (@$tagList) {
- my @groups = $self->GetGroup($tag, -1);
- for ($g=0; $g<@grps; ++$g) {
- my $grp = $grps[$g];
- next if $grp eq '*' or $grp eq 'all';
- if (defined $fmys[$g]) {
- my $f = $fmys[$g];
- last unless $groups[$f] and $grps[$g] eq lc $groups[$f];
- } else {
- last unless grep /^$grps[$g]$/i, @groups;
- }
- }
- if ($g == @grps) {
- return $tag unless wantarray;
- push @matches, $tag;
- }
- }
- } else {
- my $family = ($group =~ s/^(\d+)//) ? $1 : -1;
- foreach $tag (@$tagList) {
- my @groups = $self->GetGroup($tag, $family);
- if (grep(/^$group$/i, @groups)) {
- return $tag unless wantarray;
- push @matches, $tag;
- }
- }
- }
- return wantarray ? @matches : $matches[0];
- }
- #------------------------------------------------------------------------------
- # Set list of found tags from previously requested tags
- # Inputs: 0) ExifTool object reference
- # Returns: 0) Reference to list of found tag keys (in order of requested tags)
- # 1) Reference to list of indices for tags requested by value
- # 2) Reference to list of indices for tags specified by wildcard or "all"
- # Notes: index lists are returned in increasing order
- sub SetFoundTags($)
- {
- my $self = shift;
- my $options = $$self{OPTIONS};
- my $reqTags = $$self{REQUESTED_TAGS} || [ ];
- my $duplicates = $$options{Duplicates};
- my $exclude = $$options{Exclude};
- my $fileOrder = $$self{FILE_ORDER};
- my @groupOptions = sort grep /^Group/, keys %$options;
- my $doDups = $duplicates || $exclude || @groupOptions;
- my ($tag, $rtnTags, @byValue, @wildTags);
- # only return requested tags if specified
- if (@$reqTags) {
- $rtnTags or $rtnTags = [ ];
- # scan through the requested tags and generate a list of tags we found
- my $tagHash = $$self{VALUE};
- my $reqTag;
- foreach $reqTag (@$reqTags) {
- my (@matches, $group, $allGrp, $allTag, $byValue);
- if ($reqTag =~ /^(.*):(.+)/) {
- ($group, $tag) = ($1, $2);
- if ($group =~ /^(\*|all)$/i) {
- $allGrp = 1;
- } elsif ($group !~ /^[-\w:]*$/) {
- $self->Warn("Invalid group name '$group'");
- $group = 'invalid';
- }
- } else {
- $tag = $reqTag;
- }
- $byValue = 1 if $tag =~ s/#$// and $$options{PrintConv};
- if (defined $$tagHash{$reqTag} and not $doDups) {
- $matches[0] = $tag;
- } elsif ($tag =~ /^(\*|all)$/i) {
- # tag name of '*' or 'all' matches all tags
- if ($doDups or $allGrp) {
- @matches = grep(!/#/, keys %$tagHash);
- } else {
- @matches = grep(!/ /, keys %$tagHash);
- }
- next unless @matches; # don't want entry in list for '*' tag
- $allTag = 1;
- } elsif ($tag =~ /[*?]/) {
- # allow wildcards in tag names
- $tag =~ s/\*/[-\\w]*/g;
- $tag =~ s/\?/[-\\w]/g;
- $tag .= '( \\(.*)?' if $doDups or $allGrp;
- @matches = grep(/^$tag$/i, keys %$tagHash);
- next unless @matches; # don't want entry in list for wildcard tags
- $allTag = 1;
- } elsif ($doDups or defined $group) {
- # must also look for tags like "Tag (1)"
- # (but be sure not to match temporary ValueConv entries like "Tag #")
- @matches = grep(/^$tag( \(|$)/i, keys %$tagHash);
- } elsif ($tag =~ /^[-\w]+$/) {
- # find first matching value
- # (use in list context to return value instead of count)
- ($matches[0]) = grep /^$tag$/i, keys %$tagHash;
- defined $matches[0] or undef @matches;
- } else {
- $self->Warn("Invalid tag name '$tag'");
- }
- if (defined $group and not $allGrp) {
- # keep only specified group
- @matches = $self->GroupMatches($group, \@matches);
- next unless @matches or not $allTag;
- }
- if (@matches > 1) {
- # maintain original file order for multiple tags
- @matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches;
- # return only the highest priority tag unless duplicates wanted
- unless ($doDups or $allTag or $allGrp) {
- $tag = shift @matches;
- my $oldPriority = $$self{PRIORITY}{$tag} || 1;
- foreach (@matches) {
- my $priority = $$self{PRIORITY}{$_};
- $priority = 1 unless defined $priority;
- next unless $priority >= $oldPriority;
- $tag = $_;
- $oldPriority = $priority || 1;
- }
- @matches = ( $tag );
- }
- } elsif (not @matches) {
- # put entry in return list even without value (value is undef)
- $matches[0] = $byValue ? "$tag #(0)" : "$tag (0)";
- # bogus file order entry to avoid warning if sorting in file order
- $$self{FILE_ORDER}{$matches[0]} = 9999;
- }
- # save indices of tags extracted by value
- push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue;
- # save indices of wildcard tags
- push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag;
- push @$rtnTags, @matches;
- }
- } else {
- # no requested tags, so we want all tags
- my @allTags;
- if ($doDups) {
- @allTags = keys %{$$self{VALUE}};
- } else {
- # only include tag if it doesn't end in a copy number
- @allTags = grep(!/ /, keys %{$$self{VALUE}});
- }
- $rtnTags = \@allTags;
- }
- # filter excluded tags and group options
- while (($exclude or @groupOptions) and @$rtnTags) {
- if ($exclude) {
- my ($pat, %exclude);
- foreach $pat (@$exclude) {
- my $group;
- if ($pat =~ /^(.*):(.+)/) {
- ($group, $tag) = ($1, $2);
- if ($group =~ /^(\*|all)$/i) {
- undef $group;
- } elsif ($group !~ /^[-\w:]*$/) {
- $self->Warn("Invalid group name '$group'");
- $group = 'invalid';
- }
- } else {
- $tag = $pat;
- }
- my @matches;
- if ($tag =~ /^(\*|all)$/i) {
- @matches = @$rtnTags;
- } else {
- # allow wildcards in tag names
- $tag =~ s/\*/[-\\w]*/g;
- $tag =~ s/\?/[-\\w]/g;
- @matches = grep(/^$tag( |$)/i, @$rtnTags);
- }
- @matches = $self->GroupMatches($group, \@matches) if $group and @matches;
- $exclude{$_} = 1 foreach @matches;
- }
- if (%exclude) {
- my @filteredTags;
- $exclude{$_} or push @filteredTags, $_ foreach @$rtnTags;
- $rtnTags = \@filteredTags; # use new filtered tag list
- last unless @filteredTags; # all done if nothing left
- }
- last if $duplicates and not @groupOptions;
- }
- # filter groups if requested, or to remove duplicates
- my (%keepTags, %wantGroup, $family, $groupOpt);
- my $allGroups = 1;
- # build hash of requested/excluded group names for each group family
- my $wantOrder = 0;
- foreach $groupOpt (@groupOptions) {
- $groupOpt =~ /^Group(\d*(:\d+)*)/ or next;
- $family = $1 || 0;
- $wantGroup{$family} or $wantGroup{$family} = { };
- my $groupList;
- if (ref $$options{$groupOpt} eq 'ARRAY') {
- $groupList = $$options{$groupOpt};
- } else {
- $groupList = [ $$options{$groupOpt} ];
- }
- foreach (@$groupList) {
- # groups have priority in order they were specified
- ++$wantOrder;
- my ($groupName, $want);
- if (/^-(.*)/) {
- # excluded group begins with '-'
- $groupName = $1;
- $want = 0; # we don't want tags in this group
- } else {
- $groupName = $_;
- $want = $wantOrder; # we want tags in this group
- $allGroups = 0; # don't want all groups if we requested one
- }
- $wantGroup{$family}{$groupName} = $want;
- }
- }
- # loop through all tags and decide which ones we want
- my (@tags, %bestTag);
- GR_TAG: foreach $tag (@$rtnTags) {
- my $wantTag = $allGroups; # want tag by default if want all groups
- foreach $family (keys %wantGroup) {
- my $group = $self->GetGroup($tag, $family);
- my $wanted = $wantGroup{$family}{$group};
- next unless defined $wanted;
- next GR_TAG unless $wanted; # skip tag if group excluded
- # take lowest non-zero want flag
- next if $wantTag and $wantTag < $wanted;
- $wantTag = $wanted;
- }
- next unless $wantTag;
- if ($duplicates) {
- push @tags, $tag;
- } else {
- my $tagName = GetTagName($tag);
- my $bestTag = $bestTag{$tagName};
- if (defined $bestTag) {
- next if $wantTag > $keepTags{$bestTag};
- if ($wantTag == $keepTags{$bestTag}) {
- # want two tags with the same name -- keep the latest one
- if ($tag =~ / \((\d+)\)$/) {
- my $tagNum = $1;
- next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
- }
- }
- # this tag is better, so delete old best tag
- delete $keepTags{$bestTag};
- }
- $keepTags{$tag} = $wantTag; # keep this tag (for now...)
- $bestTag{$tagName} = $tag; # this is our current best tag
- }
- }
- unless ($duplicates) {
- # construct new tag list with no duplicates, preserving order
- foreach $tag (@$rtnTags) {
- push @tags, $tag if $keepTags{$tag};
- }
- }
- $rtnTags = \@tags;
- last;
- }
- $$self{FOUND_TAGS} = $rtnTags; # save found tags
- # return reference to found tag keys (and list of indices of tags to extract by value)
- return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags;
- }
- #------------------------------------------------------------------------------
- # Utility to load our write routines if required (called via AUTOLOAD)
- # Inputs: 0) autoload function, 1-N) function arguments
- # Returns: result of function or dies if function not available
- sub DoAutoLoad(@)
- {
- my $autoload = shift;
- my @callInfo = split(/::/, $autoload);
- my $file = 'Image/ExifTool/Write';
- return if $callInfo[$#callInfo] eq 'DESTROY';
- if (@callInfo == 4) {
- # load Image/ExifTool/WriteMODULE.pl
- $file .= "$callInfo[2].pl";
- } elsif ($callInfo[-1] eq 'ShiftTime') {
- $file = 'Image/ExifTool/Shift.pl'; # load Shift.pl
- } else {
- # load Image/ExifTool/Writer.pl
- $file .= 'r.pl';
- }
- # attempt to load the package
- eval { require $file } or die "Error while attempting to call $autoload\n$@\n";
- unless (defined &$autoload) {
- my @caller = caller(0);
- # reproduce Perl's standard 'undefined subroutine' message:
- die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n";
- }
- no strict 'refs';
- return &$autoload(@_); # call the function
- }
- #------------------------------------------------------------------------------
- # AutoLoad our writer routines when necessary
- #
- sub AUTOLOAD
- {
- return DoAutoLoad($AUTOLOAD, @_);
- }
- #------------------------------------------------------------------------------
- # Add warning tag
- # Inputs: 0) ExifTool object reference, 1) warning message
- # 2) true if minor (2 if behaviour changes when warning is ignored)
- # Returns: true if warning tag was added
- sub Warn($$;$)
- {
- my ($self, $str, $ignorable) = @_;
- if ($ignorable) {
- return 0 if $$self{OPTIONS}{IgnoreMinorErrors};
- $str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str";
- }
- $self->FoundTag('Warning', $str);
- return 1;
- }
- #------------------------------------------------------------------------------
- # Add warning tag only once per processed file
- # Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor
- # Returns: true if warning tag was added
- sub WarnOnce($$;$)
- {
- my ($self, $str, $ignorable) = @_;
- return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors};
- unless ($$self{WARNED_ONCE}{$str}) {
- $self->Warn($str, $ignorable);
- $$self{WARNED_ONCE}{$str} = 1;
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # Add error tag
- # Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor
- # Returns: true if error tag was added, otherwise warning was added
- sub Error($$;$)
- {
- my ($self, $str, $ignorable) = @_;
- if ($$self{DemoteErrors}) {
- $self->Warn($str) and ++$$self{DemoteErrors};
- return 1;
- } elsif ($ignorable) {
- $$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0;
- $str = "[minor] $str";
- }
- $self->FoundTag('Error', $str);
- return 1;
- }
- #------------------------------------------------------------------------------
- # Expand shortcuts
- # Inputs: 0) reference to list of tags, 1) set to remove trailing '#'
- # Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv,
- # multiple group names, and redirected tags
- sub ExpandShortcuts($;$)
- {
- my ($tagList, $removeSuffix) = @_;
- return unless $tagList and @$tagList;
- require Image::ExifTool::Shortcuts;
- # expand shortcuts
- my $suffix = $removeSuffix ? '' : '#';
- my @expandedTags;
- my ($entry, $tag, $excl);
- foreach $entry (@$tagList) {
- # skip things like options hash references in list
- if (ref $entry) {
- push @expandedTags, $entry;
- next;
- }
- # remove leading '-'
- ($excl, $tag) = $entry =~ /^(-?)(.*)/s;
- my ($post, @post, $pre, $v);
- # handle redirection
- if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) {
- ($tag, $post) = ($1, $2);
- if ($post =~ /^[-+]?>/ or $post !~ /\$/) {
- # expand shortcuts in postfix (rhs of redirection)
- my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/);
- $p2 = '' unless defined $p2;
- $v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix
- my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main;
- if ($match) {
- foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
- /^-/ and next; # ignore excluded tags
- if ($p2 and /(.+:)(.+)/) {
- push @post, "$op$_$v";
- } else {
- push @post, "$op$p2$_$v";
- }
- }
- next unless @post;
- $post = shift @post;
- }
- }
- } else {
- $post = '';
- }
- # handle group names
- if ($tag =~ /(.+:)(.+)/) {
- ($pre, $tag) = ($1, $2);
- } else {
- $pre = '';
- }
- $v = ($tag =~ s/#$//) ? $suffix : ''; # ValueConv suffix
- # loop over all postfixes
- for (;;) {
- # expand the tag name
- my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main;
- if ($match) {
- if ($excl) {
- # entry starts with '-', so exclude all tags in this shortcut
- foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
- /^-/ and next; # ignore excluded exclude tags
- # group of expanded tag takes precedence
- if ($pre and /(.+:)(.+)/) {
- push @expandedTags, "$excl$_";
- } else {
- push @expandedTags, "$excl$pre$_";
- }
- }
- } elsif (length $pre or length $post or $v) {
- foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
- /(-?)(.+:)?(.+)/;
- if ($2) {
- # group from expanded tag takes precedence
- push @expandedTags, "$_$v$post";
- } else {
- push @expandedTags, "$1$pre$3$v$post";
- }
- }
- } else {
- push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}};
- }
- } else {
- push @expandedTags, "$excl$pre$tag$v$post";
- }
- last unless @post;
- $post = shift @post;
- }
- }
- @$tagList = @expandedTags;
- }
- #------------------------------------------------------------------------------
- # Add hash of Composite tags to our composites
- # Inputs: 0) hash reference to table of Composite tags to add or module name,
- # 1) overwrite existing tag
- sub AddCompositeTags($;$)
- {
- local $_;
- my ($add, $overwrite) = @_;
- my $module;
- unless (ref $add) {
- $module = $add;
- $add .= '::Composite';
- no strict 'refs';
- $add = \%$add;
- }
- my $defaultGroups = $$add{GROUPS};
- # MUST get the main Composite table so fetching it later doesn't override our TagID's
- # (which may be different from the table keys if there were duplicates)
- my $compTable = GetTagTable('Image::ExifTool::Composite');
- # make sure default groups are defined in families 0 and 1
- if ($defaultGroups) {
- $$defaultGroups{0} or $$defaultGroups{0} = 'Composite';
- $$defaultGroups{1} or $$defaultGroups{1} = 'Composite';
- $$defaultGroups{2} or $$defaultGroups{2} = 'Other';
- } else {
- $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
- }
- SetupTagTable($add); # generate Name, TagID, etc
- my $tagID;
- foreach $tagID (sort keys %$add) {
- next if $specialTags{$tagID}; # must skip special tags
- my $tagInfo = $$add{$tagID};
- # tagID's MUST be the exact tag name for logic in BuildCompositeTags()
- my $tag = $$tagInfo{Name};
- $$tagInfo{Module} = $module if $$tagInfo{Writable};
- # allow Composite tags with the same name
- my ($t, $n, $type);
- while ($$compTable{$tag} and not $overwrite) {
- $n ? $n += 1 : ($n = 2, $t = $tag);
- $tag = "${t}-$n";
- $$tagInfo{NewTagID} = $tag; # save new ID so we can use it in TagLookup
- }
- # convert scalar Require/Desire entries
- foreach $type ('Require','Desire') {
- my $req = $$tagInfo{$type} or next;
- $$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH';
- }
- # add this Composite tag to our main Composite table
- $$tagInfo{Table} = $compTable;
- # (use the original TagID, even if we changed it, so don't do this:)
- # $$tagInfo{TagID} = $tag;
- # save tag under NewTagID in Composite table
- $$compTable{$tag} = $tagInfo;
- # set all default groups in tag
- my $groups = $$tagInfo{Groups};
- $groups or $groups = $$tagInfo{Groups} = { };
- # fill in default groups
- foreach (keys %$defaultGroups) {
- $$groups{$_} or $$groups{$_} = $$defaultGroups{$_};
- }
- # set flag indicating group list was built
- $$tagInfo{GotGroups} = 1;
- }
- }
- #------------------------------------------------------------------------------
- # Add tags to TagLookup (used for writing)
- # Inputs: 0) source hash of tag definitions, 1) name of destination tag table
- sub AddTagsToLookup($$)
- {
- my ($tagHash, $table) = @_;
- if (defined &Image::ExifTool::TagLookup::AddTags) {
- Image::ExifTool::TagLookup::AddTags($tagHash, $table);
- } elsif (not $Image::ExifTool::pluginTags{$tagHash}) {
- # queue these tags until TagLookup is loaded
- push @Image::ExifTool::pluginTags, [ $tagHash, $table ];
- # set flag so we don't load same tags twice
- $Image::ExifTool::pluginTags{$tagHash} = 1;
- }
- }
- #------------------------------------------------------------------------------
- # Expand tagInfo Flags
- # Inputs: 0) tagInfo hash ref
- # Notes: $$tagInfo{Flags} must be defined to call this routine
- sub ExpandFlags($)
- {
- my $tagInfo = shift;
- my $flags = $$tagInfo{Flags};
- if (ref $flags eq 'ARRAY') {
- foreach (@$flags) {
- $$tagInfo{$_} = 1;
- }
- } elsif (ref $flags eq 'HASH') {
- my $key;
- foreach $key (keys %$flags) {
- $$tagInfo{$key} = $$flags{$key};
- }
- } else {
- $$tagInfo{$flags} = 1;
- }
- }
- #------------------------------------------------------------------------------
- # Set up tag table (must be done once for each tag table used)
- # Inputs: 0) Reference to tag table
- # Notes: - generates 'Name' field from key if it doesn't exist
- # - stores 'Table' pointer and 'TagID' value
- # - expands 'Flags' for quick lookup
- sub SetupTagTable($)
- {
- my $tagTablePtr = shift;
- my ($tagID, $tagInfo);
- foreach $tagID (TagTableKeys($tagTablePtr)) {
- my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
- # process conditional tagInfo arrays
- foreach $tagInfo (@infoArray) {
- $$tagInfo{Table} = $tagTablePtr;
- $$tagInfo{TagID} = $tagID;
- $$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID);
- $$tagInfo{Flags} and ExpandFlags($tagInfo);
- }
- next unless @infoArray > 1;
- # add an "Index" member to each tagInfo in a list
- my $index = 0;
- foreach $tagInfo (@infoArray) {
- $$tagInfo{Index} = $index++;
- }
- }
- }
- #------------------------------------------------------------------------------
- # Utilities to check for numerical types
- # Inputs: 0) value; Returns: true if value is a numerical type
- # Notes: May change commas to decimals in floats for use in other locales
- sub IsFloat($) {
- return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
- # allow comma separators (for other locales)
- return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/;
- $_[0] =~ tr/,/./; # but translate ',' to '.'
- return 1;
- }
- sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); }
- sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
- sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); }
- # round floating point value to specified number of significant digits
- # Inputs: 0) value, 1) number of sig digits; Returns: rounded number
- sub RoundFloat($$)
- {
- my ($val, $sig) = @_;
- return sprintf("%.${sig}g", $val);
- }
- # Convert strings to floating point numbers (or undef)
- # Inputs: 0-N) list of strings (may be undef)
- # Returns: last value converted
- sub ToFloat(@)
- {
- local $_;
- foreach (@_) {
- next unless defined $_;
- # (add 0 to convert "0.0" to "0" for tests)
- $_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef;
- }
- return $_[-1];
- }
- #------------------------------------------------------------------------------
- # Utility routines to for reading binary data values from file
- my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' );
- my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' );
- my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' );
- # the following 4 variables are defined in 'use vars' instead of using 'my'
- # because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my'
- # variables from within subroutines (ref communication with Pavel Merdin):
- # $swapBytes - set if EXIF header is not native byte ordering
- # $swapWords - swap 32-bit words in doubles (ARM quirk)
- $currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM')
- %unpackStd = %unpackMotorola;
- # Swap bytes in data if necessary
- # Inputs: 0) data, 1) number of bytes
- # Returns: swapped data
- sub SwapBytes($$)
- {
- return $_[0] unless $swapBytes;
- my ($val, $bytes) = @_;
- my $newVal = '';
- $newVal .= substr($val, $bytes, 1) while $bytes--;
- return $newVal;
- }
- # Swap words. Inputs: 8 bytes of data, Returns: swapped data
- sub SwapWords($)
- {
- return $_[0] unless $swapWords and length($_[0]) == 8;
- return substr($_[0],4,4) . substr($_[0],0,4)
- }
- # Unpack value, letting unpack() handle byte swapping
- # Inputs: 0) unpack template, 1) data reference, 2) offset
- # Returns: unpacked number
- # - uses value of %unpackStd to determine the unpack template
- # - can only be called for 'S' or 'L' templates since these are the only
- # templates for which you can specify the byte ordering.
- sub DoUnpackStd(@)
- {
- $_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]});
- return unpack($unpackStd{$_[0]}, ${$_[1]});
- }
- # same, but with reversed byte order
- sub DoUnpackRev(@)
- {
- my $fmt = $unpackRev{$unpackStd{$_[0]}};
- $_[2] and return unpack("x$_[2] $fmt", ${$_[1]});
- return unpack($fmt, ${$_[1]});
- }
- # Pack value
- # Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref)
- # Returns: packed value
- sub DoPackStd(@)
- {
- my $val = pack($unpackStd{$_[0]}, $_[1]);
- $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
- return $val;
- }
- # same, but with reversed byte order
- sub DoPackRev(@)
- {
- my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]);
- $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
- return $val;
- }
- # Unpack value, handling the byte swapping manually
- # Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset
- # Returns: unpacked number
- # - uses value of $swapBytes to determine byte ordering
- sub DoUnpack(@)
- {
- my ($bytes, $template, $dataPt, $pos) = @_;
- my $val;
- if ($swapBytes) {
- $val = '';
- $val .= substr($$dataPt,$pos+$bytes,1) while $bytes--;
- } else {
- $val = substr($$dataPt,$pos,$bytes);
- }
- defined($val) or return undef;
- return unpack($template,$val);
- }
- # Unpack double value
- # Inputs: 0) unpack template, 1) data reference, 2) offset
- # Returns: unpacked number
- sub DoUnpackDbl(@)
- {
- my ($template, $dataPt, $pos) = @_;
- my $val = substr($$dataPt,$pos,8);
- defined($val) or return undef;
- # swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value
- return unpack($template, SwapWords(SwapBytes($val, 8)));
- }
- # Inputs: 0) data reference, 1) offset into data
- sub Get8s($$) { return DoUnpackStd('c', @_); }
- sub Get8u($$) { return DoUnpackStd('C', @_); }
- sub Get16s($$) { return DoUnpack(2, 's', @_); }
- sub Get16u($$) { return DoUnpackStd('S', @_); }
- sub Get32s($$) { return DoUnpack(4, 'l', @_); }
- sub Get32u($$) { return DoUnpackStd('L', @_); }
- sub GetFloat($$) { return DoUnpack(4, 'f', @_); }
- sub GetDouble($$) { return DoUnpackDbl('d', @_); }
- sub Get16uRev($$) { return DoUnpackRev('S', @_); }
- sub Get32uRev($$) { return DoUnpackRev('L', @_); }
- # rationals may be a floating point number, 'inf' or 'undef'
- my ($ratNumer, $ratDenom);
- sub GetRational32s($$)
- {
- my ($dataPt, $pos) = @_;
- $ratNumer = Get16s($dataPt,$pos);
- $ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
- # round off to a reasonable number of significant figures
- return RoundFloat($ratNumer / $ratDenom, 7);
- }
- sub GetRational32u($$)
- {
- my ($dataPt, $pos) = @_;
- $ratNumer = Get16u($dataPt,$pos);
- $ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
- return RoundFloat($ratNumer / $ratDenom, 7);
- }
- sub GetRational64s($$)
- {
- my ($dataPt, $pos) = @_;
- $ratNumer = Get32s($dataPt,$pos);
- $ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
- return RoundFloat($ratNumer / $ratDenom, 10);
- }
- sub GetRational64u($$)
- {
- my ($dataPt, $pos) = @_;
- $ratNumer = Get32u($dataPt,$pos);
- $ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
- return RoundFloat($ratNumer / $ratDenom, 10);
- }
- sub GetFixed16s($$)
- {
- my ($dataPt, $pos) = @_;
- my $val = Get16s($dataPt, $pos) / 0x100;
- return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000;
- }
- sub GetFixed16u($$)
- {
- my ($dataPt, $pos) = @_;
- return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000;
- }
- sub GetFixed32s($$)
- {
- my ($dataPt, $pos) = @_;
- my $val = Get32s($dataPt, $pos) / 0x10000;
- # remove insignificant digits
- return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5;
- }
- sub GetFixed32u($$)
- {
- my ($dataPt, $pos) = @_;
- # remove insignificant digits
- return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5;
- }
- # Inputs: 0) value, 1) data ref, 2) offset
- sub Set8s(@) { return DoPackStd('c', @_); }
- sub Set8u(@) { return DoPackStd('C', @_); }
- sub Set16u(@) { return DoPackStd('S', @_); }
- sub Set32u(@) { return DoPackStd('L', @_); }
- sub Set16uRev(@) { return DoPackRev('S', @_); }
- #------------------------------------------------------------------------------
- # Get current byte order ('II' or 'MM')
- sub GetByteOrder() { return $currentByteOrder; }
- #------------------------------------------------------------------------------
- # Set byte ordering
- # Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian')
- # Returns: 1 on success
- sub SetByteOrder($)
- {
- my $order = shift;
- if ($order eq 'MM') { # big endian (Motorola)
- %unpackStd = %unpackMotorola;
- } elsif ($order eq 'II') { # little endian (Intel)
- %unpackStd = %unpackIntel;
- } elsif ($order =~ /^Big/i) {
- $order = 'MM';
- %unpackStd = %unpackMotorola;
- } elsif ($order =~ /^Little/i) {
- $order = 'II';
- %unpackStd = %unpackIntel;
- } else {
- return 0;
- }
- my $val = unpack('S','A ');
- my $nativeOrder;
- if ($val == 0x4120) { # big endian
- $nativeOrder = 'MM';
- } elsif ($val == 0x2041) { # little endian
- $nativeOrder = 'II';
- } else {
- warn sprintf("Unknown native byte order! (pattern %x)\n",$val);
- return 0;
- }
- $currentByteOrder = $order; # save current byte order
- # swap bytes if our native CPU byte ordering is not the same as the EXIF
- $swapBytes = ($order ne $nativeOrder);
- # little-endian ARM has big-endian words for doubles (thanks Riku Voipio)
- # (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since
- # 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?)
- my $pack1d = pack('d', 1);
- $swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or
- $pack1d eq "\0\0\xf0\x3f\0\0\0\0");
- return 1;
- }
- #------------------------------------------------------------------------------
- # Change byte order
- sub ToggleByteOrder()
- {
- SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II');
- }
- #------------------------------------------------------------------------------
- # hash lookups for reading values from data
- my %formatSize = (
- int8s => 1,
- int8u => 1,
- int16s => 2,
- int16u => 2,
- int16uRev => 2,
- int32s => 4,
- int32u => 4,
- int32uRev => 4,
- int64s => 8,
- int64u => 8,
- rational32s => 4,
- rational32u => 4,
- rational64s => 8,
- rational64u => 8,
- fixed16s => 2,
- fixed16u => 2,
- fixed32s => 4,
- fixed32u => 4,
- float => 4,
- double => 8,
- extended => 10,
- unicode => 2,
- complex => 8,
- string => 1,
- binary => 1,
- 'undef' => 1,
- ifd => 4,
- ifd64 => 8,
- );
- my %readValueProc = (
- int8s => \&Get8s,
- int8u => \&Get8u,
- int16s => \&Get16s,
- int16u => \&Get16u,
- int16uRev => \&Get16uRev,
- int32s => \&Get32s,
- int32u => \&Get32u,
- int32uRev => \&Get32uRev,
- int64s => \&Get64s,
- int64u => \&Get64u,
- rational32s => \&GetRational32s,
- rational32u => \&GetRational32u,
- rational64s => \&GetRational64s,
- rational64u => \&GetRational64u,
- fixed16s => \&GetFixed16s,
- fixed16u => \&GetFixed16u,
- fixed32s => \&GetFixed32s,
- fixed32u => \&GetFixed32u,
- float => \&GetFloat,
- double => \&GetDouble,
- extended => \&GetExtended,
- ifd => \&Get32u,
- ifd64 => \&Get64u,
- );
- # lookup for all rational types
- my %isRational = (
- rational32u => 1,
- rational32s => 1,
- rational64u => 1,
- rational64s => 1,
- );
- sub FormatSize($) { return $formatSize{$_[0]}; }
- #------------------------------------------------------------------------------
- # Read value from binary data (with current byte ordering)
- # Inputs: 0) data reference, 1) value offset, 2) format string,
- # 3) number of values (or undef to use all data)
- # 4) valid data length relative to offset, 5) optional pointer to returned rational
- # Returns: converted value, or undefined if data isn't there
- # or list of values in list context
- sub ReadValue($$$$$;$)
- {
- my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_;
- my $len = $formatSize{$format};
- unless ($len) {
- warn "Unknown format $format";
- $len = 1;
- }
- unless ($count) {
- return '' if defined $count or $size < $len;
- $count = int($size / $len);
- }
- # make sure entry is inside data
- if ($len * $count > $size) {
- $count = int($size / $len); # shorten count if necessary
- $count < 1 and return undef; # return undefined if no data
- }
- my @vals;
- my $proc = $readValueProc{$format};
- if (not $proc) {
- # handle undef/binary/string (also unsupported unicode/complex)
- $vals[0] = substr($$dataPt, $offset, $count * $len);
- # truncate string at null terminator if necessary
- $vals[0] =~ s/\0.*//s if $format eq 'string';
- } elsif ($isRational{$format} and $ratPt) {
- # store rationals separately as string fractions
- my @rat;
- for (;;) {
- push @vals, &$proc($dataPt, $offset);
- push @rat, "$ratNumer/$ratDenom";
- last if --$count <= 0;
- $offset += $len;
- }
- $$ratPt = join(' ',@rat);
- } else {
- for (;;) {
- push @vals, &$proc($dataPt, $offset);
- last if --$count <= 0;
- $offset += $len;
- }
- }
- return @vals if wantarray;
- return join(' ', @vals) if @vals > 1;
- return $vals[0];
- }
- #------------------------------------------------------------------------------
- # Decode string with specified encoding
- # Inputs: 0) ExifTool object ref, 1) string to decode
- # 2) source character set name (undef for current Charset)
- # 3) optional source byte order (2-byte and 4-byte fixed-width sets only)
- # 4) optional destination character set (defaults to Charset setting)
- # 5) optional destination byte order (2-byte and 4-byte fixed-width only)
- # Returns: string in destination encoding
- # Note: ExifTool ref may be undef if character both character sets are provided
- # (but in this case no warnings will be issued)
- sub Decode($$$;$$$)
- {
- my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_;
- $from or $from = $$self{OPTIONS}{Charset};
- $to or $to = $$self{OPTIONS}{Charset};
- if ($from ne $to and length $val) {
- require Image::ExifTool::Charset;
- my $cs1 = $Image::ExifTool::Charset::csType{$from};
- my $cs2 = $Image::ExifTool::Charset::csType{$to};
- if ($cs1 and $cs2 and not $cs2 & 0x002) {
- # treat as straight ASCII if no character will need remapping
- if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) {
- my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder);
- $val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder);
- }
- } elsif ($self) {
- my $set = $cs1 ? $to : $from;
- unless ($$self{"DecodeWarn$set"}) {
- $self->Warn("Unsupported character set ($set)");
- $$self{"DecodeWarn$set"} = 1;
- }
- }
- }
- return $val;
- }
- #------------------------------------------------------------------------------
- # Encode string with specified encoding
- # Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name,
- # 3) optional destination byte order (2-byte and 4-byte fixed-width sets only)
- # Returns: string in specified encoding
- sub Encode($$$;$)
- {
- my ($self, $val, $to, $toOrder) = @_;
- return $self->Decode($val, undef, undef, $to, $toOrder);
- }
- #------------------------------------------------------------------------------
- # Decode bit mask
- # Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef)
- # 2) optional bits per word (defaults to 32)
- sub DecodeBits($$;$)
- {
- my ($vals, $lookup, $bits) = @_;
- $bits or $bits = 32;
- my ($val, $i, @bitList);
- my $num = 0;
- foreach $val (split ' ', $vals) {
- for ($i=0; $i<$bits; ++$i) {
- next unless $val & (1 << $i);
- my $n = $i + $num;
- if (not $lookup) {
- push @bitList, $n;
- } elsif ($$lookup{$n}) {
- push @bitList, $$lookup{$n};
- } else {
- push @bitList, "[$n]";
- }
- }
- $num += $bits;
- }
- return '(none)' unless @bitList;
- return join($lookup ? ', ' : ',', @bitList);
- }
- #------------------------------------------------------------------------------
- # Validate an extracted image and repair if necessary
- # Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key
- # Returns: image reference or undef if it wasn't valid
- # Note: should be called from RawConv, not ValueConv
- sub ValidateImage($$$)
- {
- my ($self, $imagePt, $tag) = @_;
- return undef if $$imagePt eq 'none';
- unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or
- # the first byte of the preview of some Minolta cameras is wrong,
- # so check for this and set it back to 0xff if necessary
- $$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or
- $self->Options('IgnoreMinorErrors'))
- {
- # issue warning only if the tag was specifically requested
- if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {
- $self->Warn("$tag is not a valid JPEG image",1);
- return undef;
- }
- }
- return $imagePt;
- }
- #------------------------------------------------------------------------------
- # Validate a tag name argument (including group name and wildcards, etc)
- # Inputs: 0) tag name
- # Returns: true if tag name is valid
- # - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9]
- # - tag names may contain wildcards [?*], and end with a hash [#]
- # - may have group name prefixes (which may have family number prefix), separated by colons
- # - a group name may be zero or more characters
- sub ValidTagName($)
- {
- my $tag = shift;
- return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/;
- }
- #------------------------------------------------------------------------------
- # Generate a valid tag name based on the tag ID or name
- # Inputs: 0) tag ID or name
- # Returns: valid tag name
- sub MakeTagName($)
- {
- my $name = shift;
- $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
- $name = ucfirst $name; # capitalize first letter
- $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
- return $name;
- }
- #------------------------------------------------------------------------------
- # Make description from a tag name
- # Inputs: 0) tag name 1) optional tagID to add at end of description
- # Returns: description
- sub MakeDescription($;$)
- {
- my ($tag, $tagID) = @_;
- # start with the tag name and force first letter to be upper case
- my $desc = ucfirst($tag);
- # translate underlines to spaces
- $desc =~ tr/_/ /;
- # remove hex TagID from name (to avoid inserting spaces in the number)
- $desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID;
- # put a space between lower/UPPER case and lower/number combinations
- $desc =~ s/([a-z])([A-Z\d])/$1 $2/g;
- # put a space between acronyms and words
- $desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g;
- # put spaces after numbers (if more than one character follows the number)
- $desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
- # add TagID to description
- $desc .= ' ' . $tagID if defined $tagID;
- return $desc;
- }
- #------------------------------------------------------------------------------
- # Get descriptions for all tags in an array
- # Inputs: 0) ExifTool ref, 1) reference to list of tag keys
- # Returns: reference to hash lookup for descriptions
- # Note: Returned descriptions are NOT escaped by ESCAPE_PROC
- sub GetDescriptions($$)
- {
- local $_;
- my ($self, $tags) = @_;
- my %desc;
- my $oldEscape = $$self{ESCAPE_PROC};
- delete $$self{ESCAPE_PROC};
- $desc{$_} = $self->GetDescription($_) foreach @$tags;
- $$self{ESCAPE_PROC} = $oldEscape;
- return \%desc;
- }
- #------------------------------------------------------------------------------
- # Apply filter to value(s) if necessary
- # Inputs: 0) ExifTool ref, 1-N) references to values(s) to filter
- # Returns: nothing, but changes values if necessary
- sub Filter($@)
- {
- local $_;
- my $self = shift;
- return unless defined $$self{OPTIONS}{Filter};
- while (@_) {
- my $valPt = shift;
- next unless defined $$valPt;
- if (not ref $$valPt) {
- $_ = $$valPt;
- #### eval Filter ($_)
- eval $$self{OPTIONS}{Filter};
- $$valPt = $_;
- } elsif (ref $$valPt eq 'SCALAR') {
- my $val = $$$valPt; # make a copy to avoid filtering twice
- $self->Filter(\$val);
- $$valPt = \$val;
- } elsif (ref $$valPt eq 'ARRAY') {
- my @val = @{$$valPt}; # make a copy to avoid filtering twice
- $self->Filter(\$_) foreach @val;
- $$valPt = \@val;
- } elsif (ref $$valPt eq 'HASH') {
- my %val = %{$$valPt}; # make a copy to avoid filtering twice
- $self->Filter(\$val{$_}) foreach keys %val;
- $$valPt = \%val;
- }
- }
- }
- #------------------------------------------------------------------------------
- # Return printable value
- # Inputs: 0) ExifTool object reference
- # 1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited)
- sub Printable($;$)
- {
- my ($self, $outStr, $maxLen) = @_;
- return '(undef)' unless defined $outStr;
- $outStr =~ tr/\x01-\x1f\x7f-\xff/./;
- $outStr =~ s/\x00//g;
- my $verbose = $$self{OPTIONS}{Verbose};
- if ($verbose < 4) {
- if ($maxLen) {
- $maxLen = 20 if $maxLen < 20; # minimum length is 20
- } elsif (defined $maxLen) {
- $maxLen = length $outStr; # 0 is unlimited
- } else {
- $maxLen = 60; # default maximum is 60
- }
- } else {
- $maxLen = length $outStr;
- # limit to 2048 characters if verbose < 5
- $maxLen = 2048 if $maxLen > 2048 and $verbose < 5;
- }
- # limit length if necessary
- $outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen;
- return $outStr;
- }
- #------------------------------------------------------------------------------
- # Convert date/time from Exif format
- # Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format
- # Returns: Formatted date/time string
- sub ConvertDateTime($$)
- {
- my ($self, $date) = @_;
- my $fmt = $$self{OPTIONS}{DateFormat};
- my $shift = $$self{OPTIONS}{GlobalTimeShift};
- if ($shift) {
- my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1;
- my $offset = $$self{GLOBAL_TIME_OFFSET};
- $offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { };
- ShiftTime($date, $shift, $dir, $offset);
- }
- # only convert date if a format was specified and the date is recognizable
- if ($fmt) {
- # separate time zone if it exists
- my $tz;
- $date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1;
- # a few cameras use incorrect date/time formatting:
- # - slashes instead of colons in date (RolleiD330, ImpressCam)
- # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar)
- # - single-digit seconds with leading space (HP scanners)
- my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format
- if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) {
- shift @a while @a > 6; # remove superfluous entries
- unshift @a, 1 while @a < 3; # add month and day if necessary
- unshift @a, 0 while @a < 6; # add h,m,s if necessary
- $a[5] -= 1900; # base year is 1900
- $a[4] -= 1; # base month is 1
- # parse %z and %s ourself (to handle time zones properly)
- if ($fmt =~ /%[sz]/) {
- # use system time zone unless otherwise specified
- $tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local };
- # remove colon, setting to UTC if time zone is not numeric
- $tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000';
- $fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes
- if ($fmt =~ /%s/ and eval { require Time::Local }) {
- # calculate seconds since the Epoch, UTC
- my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40);
- $fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes
- }
- }
- $date = POSIX::strftime($fmt, @a); # generate the formatted date/time
- } elsif ($$self{OPTIONS}{StrictDate}) {
- undef $date;
- }
- }
- return $date;
- }
- #------------------------------------------------------------------------------
- # Print conversion for time span value
- # Inputs: 0) time ticks, 1) number of seconds per tick (default 1)
- # Returns: readable time
- sub ConvertTimeSpan($;$)
- {
- my ($val, $mult) = @_;
- if (Image::ExifTool::IsFloat($val) and $val != 0) {
- $val *= $mult if $mult;
- if ($val < 60) {
- $val = "$val seconds";
- } elsif ($val < 3600) {
- my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f';
- my $s = ($val == 60 and $mult) ? '' : 's';
- $val = sprintf("$fmt minute$s", $val / 60);
- } elsif ($val < 24 * 3600) {
- $val = sprintf("%.1f hours", $val / 3600);
- } else {
- $val = sprintf("%.1f days", $val / (24 * 3600));
- }
- }
- return $val;
- }
- #------------------------------------------------------------------------------
- # Patched timelocal() that fixes ActivePerl timezone bug
- # Inputs/Returns: same as timelocal()
- # Notes: must 'require Time::Local' before calling this routine
- sub TimeLocal(@)
- {
- my $tm = Time::Local::timelocal(@_);
- if ($^O eq 'MSWin32') {
- # patch for ActivePerl timezone bug
- my @t2 = localtime($tm);
- my $t2 = Time::Local::timelocal(@t2);
- # adjust timelocal() return value to be consistent with localtime()
- $tm += $tm - $t2;
- }
- return $tm;
- }
- #------------------------------------------------------------------------------
- # Get time zone in minutes
- # Inputs: 0) localtime array ref, 1) gmtime array ref
- # Returns: time zone offset in minutes
- sub GetTimeZone($$)
- {
- my ($tm, $gm) = @_;
- # compute the number of minutes between localtime and gmtime
- my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]);
- if ($$tm[3] != $$gm[3]) {
- # account for case where one date wraps to the first of the next month
- $$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1;
- # adjust for the +/- one day difference
- $min += ($$tm[3] - $$gm[3]) * 24 * 60;
- }
- # MirBSD patch to round to the nearest 30 minutes because
- # it includes leap seconds in localtime but not gmtime
- $min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd';
- return $min;
- }
- #------------------------------------------------------------------------------
- # Get time zone string
- # Inputs: 0) time zone offset in minutes
- # or 0) localtime array ref, 1) corresponding time value
- # Returns: time zone string ("+/-HH:MM")
- sub TimeZoneString($;$)
- {
- my $min = shift;
- if (ref $min) {
- my @gm = gmtime(shift);
- $min = GetTimeZone($min, \@gm);
- }
- my $sign = '+';
- $min < 0 and $sign = '-', $min = -$min;
- my $h = int($min / 60);
- return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60);
- }
- #------------------------------------------------------------------------------
- # Convert Unix time to EXIF date/time string
- # Inputs: 0) Unix time value, 1) non-zero to convert to local time
- # Returns: EXIF date/time string (with timezone for local times)
- # Notes: fractional seconds are ignored
- sub ConvertUnixTime($;$)
- {
- my ($time, $toLocal) = @_;
- return '0000:00:00 00:00:00' if $time == 0;
- $time = int($time + 1e-6) if $time != int($time); # avoid round-off errors
- my (@tm, $tz);
- if ($toLocal) {
- @tm = localtime($time);
- $tz = TimeZoneString(\@tm, $time);
- } else {
- @tm = gmtime($time);
- $tz = '';
- }
- my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s",
- $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz);
- return $str;
- }
- #------------------------------------------------------------------------------
- # Get Unix time from EXIF-formatted date/time string with optional timezone
- # Inputs: 0) EXIF date/time string, 1) non-zero if time is local
- # Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error
- sub GetUnixTime($;$)
- {
- my ($timeStr, $isLocal) = @_;
- return 0 if $timeStr eq '0000:00:00 00:00:00';
- my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
- return undef unless @tm == 6 and eval { require Time::Local };
- my $tzsec = 0;
- # use specified timezone offset (if given) instead of local system time
- # if we are converting a local time value
- if ($isLocal and $timeStr =~ /(?:Z|([-+])(\d+):(\d+))$/i) {
- # use specified timezone if one exists
- $tzsec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1;
- undef $isLocal; # convert using GMT corrected for specified timezone
- }
- $tm[0] -= 1900; # convert year
- $tm[1] -= 1; # convert month
- @tm = reverse @tm; # change to order required by timelocal()
- return $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzsec;
- }
- #------------------------------------------------------------------------------
- # Print conversion for file size
- # Inputs: 0) file size in bytes
- # Returns: converted file size
- sub ConvertFileSize($)
- {
- my $val = shift;
- $val < 2048 and return "$val bytes";
- $val < 10240 and return sprintf('%.1f kB', $val / 1024);
- $val < 2097152 and return sprintf('%.0f kB', $val / 1024);
- $val < 10485760 and return sprintf('%.1f MB', $val / 1048576);
- return sprintf('%.0f MB', $val / 1048576);
- }
- #------------------------------------------------------------------------------
- # Convert seconds to duration string (handles negative durations)
- # Inputs: 0) floating point seconds
- # Returns: duration string in form "S.SS s", "MM:SS" or "H:MM:SS"
- sub ConvertDuration($)
- {
- my $time = shift;
- return $time unless IsFloat($time);
- return '0 s' if $time == 0;
- my $sign = ($time > 0 ? '' : (($time = -$time), '-'));
- return sprintf("$sign%.2f s", $time) if $time < 30;
- my $h = int($time / 3600);
- $time -= $h * 3600;
- my $m = int($time / 60);
- $time -= $m * 60;
- if ($h > 24) {
- my $d = int($h / 24);
- $h -= $d * 24;
- $sign = "$sign$d days ";
- }
- return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time));
- }
- #------------------------------------------------------------------------------
- # Print conversion for bitrate values
- # Inputs: 0) bitrate in bits per second
- # Returns: human-readable bitrate string
- # Notes: returns input value without formatting if it isn't numerical
- sub ConvertBitrate($)
- {
- my $bitrate = shift;
- IsFloat($bitrate) or return $bitrate;
- my @units = ('bps', 'kbps', 'Mbps', 'Gbps');
- for (;;) {
- my $units = shift @units;
- $bitrate >= 1000 and @units and $bitrate /= 1000, next;
- my $fmt = $bitrate < 100 ? '%.3g' : '%.0f';
- return sprintf("$fmt $units", $bitrate);
- }
- }
- #------------------------------------------------------------------------------
- # Convert file name for printing
- # Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set
- # Returns: converted file name in external character set
- sub ConvertFileName($$)
- {
- my ($self, $val) = @_;
- my $enc = $$self{OPTIONS}{CharsetFileName};
- $val = $self->Decode($val, $enc) if $enc;
- return $val;
- }
- #------------------------------------------------------------------------------
- # Inverse conversion for file name (encode
- # Inputs: 0) ExifTool ref, 1) file name in external character set
- # Returns: file name in CharsetFileName character set
- sub InverseFileName($$)
- {
- my ($self, $val) = @_;
- my $enc = $$self{OPTIONS}{CharsetFileName};
- $val = $self->Encode($val, $enc) if $enc;
- $val =~ tr/\\/\//; # make sure we are using forward slashes
- return $val;
- }
- #------------------------------------------------------------------------------
- # Save information for HTML dump
- # Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size
- # 3) comment string, 4) tool tip (or SAME), 5) flags
- sub HDump($$$$;$$)
- {
- my $self = shift;
- if ($$self{HTML_DUMP}) {
- my $pos = shift;
- $pos += $$self{BASE} if $$self{BASE};
- $$self{HTML_DUMP}->Add($pos, @_);
- }
- }
- #------------------------------------------------------------------------------
- # Identify trailer ending at specified offset from end of file
- # Inputs: 0) RAF reference, 1) offset from end of file (0 by default)
- # Returns: Trailer info hash (with RAF and DirName set),
- # or undef if no recognized trailer was found
- # Notes: leaves file position unchanged
- sub IdentifyTrailer($;$)
- {
- my $raf = shift;
- my $offset = shift || 0;
- my $pos = $raf->Tell();
- my ($buff, $type, $len);
- while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) {
- # read up to 64 bytes before specified offset from end of file
- $len = 64 if $len > 64;
- $raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last;
- if ($buff =~ /AXS(!|\*).{8}$/s) {
- $type = 'AFCP';
- } elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) {
- $type = 'FotoStation';
- } elsif ($buff =~ /cbipcbbl$/) {
- $type = 'PhotoMechanic';
- } elsif ($buff =~ /^CANON OPTIONAL DATA\0/) {
- $type = 'CanonVRD';
- } elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
- $buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s)
- {
- $type = 'MIE';
- } elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) {
- $type = 'Samsung';
- }
- last;
- }
- $raf->Seek($pos, 0); # restore original file position
- return $type ? { RAF => $raf, DirName => $type } : undef;
- }
- #------------------------------------------------------------------------------
- # Read/rewrite trailer information (including multiple trailers)
- # Inputs: 0) ExifTool object ref, 1) DirInfo ref:
- # - requires RAF and DirName
- # - OutFile is a scalar reference for writing
- # - scans from current file position if ScanForAFCP is set
- # Returns: 1 if trailer was processed or couldn't be processed (or written OK)
- # 0 if trailer was recognized but offsets need fixing (or write error)
- # - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated
- # - preserves current file position and byte order
- sub ProcessTrailers($$)
- {
- my ($self, $dirInfo) = @_;
- my $dirName = $$dirInfo{DirName};
- my $outfile = $$dirInfo{OutFile};
- my $offset = $$dirInfo{Offset} || 0;
- my $fixup = $$dirInfo{Fixup};
- my $raf = $$dirInfo{RAF};
- my $pos = $raf->Tell();
- my $byteOrder = GetByteOrder();
- my $success = 1;
- my $path = $$self{PATH};
- for (;;) { # loop through all trailers
- require "Image/ExifTool/$dirName.pm";
- my $proc = "Image::ExifTool::${dirName}::Process$dirName";
- my $outBuff;
- if ($outfile) {
- # write to local buffer so we can add trailer in proper order later
- $$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = '';
- # must generate new fixup if necessary so we can shift
- # the old fixup separately after we prepend this trailer
- delete $$dirInfo{Fixup};
- }
- delete $$dirInfo{DirLen}; # reset trailer length
- $$dirInfo{Offset} = $offset; # set offset from end of file
- $$dirInfo{Trailer} = 1; # set Trailer flag in case proc cares
- # add trailer and DirName to SubDirectory PATH
- push @$path, 'Trailer', $dirName;
- # read or write this trailer
- # (proc takes Offset as offset from end of trailer to end of file,
- # and returns DataPos and DirLen, and Fixup if applicable)
- no strict 'refs';
- my $result = &$proc($self, $dirInfo);
- use strict 'refs';
- # restore PATH (pop last 2 items)
- splice @$path, -2;
- # check result
- if ($outfile) {
- if ($result > 0) {
- if ($outBuff) {
- # write trailers to OutFile in original order
- $$outfile = $outBuff . $$outfile;
- # must adjust old fixup start if it exists
- $$fixup{Start} += length($outBuff) if $fixup;
- $outBuff = ''; # free memory
- }
- if ($$dirInfo{Fixup}) {
- if ($fixup) {
- # add fixup for subsequent trailers to the fixup for this trailer
- # (but first we must adjust for the new start position)
- $$fixup{Shift} += $$dirInfo{Fixup}{Start};
- $$fixup{Start} -= $$dirInfo{Fixup}{Start};
- $$dirInfo{Fixup}->AddFixup($fixup);
- }
- $fixup = $$dirInfo{Fixup}; # save fixup
- }
- } else {
- $success = 0 if $self->Error("Error rewriting $dirName trailer", 2);
- last;
- }
- } elsif ($result < 0) {
- # can't continue if we must scan for this trailer
- $success = 0;
- last;
- }
- last unless $result > 0 and $$dirInfo{DirLen};
- # look for next trailer
- $offset += $$dirInfo{DirLen};
- my $nextTrail = IdentifyTrailer($raf, $offset) or last;
- $dirName = $$dirInfo{DirName} = $$nextTrail{DirName};
- $raf->Seek($pos, 0);
- }
- SetByteOrder($byteOrder); # restore original byte order
- $raf->Seek($pos, 0); # restore original file position
- $$dirInfo{OutFile} = $outfile; # restore original outfile
- $$dirInfo{Offset} = $offset; # return offset from EOF to start of first trailer
- $$dirInfo{Fixup} = $fixup; # return fixup information
- return $success;
- }
- #------------------------------------------------------------------------------
- # JPEG constants
- # JPEG marker names
- %jpegMarker = (
- 0x00 => 'NULL',
- 0x01 => 'TEM',
- 0xc0 => 'SOF0', # to SOF15, with a few exceptions below
- 0xc4 => 'DHT',
- 0xc8 => 'JPGA',
- 0xcc => 'DAC',
- 0xd0 => 'RST0',
- 0xd8 => 'SOI',
- 0xd9 => 'EOI',
- 0xda => 'SOS',
- 0xdb => 'DQT',
- 0xdc => 'DNL',
- 0xdd => 'DRI',
- 0xde => 'DHP',
- 0xdf => 'EXP',
- 0xe0 => 'APP0', # to APP15
- 0xf0 => 'JPG0',
- 0xfe => 'COM',
- );
- # lookup for size of JPEG marker length word
- # (2 bytes assumed unless specified here)
- my %markerLenBytes = (
- 0x00 => 0, 0x01 => 0,
- 0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0,
- 0xd8 => 0, 0xd9 => 0, 0xda => 0,
- # J2C
- 0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0,
- 0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0,
- 0x4f => 0,
- 0x92 => 0, 0x93 => 0,
- # J2C extensions
- 0x74 => 4, 0x75 => 4, 0x77 => 4,
- );
- #------------------------------------------------------------------------------
- # Get JPEG marker name
- # Inputs: 0) Jpeg number
- # Returns: marker name
- sub JpegMarkerName($)
- {
- my $marker = shift;
- my $markerName = $jpegMarker{$marker};
- unless ($markerName) {
- $markerName = $jpegMarker{$marker & 0xf0};
- if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
- $markerName = $1 . ($marker & 0x0f);
- } else {
- $markerName = sprintf("marker 0x%.2x", $marker);
- }
- }
- return $markerName;
- }
- #------------------------------------------------------------------------------
- # Adjust directory start position
- # Inputs: 0) dirInfo ref, 1) start offset
- # 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0)
- sub DirStart($$;$)
- {
- my ($dirInfo, $start, $base) = @_;
- $$dirInfo{DirStart} = $start;
- $$dirInfo{DirLen} -= $start;
- if (defined $base) {
- $$dirInfo{Base} = $$dirInfo{DataPos} + $base;
- $$dirInfo{DataPos} = -$base; # (relative to Base!)
- }
- }
- #------------------------------------------------------------------------------
- # Extract metadata from a jpg image
- # Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
- # Returns: 1 on success, 0 if this wasn't a valid JPEG file
- sub ProcessJPEG($$)
- {
- local $_;
- my ($self, $dirInfo) = @_;
- my ($ch, $s, $length);
- my $verbose = $$self{OPTIONS}{Verbose};
- my $out = $$self{OPTIONS}{TextOut};
- my $fast = $$self{OPTIONS}{FastScan};
- my $raf = $$dirInfo{RAF};
- my $htmlDump = $$self{HTML_DUMP};
- my %dumpParms = ( Out => $out );
- my ($success, $wantTrailer, $trailInfo, $type);
- my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal);
- my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP);
- # check to be sure this is a valid JPG (or J2C, or EXV) file
- return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/;
- if ($s eq "\xff\x01") {
- return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2';
- $type = 'EXV';
- }
- if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$self{OPTIONS}{ExtractEmbedded})) {
- $self->SetFileType($type); # set FileType tag
- return 1 if $fast and $fast == 3; # don't process file when FastScan == 3
- $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags
- }
- $dumpParms{MaxLen} = 128 if $verbose < 4;
- if ($htmlDump) {
- $dumpEnd = $raf->Tell();
- my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI');
- my $pos = $dumpEnd - $n;
- $self->HDump(0, $pos, '[unknown header]') if $pos;
- $self->HDump($pos, $n, "$t header", "$m Marker");
- }
- my $path = $$self{PATH};
- my $pn = scalar @$path;
- # set input record separator to 0xff (the JPEG marker) to make reading quicker
- local $/ = "\xff";
- my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData);
- # read file until we reach an end of image (EOI) or start of scan (SOS)
- Marker: for (;;) {
- # set marker and data pointer for current segment
- my $marker = $nextMarker;
- my $segDataPt = $nextSegDataPt;
- my $segPos = $nextSegPos;
- undef $nextMarker;
- undef $nextSegDataPt;
- #
- # read ahead to the next segment unless we have reached EOI, SOS or SOD
- #
- unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) {
- # read up to next marker (JPEG markers begin with 0xff)
- my $buff;
- $raf->ReadLine($buff) or last;
- # JPEG markers can be padded with unlimited 0xff's
- for (;;) {
- $raf->Read($ch, 1) or last Marker;
- $nextMarker = ord($ch);
- last unless $nextMarker == 0xff;
- }
- # read segment data if it exists
- if (not defined $markerLenBytes{$nextMarker}) {
- # read record length word
- last unless $raf->Read($s, 2) == 2;
- my $len = unpack('n',$s); # get data length
- last unless defined($len) and $len >= 2;
- $nextSegPos = $raf->Tell();
- $len -= 2; # subtract size of length word
- last unless $raf->Read($buff, $len) == $len;
- $nextSegDataPt = \$buff; # set pointer to our next data
- } elsif ($markerLenBytes{$nextMarker} == 4) {
- # handle J2C extensions with 4-byte length word
- last unless $raf->Read($s, 4) == 4;
- my $len = unpack('N',$s); # get data length
- last unless defined($len) and $len >= 4;
- $nextSegPos = $raf->Tell();
- $len -= 4; # subtract size of length word
- last unless $raf->Seek($len, 1);
- }
- # read second segment too if this was the first
- next unless defined $marker;
- }
- # set some useful variables for the current segment
- my $markerName = JpegMarkerName($marker);
- $$path[$pn] = $markerName;
- #
- # parse the current segment
- #
- # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
- if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
- $length = length $$segDataPt;
- if ($verbose) {
- print $out "JPEG $markerName ($length bytes):\n";
- HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2;
- } elsif ($htmlDump) {
- $self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08);
- $dumpEnd = $segPos + $length;
- }
- next unless $length >= 6;
- # extract some useful information
- my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt);
- my $sof = GetTagTable('Image::ExifTool::JPEG::SOF');
- $self->HandleTag($sof, 'ImageWidth', $w);
- $self->HandleTag($sof, 'ImageHeight', $h);
- $self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0);
- $self->HandleTag($sof, 'BitsPerSample', $p);
- $self->HandleTag($sof, 'ColorComponents', $n);
- next unless $n == 3 and $length >= 15;
- my ($i, $hmin, $hmax, $vmin, $vmax);
- # loop through all components to determine sampling frequency
- $subSampling = '';
- for ($i=0; $i<$n; ++$i) {
- my $sf = Get8u($segDataPt, 7 + 3 * $i);
- $subSampling .= sprintf('%.2x', $sf);
- # isolate horizontal and vertical components
- my ($hf, $vf) = ($sf >> 4, $sf & 0x0f);
- unless ($i) {
- $hmin = $hmax = $hf;
- $vmin = $vmax = $vf;
- next;
- }
- # determine min/max frequencies
- $hmin = $hf if $hf < $hmin;
- $hmax = $hf if $hf > $hmax;
- $vmin = $vf if $vf < $vmin;
- $vmax = $vf if $vf > $vmax;
- }
- if ($hmin and $vmin) {
- my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin);
- $self->FoundTag($$sof{YCbCrSubSampling}, "$hs $vs");
- }
- next;
- } elsif ($marker == 0xd9) { # EOI
- pop @$path;
- $verbose and print $out "JPEG EOI\n";
- my $pos = $raf->Tell();
- if ($htmlDump and $dumpEnd) {
- $self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
- $self->HDump($pos-2, 2, 'JPEG EOI', undef);
- $dumpEnd = 0;
- }
- $success = 1;
- # we are here because we are looking for trailer information
- if ($wantTrailer) {
- my $start = $$self{PreviewImageStart};
- if ($start) {
- my $buff;
- # most previews start right after the JPEG EOI, but the Olympus E-20
- # preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is
- # 979 bytes in, and Sony previews can start up to 32 kB into the trailer.
- # (and Minolta and Sony previews can have a random first byte...)
- my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024;
- if ($raf->Read($buff, $scanLen) and ($buff =~ /\xff\xd8\xff./g or
- ($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)))
- {
- # adjust PreviewImageStart to this location
- my $actual = $pos + pos($buff) - 4;
- if ($start ne $actual and $verbose > 1) {
- print $out "(Fixed PreviewImage location: $start -> $actual)\n";
- }
- # update preview image offsets
- $$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart};
- $$self{PreviewImageStart} = $actual;
- # load preview now if we tried and failed earlier
- if ($$self{PreviewError} and $$self{PreviewImageLength}) {
- if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) {
- $self->FoundTag('PreviewImage', $buff);
- delete $$self{PreviewError};
- }
- }
- }
- $raf->Seek($pos, 0);
- }
- }
- # process trailer now or finish processing trailers
- # and scan for AFCP if necessary
- my $fromEnd = 0;
- if ($trailInfo) {
- $$trailInfo{ScanForAFCP} = 1; # scan now if necessary
- $self->ProcessTrailers($trailInfo);
- # save offset from end of file to start of first trailer
- $fromEnd = $$trailInfo{Offset};
- undef $trailInfo;
- }
- if ($$self{LeicaTrailer}) {
- $raf->Seek(0, 2);
- $$self{LeicaTrailer}{TrailPos} = $pos;
- $$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd;
- Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
- }
- # finally, dump remaining information in JPEG trailer
- if ($verbose or $htmlDump) {
- my $endPos = $$self{LeicaTrailerPos};
- unless ($endPos) {
- $raf->Seek(0, 2);
- $endPos = $raf->Tell() - $fromEnd;
- }
- $self->DumpUnknownTrailer({
- RAF => $raf,
- DataPos => $pos,
- DirLen => $endPos - $pos
- }) if $endPos > $pos;
- }
- last; # all done parsing file
- } elsif ($marker == 0xda) { # SOS
- pop @$path;
- # all done with meta information unless we have a trailer
- $verbose and print $out "JPEG SOS\n";
- unless ($fast) {
- $trailInfo = IdentifyTrailer($raf);
- # process trailer now unless we are doing verbose dump
- if ($trailInfo and $verbose < 3 and not $htmlDump) {
- # process trailers (keep trailInfo to finish processing later
- # only if we can't finish without scanning from end of file)
- $self->ProcessTrailers($trailInfo) and undef $trailInfo;
- }
- if ($wantTrailer) {
- # seek ahead and validate preview image
- my $buff;
- my $curPos = $raf->Tell();
- if ($raf->Seek($$self{PreviewImageStart}, 0) and
- $raf->Read($buff, 4) == 4 and
- $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/)
- {
- undef $wantTrailer;
- }
- $raf->Seek($curPos, 0) or last;
- }
- # seek ahead and process Leica trailer
- if ($$self{LeicaTrailer}) {
- require Image::ExifTool::Panasonic;
- Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
- $wantTrailer = 1 if $$self{LeicaTrailer};
- }
- next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump;
- }
- # nothing interesting to parse after start of scan (SOS)
- $success = 1;
- last; # all done parsing file
- } elsif ($marker == 0x93) {
- pop @$path;
- $verbose and print $out "JPEG SOD\n";
- $success = 1;
- next if $verbose > 2 or $htmlDump;
- last; # all done parsing file
- } elsif (defined $markerLenBytes{$marker}) {
- # handle other stand-alone markers and segments we skipped over
- $verbose and $marker and print $out "JPEG $markerName\n";
- next;
- } elsif ($marker == 0xdb and length($$segDataPt) and # DQT
- # save the DQT data only if JPEGDigest has been requested
- # (Note: this will not work with the application -p option
- # because we aren't checking the RequestAll API option here.
- # The reason is that there is too much overhead involved in
- # the calculation of this tag to make this worth the CPU time.)
- ($$self{REQ_TAG_LOOKUP}{jpegdigest} or $$self{REQ_TAG_LOOKUP}{jpegqualityestimate}))
- {
- my $num = unpack('C',$$segDataPt) & 0x0f; # get table index
- $dqt[$num] = $$segDataPt if $num < 4; # save for MD5 calculation
- }
- # handle all other markers
- my $dumpType = '';
- my ($desc, $tip);
- $length = length $$segDataPt;
- if ($verbose) {
- print $out "JPEG $markerName ($length bytes):\n";
- if ($verbose > 2) {
- my %extraParms = ( Addr => $segPos );
- $extraParms{MaxLen} = 128 if $verbose == 4;
- HexDump($segDataPt, undef, %dumpParms, %extraParms);
- }
- }
- # prepare dirInfo hash for processing this information
- my %dirInfo = (
- Parent => $markerName,
- DataPt => $segDataPt,
- DataPos => $segPos,
- DataLen => $length,
- DirStart => 0,
- DirLen => $length,
- Base => 0,
- );
- if ($marker == 0xe0) { # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad)
- if ($$segDataPt =~ /^JFIF\0/) {
- $dumpType = 'JFIF';
- DirStart(\%dirInfo, 5); # start at byte 5
- SetByteOrder('MM');
- my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^JFXX\0\x10/) {
- $dumpType = 'JFXX';
- my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension');
- my $tagInfo = $self->GetTagInfo($tagTablePtr, 0x10);
- $self->FoundTag($tagInfo, substr($$segDataPt, 6));
- } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
- next if $fast and $fast > 1; # skip processing for very fast
- $dumpType = 'CIFF';
- my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) );
- $$self{SET_GROUP1} = 'CIFF';
- push @{$$self{PATH}}, 'CIFF';
- require Image::ExifTool::CanonRaw;
- Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
- pop @{$$self{PATH}};
- delete $$self{SET_GROUP1};
- } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) {
- $dumpType = $1;
- SetByteOrder('MM');
- my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType");
- DirStart(\%dirInfo, 4);
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI)
- # (some Kodak cameras don't put a second "\0", and I have seen an
- # example where there was a second 4-byte APP1 segment header)
- if ($$segDataPt =~ /^(.{0,4})Exif\0/is) {
- undef $dumpType; # (will be dumped here)
- # this is EXIF data --
- # get the data block (into a common variable)
- my $hdrLen = length($exifAPP1hdr);
- if (length $1) {
- $hdrLen += length $1;
- $self->Warn('Unknown garbage at start of EXIF segment',1);
- } elsif ($$segDataPt !~ /^Exif\0/) {
- $self->Warn('Incorrect EXIF segment identifier',1);
- }
- DirStart(\%dirInfo, $hdrLen, $hdrLen);
- if ($htmlDump) {
- $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes");
- $self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif');
- $dumpEnd = $segPos + $length;
- }
- # extract the EXIF information (it is in standard TIFF format)
- $self->ProcessTIFF(\%dirInfo);
- # avoid looking for preview unless necessary because it really slows
- # us down -- only look for it if we found pointer, and preview is
- # outside EXIF, and PreviewImage is specifically requested
- my $start = $self->GetValue('PreviewImageStart', 'ValueConv');
- my $plen = $self->GetValue('PreviewImageLength', 'ValueConv');
- if (not $start or not $plen and $$self{PreviewError}) {
- $start = $$self{PreviewImageStart};
- $plen = $$self{PreviewImageLength};
- }
- if ($start and $plen and IsInt($start) and IsInt($plen) and
- $start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and
- ($$self{REQ_TAG_LOOKUP}{previewimage} or
- # (extracted normally, so check Binary option)
- ($$self{OPTIONS}{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage})))
- {
- $$self{PreviewImageStart} = $start;
- $$self{PreviewImageLength} = $plen;
- $wantTrailer = 1;
- }
- } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
- # off len -- extended XMP header (75 bytes total):
- # 0 35 bytes - signature
- # 35 32 bytes - GUID (MD5 hash of full extended XMP data in ASCII)
- # 67 4 bytes - total size of extended XMP data
- # 71 4 bytes - offset for this XMP data portion
- $dumpType = 'Extended XMP';
- if ($length > 75) {
- my ($size, $off) = unpack('x67N2', $$segDataPt);
- my $guid = substr($$segDataPt, 35, 32);
- if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase)
- $self->WarnOnce($tip = 'Invalid extended XMP GUID');
- } else {
- my $extXMP = $extendedXMP{$guid};
- if (not $extXMP) {
- $extXMP = $extendedXMP{$guid} = { };
- } elsif ($size != $$extXMP{Size}) {
- $self->WarnOnce('Inconsistent extended XMP size');
- }
- $$extXMP{Size} = $size;
- $$extXMP{$off} = substr($$segDataPt, 75);
- $tip = "Full length: $size\nChunk offset: $off\nChunk length: " .
- ($length - 75) . "\nGUID: $guid";
- # (delay processing extended XMP until after reading all segments)
- }
- } else {
- $self->WarnOnce($tip = 'Invalid extended XMP segment');
- }
- } elsif ($$segDataPt =~ /^QVCI\0/) {
- $dumpType = 'QVCI';
- my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) {
- $dumpType = 'FLIR';
- # must concatenate FLIR chunks (note: handle the case where
- # some software erroneously writes zeros for the chunk counts)
- my $chunkNum = Get8u($segDataPt, 6);
- my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!)
- $verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n",
- $chunkNum + 1, $chunksTot;
- if (defined $flirTotal) {
- # abort parsing FLIR if the total chunk count is inconsistent
- undef $flirCount if $chunksTot != $flirTotal;
- } else {
- $flirCount = 0;
- $flirTotal = $chunksTot;
- }
- if (defined $flirCount) {
- if (defined $flirChunk[$chunkNum]) {
- $self->WarnOnce('Duplicate FLIR chunk number(s)');
- $flirChunk[$chunkNum] .= substr($$segDataPt, 8);
- } else {
- $flirChunk[$chunkNum] = substr($$segDataPt, 8);
- }
- # process the FLIR information if we have all of the chunks
- if (++$flirCount >= $flirTotal) {
- my $flir = '';
- defined $_ and $flir .= $_ foreach @flirChunk;
- undef @flirChunk; # free memory
- my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF');
- my %dirInfo = (
- DataPt => \$flir,
- Parent => $markerName,
- DirName => 'FLIR',
- );
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- undef $flirCount; # prevent reprocessing
- }
- } else {
- $self->WarnOnce('Invalid or extraneous FLIR chunk(s)');
- }
- } else {
- # Hmmm. Could be XMP, let's see
- my $processed;
- if ($$segDataPt =~ /^http/ or $$segDataPt =~ /^XMP\0/ or $$segDataPt =~ /<exif:/) {
- $dumpType = 'XMP';
- # also try to parse XMP with a non-standard header
- # (note: this non-standard XMP is ignored when writing)
- my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
- my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
- DirStart(\%dirInfo, $start);
- $dirInfo{DirName} = $start ? 'XMP' : 'XML',
- $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- if ($processed and not $start) {
- $self->Warn('Non-standard header for APP1 XMP segment');
- }
- }
- if ($verbose and not $processed) {
- $self->Warn("Ignored APP1 segment length $length (unknown header)");
- }
- }
- } elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, PreviewImage)
- if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) {
- $dumpType = 'ICC_Profile';
- # must concatenate profile chunks (note: handle the case where
- # some software erroneously writes zeros for the chunk counts)
- my $chunkNum = Get8u($segDataPt, 12);
- my $chunksTot = Get8u($segDataPt, 13);
- $verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n";
- if (defined $iccChunksTotal) {
- # abort parsing ICC_Profile if the total chunk count is inconsistent
- undef $iccChunkCount if $chunksTot != $iccChunksTotal;
- } else {
- $iccChunkCount = 0;
- $iccChunksTotal = $chunksTot;
- $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot;
- }
- if (defined $iccChunkCount) {
- if (defined $iccChunk[$chunkNum]) {
- $self->WarnOnce('Duplicate ICC_Profile chunk number(s)');
- $iccChunk[$chunkNum] .= substr($$segDataPt, 14);
- } else {
- $iccChunk[$chunkNum] = substr($$segDataPt, 14);
- }
- # process profile if we have all of the chunks
- if (++$iccChunkCount >= $iccChunksTotal) {
- my $icc_profile = '';
- defined $_ and $icc_profile .= $_ foreach @iccChunk;
- undef @iccChunk; # free memory
- my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
- my %dirInfo = (
- DataPt => \$icc_profile,
- DataPos => $segPos + 14,
- DataLen => length($icc_profile),
- DirStart => 0,
- DirLen => length($icc_profile),
- Parent => $markerName,
- );
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- undef $iccChunkCount; # prevent reprocessing
- }
- } else {
- $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)');
- }
- } elsif ($$segDataPt =~ /^FPXR\0/) {
- next if $fast and $fast > 1; # skip processing for very fast
- $dumpType = 'FPXR';
- my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
- # set flag if this is the last FPXR segment
- $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^MPF\0/) {
- undef $dumpType; # (will be dumped here)
- DirStart(\%dirInfo, 4, 4);
- $dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1
- if ($htmlDump) {
- $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes");
- $self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF');
- $dumpEnd = $segPos + $length;
- }
- # extract the MPF information (it is in standard TIFF format)
- my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main');
- $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) {
- # Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0",
- # Digilife DDC-690/Rollei="BGTH"
- $dumpType = 'Preview Image';
- $preview = substr($$segDataPt, length($1));
- } elsif ($preview) {
- $dumpType = 'Preview Image';
- $preview .= $$segDataPt;
- }
- if ($preview and $nextMarker ne $marker) {
- $self->FoundTag('PreviewImage', $preview);
- undef $preview;
- }
- } elsif ($marker == 0xe3) { # APP3 (Kodak "Meta", Stim)
- if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
- undef $dumpType; # (will be dumped here)
- DirStart(\%dirInfo, 6, 6);
- if ($htmlDump) {
- $self->HDump($segPos-4, 10, 'APP3 Meta header');
- $dumpEnd = $segPos + $length;
- }
- my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
- $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^Stim\0/) {
- undef $dumpType; # (will be dumped here)
- DirStart(\%dirInfo, 6, 6);
- if ($htmlDump) {
- $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes");
- $self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim');
- $dumpEnd = $segPos + $length;
- }
- # extract the Stim information (it is in standard TIFF format)
- my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main');
- $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
- $dumpType = 'PreviewImage'; # (Samsung, HP, BenQ)
- $preview = $$segDataPt;
- }
- if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4
- $self->FoundTag('PreviewImage', $preview);
- undef $preview;
- }
- } elsif ($marker == 0xe4) { # APP4 ("SCALADO", FPXR, PreviewImage)
- if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) {
- $dumpType = 'SCALADO';
- my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt);
- # assume that the segments are in order and just concatinate them
- $scalado = '' unless defined $scalado;
- $scalado .= substr($$segDataPt, 16);
- if ($idx == $num - 1) {
- if ($len != length $scalado) {
- $self->Warn('Possibly corrupted APP4 SCALADO data', 1);
- }
- my %dirInfo = (
- Parent => $markerName,
- DataPt => \$scalado,
- );
- my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- undef $scalado;
- }
- } elsif ($$segDataPt =~ /^FPXR\0/) {
- next if $fast and $fast > 1; # skip processing for very fast
- $dumpType = 'FPXR';
- my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
- # set flag if this is the last FPXR segment
- $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($preview) {
- # continued Samsung S1060 preview from APP3
- $dumpType = 'PreviewImage';
- $preview .= $$segDataPt;
- }
- # BenQ DC E1050 continues preview in APP5
- if ($preview and $nextMarker ne 0xe5) {
- $self->FoundTag('PreviewImage', $preview);
- undef $preview;
- }
- } elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA")
- if ($$segDataPt =~ /^RMETA\0/) {
- # (NOTE: apparently these may span multiple segments, but I haven't seen
- # a sample like this, so multi-segment support hasn't yet been implemented)
- $dumpType = 'Ricoh RMETA';
- DirStart(\%dirInfo, 6, 6);
- my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($preview) {
- $dumpType = 'PreviewImage';
- $preview .= $$segDataPt;
- $self->FoundTag('PreviewImage', $preview);
- undef $preview;
- }
- } elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM, NITF, HP_TDHD)
- if ($$segDataPt =~ /^EPPIM\0/) {
- undef $dumpType; # (will be dumped here)
- DirStart(\%dirInfo, 6, 6);
- if ($htmlDump) {
- $self->HDump($segPos-4, 10, 'APP6 EPPIM header');
- $dumpEnd = $segPos + $length;
- }
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM');
- $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^NITF\0/) {
- $dumpType = 'NITF';
- SetByteOrder('MM');
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF');
- DirStart(\%dirInfo, 5);
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) {
- # HP Photosmart R837 APP6 "TDHD" segment
- $dumpType = 'TDHD';
- my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD');
- # (ignore first TDHD element because size includes 12-byte tag header)
- DirStart(\%dirInfo, 12);
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xe7) { # APP7 (Pentax, Qualcomm)
- if ($$segDataPt =~ /^PENTAX \0(II|MM)/) {
- # found in K-3 images (is this multi-segment??)
- SetByteOrder($1);
- undef $dumpType; # (dump this ourself)
- my $hdrLen = 10;
- my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main');
- DirStart(\%dirInfo, $hdrLen, 0);
- $dirInfo{DirName} = 'Pentax APP7';
- if ($htmlDump) {
- $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes");
- $self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax');
- $dumpEnd = $segPos + $length;
- }
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) {
- # found in HP iPAQ_VoiceMessenger
- $dumpType = 'Qualcomm';
- my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main');
- DirStart(\%dirInfo, 27);
- $dirInfo{DirName} = 'Qualcomm';
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xe8) { # APP8 (SPIFF)
- # my sample SPIFF has 32 bytes of data, but spec states 30
- if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) {
- $dumpType = 'SPIFF';
- DirStart(\%dirInfo, 6);
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xe9) { # APP9 (Media Jukebox)
- if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) {
- $dumpType = 'MediaJukebox';
- # (start parsing after the "<MJMD>")
- DirStart(\%dirInfo, 22);
- $dirInfo{DirName} = 'MediaJukebox';
- require Image::ExifTool::XMP;
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP);
- }
- } elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments)
- if ($$segDataPt =~ /^UNICODE\0/) {
- $dumpType = 'PhotoStudio';
- my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM');
- $self->FoundTag('Comment', $comment);
- }
- } elsif ($marker == 0xeb) { # APP11 (JPEG-HDR)
- if ($$segDataPt =~ /^HDR_RI /) {
- $dumpType = 'JPEG-HDR';
- my $dataPt = $segDataPt;
- if (defined $combinedSegData) {
- if ($$segDataPt =~ /~\0/g) {
- $combinedSegData .= substr($$segDataPt,pos($$segDataPt));
- } else {
- $self->Warn('Invalid format for JPEG-HDR extended segment');
- }
- $dataPt = \$combinedSegData;
- }
- if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) {
- $combinedSegData = $$segDataPt unless defined $combinedSegData;
- } else {
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR');
- my %dirInfo = ( DataPt => $dataPt );
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- undef $combinedSegData;
- }
- }
- } elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info)
- if ($$segDataPt =~ /^Ducky/) {
- $dumpType = 'Ducky';
- DirStart(\%dirInfo, 5);
- my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } else {
- my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo');
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info';
- }
- } elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM)
- my $isOld;
- if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) {
- $dumpType = 'Photoshop';
- # add this data to the combined data if it exists
- my $dataPt = $segDataPt;
- if (defined $combinedSegData) {
- $combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
- $dataPt = \$combinedSegData;
- }
- # peek ahead to see if the next segment is photoshop data too
- if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) {
- # initialize combined data if necessary
- $combinedSegData = $$segDataPt unless defined $combinedSegData;
- # (will handle the Photoshop data the next time around)
- } else {
- my $hdrLen = $isOld ? 27 : 14;
- # process APP13 Photoshop record
- my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
- my %dirInfo = (
- DataPt => $dataPt,
- DataPos => $segPos,
- DataLen => length $$dataPt,
- DirStart => $hdrLen, # directory starts after identifier
- DirLen => length($$dataPt) - $hdrLen,
- Parent => $markerName,
- );
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- undef $combinedSegData;
- }
- } elsif ($$segDataPt =~ /^Adobe_CM/) {
- $dumpType = 'Adobe_CM';
- SetByteOrder('MM');
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM');
- DirStart(\%dirInfo, 8);
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xee) { # APP14 (Adobe)
- if ($$segDataPt =~ /^Adobe/) {
- # extract as a block if requested, or if copying tags from file
- if ($$self{REQ_TAG_LOOKUP}{adobe} or
- # (not extracted normally, so check TAGS_FROM_FILE)
- ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe}))
- {
- $self->FoundTag('Adobe', $$segDataPt);
- }
- $dumpType = 'Adobe';
- SetByteOrder('MM');
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe');
- DirStart(\%dirInfo, 5);
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- }
- } elsif ($marker == 0xef) { # APP15 (GraphicConverter)
- if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) {
- $dumpType = 'GraphicConverter';
- my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv');
- $self->HandleTag($tagTablePtr, 'Q', $1);
- }
- } elsif ($marker == 0xfe) { # COM (JPEG comment)
- $dumpType = 'Comment';
- $$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators
- $self->FoundTag('Comment', $$segDataPt);
- } elsif ($marker == 0x64) { # CME (J2C comment and extension)
- $dumpType = 'Comment';
- if ($length > 2) {
- my $reg = unpack('n', $$segDataPt); # get registration value
- my $val = substr($$segDataPt, 2);
- $val = $self->Decode($val, 'Latin') if $reg == 1;
- # (actually an extension for $reg==65535, but store as binary comment)
- $self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val);
- }
- } elsif ($marker == 0x51) { # SIZ (J2C)
- my ($w, $h) = unpack('x2N2', $$segDataPt);
- $self->FoundTag('ImageWidth', $w);
- $self->FoundTag('ImageHeight', $h);
- } elsif (($marker & 0xf0) != 0xe0) {
- $dumpType = "$markerName segment";
- $desc = "[JPEG $markerName]"; # (other known JPEG segments)
- }
- if (defined $dumpType) {
- if (not $dumpType and $$self{OPTIONS}{Unknown}) {
- $self->Warn("Unknown $markerName segment", 1);
- }
- if ($htmlDump) {
- $desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
- $self->HDump($segPos-4, $length+4, $desc, $tip, 0x08);
- $dumpEnd = $segPos + $length;
- }
- }
- undef $$segDataPt;
- }
- # process extended XMP now if it existed
- if (%extendedXMP) {
- my $guid;
- # GUID indicated by the last main XMP segment
- my $goodGuid = $$self{VALUE}{HasExtendedXMP} || '';
- # GUID of the extended XMP that we will process ('2' for all)
- my $readGuid = $$self{OPTIONS}{ExtendedXMP} || 0;
- $readGuid = $goodGuid if $readGuid eq '1';
- foreach $guid (sort keys %extendedXMP) {
- next unless length $guid == 32; # ignore other (internal) keys
- my $extXMP = $extendedXMP{$guid};
- my ($off, @offsets, $warn);
- # make sure we have all chunks, and create a list of sorted offsets
- for ($off=0; $off<$$extXMP{Size}; ) {
- last unless defined $$extXMP{$off};
- push @offsets, $off;
- $off += length $$extXMP{$off};
- }
- unless ($off == $$extXMP{Size}) {
- $self->Warn("Incomplete extended XMP (GUID $guid)");
- next;
- }
- if ($guid eq $readGuid or $readGuid eq '2') {
- $warn = 'Reading non-' if $guid ne $goodGuid;
- my $buff = '';
- # assemble XMP all together
- $buff .= $$extXMP{$_} foreach @offsets;
- my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
- my %dirInfo = (
- DataPt => \$buff,
- Parent => 'APP1',
- );
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- } else {
- $warn = 'Ignored ';
- $warn .= 'non-' if $guid ne $goodGuid;
- }
- $self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn;
- delete $extendedXMP{$guid};
- }
- }
- # calculate JPEGDigest if requested
- if (@dqt) {
- require Image::ExifTool::JPEGDigest;
- Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling);
- }
- # issue necessary warnings
- $self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount;
- $self->Warn('Incomplete FLIR record', 1) if defined $flirCount;
- $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError};
- $success or $self->Warn('JPEG format error');
- pop @$path if @$path > $pn;
- return 1;
- }
- #------------------------------------------------------------------------------
- # Extract metadata from an Exiv2 EXV file
- # Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
- # Returns: 1 on success, 0 if this wasn't a valid JPEG file
- sub ProcessEXV($$)
- {
- my ($self, $dirInfo) = @_;
- return $self->ProcessJPEG($dirInfo);
- }
- #------------------------------------------------------------------------------
- # Process EXIF file
- # Inputs/Returns: same as ProcessTIFF
- sub ProcessEXIF($$;$)
- {
- my ($self, $dirInfo, $tagTablePtr) = @_;
- return $self->ProcessTIFF($dirInfo, $tagTablePtr);
- }
- #------------------------------------------------------------------------------
- # Process TIFF data (wrapper for DoProcessTIFF to allow re-entry)
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
- # Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
- sub ProcessTIFF($$;$)
- {
- my ($self, $dirInfo, $tagTablePtr) = @_;
- my $exifData = $$self{EXIF_DATA};
- my $exifPos = $$self{EXIF_POS};
- my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr);
- # restore original EXIF information (in case ProcessTIFF is nested)
- if (defined $exifData) {
- $$self{EXIF_DATA} = $exifData;
- $$self{EXIF_POS} = $exifPos;
- }
- return $rtnVal;
- }
- #------------------------------------------------------------------------------
- # Process TIFF data
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
- # Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
- sub DoProcessTIFF($$;$)
- {
- my ($self, $dirInfo, $tagTablePtr) = @_;
- my $dataPt = $$dirInfo{DataPt};
- my $fileType = $$dirInfo{Parent} || '';
- my $raf = $$dirInfo{RAF};
- my $base = $$dirInfo{Base} || 0;
- my $outfile = $$dirInfo{OutFile};
- my ($err, $sig, $canonSig, $otherSig);
- # attempt to read TIFF header
- $$self{EXIF_DATA} = '';
- if ($raf) {
- if ($outfile) {
- $raf->Seek(0, 0) or return 0;
- if ($base) {
- $raf->Read($$dataPt, $base) == $base or return 0;
- Write($outfile, $$dataPt) or $err = 1;
- }
- } else {
- $raf->Seek($base, 0) or return 0;
- }
- # extract full EXIF block (for block copy) from EXIF file
- my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8;
- my $n = $raf->Read($$self{EXIF_DATA}, $amount);
- if ($n < 8) {
- return 0 if $n or not $outfile or $fileType ne 'EXIF';
- # create EXIF file from scratch
- delete $$self{EXIF_DATA};
- undef $raf;
- }
- if ($n > 8) {
- $raf->Seek(8, 0);
- if ($n == $amount) {
- $$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8);
- $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen)
- }
- }
- } elsif ($dataPt and length $$dataPt) {
- # save a copy of the EXIF data
- my $dirStart = $$dirInfo{DirStart} || 0;
- my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
- $$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen);
- $self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2;
- } elsif ($outfile) {
- delete $$self{EXIF_DATA}; # create from scratch
- } else {
- $$self{EXIF_DATA} = '';
- }
- unless (defined $$self{EXIF_DATA}) {
- # create TIFF information from scratch
- if ($self->SetPreferredByteOrder() eq 'MM') {
- $$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
- } else {
- $$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
- }
- }
- $$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS};
- $$self{EXIF_POS} = $base + $$self{BASE};
- $dataPt = \$$self{EXIF_DATA};
- # set byte ordering
- my $byteOrder = substr($$dataPt,0,2);
- SetByteOrder($byteOrder) or return 0;
- # verify the byte ordering
- my $identifier = Get16u($dataPt, 2);
- # identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF)
- # no longer do this because various files use different values
- # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????)
- # return 0 unless $identifier == 0x2a;
- # get offset to IFD0
- my $offset = Get32u($dataPt, 4);
- $offset >= 8 or return 0;
- if ($raf) {
- # check for canon or EXIF signature
- # (Canon CR2 images should have an offset of 16, but it may be
- # greater if edited by PhotoMechanic)
- if ($identifier == 0x2a and $offset >= 16) {
- $raf->Read($sig, 8) == 8 or return 0;
- $$dataPt .= $sig;
- if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) {
- if ($sig eq 'ExifMeta') {
- $self->SetFileType($fileType = 'EXIF');
- $otherSig = $sig;
- } else {
- $fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW';
- $canonSig = $sig;
- }
- $self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP};
- }
- } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) {
- # panasonic RAW, RW2 or RWL file
- my $magic;
- # test for RW2/RWL magic number
- if ($offset >= 0x18 and $raf->Read($magic, 16) and
- $magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a")
- {
- $fileType = 'RW2' unless $fileType eq 'RWL';
- $self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP};
- $otherSig = $magic; # save signature for writing
- } else {
- $fileType = 'RAW';
- }
- $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main');
- } elsif ($fileType eq 'TIFF') {
- if ($identifier == 0x2b) {
- # this looks like a BigTIFF image
- $raf->Seek(0);
- require Image::ExifTool::BigTIFF;
- return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
- } elsif ($identifier == 0x4f52 or $identifier == 0x5352) {
- # Olympus ORF image (set FileType now because base type is 'ORF')
- $self->SetFileType($fileType = 'ORF');
- } elsif ($identifier == 0x4352) {
- $fileType = 'DCP';
- } elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) {
- $fileType = 'HDP'; # Windows HD Photo file
- # check version number
- my $ver = Get8u($dataPt, 3);
- if ($ver > 1) {
- $self->Error("Windows HD Photo version $ver files not yet supported");
- return 1;
- }
- }
- }
- # we have a valid TIFF (or whatever) file
- if ($fileType and not $$self{VALUE}{FileType}) {
- my $lookup = $fileTypeLookup{$fileType};
- $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup;
- # use file extension to pre-determine type if extension is TIFF-based or type is RAW
- my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : '';
- my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef;
- $self->SetFileType($t);
- }
- # don't process file if FastScan == 3
- return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3;
- }
- my $ifdName = 'IFD0';
- if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') {
- $self->FoundTag('ExifByteOrder', $byteOrder);
- } else {
- $ifdName = $$tagTablePtr{GROUPS}{1};
- }
- if ($$self{HTML_DUMP}) {
- my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x",
- ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset);
- $self->HDump($base, 8, 'TIFF header', $tip, 0);
- }
- # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...)
- $$self{TIFF_TYPE} = $fileType;
- # get reference to the main EXIF table
- $tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
- # build directory information hash
- my %dirInfo = (
- Base => $base,
- DataPt => $dataPt,
- DataLen => length $$dataPt,
- DataPos => 0,
- DirStart => $offset,
- DirLen => length($$dataPt) - $offset,
- RAF => $raf,
- DirName => $ifdName,
- Parent => $fileType,
- ImageData=> 'Main', # set flag to get information to copy main image data later
- Multi => $$dirInfo{Multi},
- );
- # extract information from the image
- unless ($outfile) {
- # process the directory
- $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
- # process GeoTiff information if available
- if ($$self{VALUE}{GeoTiffDirectory}) {
- require Image::ExifTool::GeoTiff;
- Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
- }
- # process information in recognized trailers
- if ($raf) {
- my $trailInfo = IdentifyTrailer($raf);
- if ($trailInfo) {
- $$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary
- $self->ProcessTrailers($trailInfo);
- }
- # dump any other known trailer (eg. A100 RAW Data)
- if ($$self{HTML_DUMP} and $$self{KnownTrailer}) {
- my $known = $$self{KnownTrailer};
- $raf->Seek(0, 2);
- my $len = $raf->Tell() - $$known{Start};
- $len -= $$trailInfo{Offset} if $trailInfo; # account for other trailers
- $self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0;
- }
- }
- # update FileType if necessary now that we know more about the file
- if ($$self{DNGVersion} and $$self{VALUE}{FileType} ne 'DNG') {
- # override whatever FileType we set since we now know it is DNG
- $self->OverrideFileType('DNG');
- }
- return 1;
- }
- #
- # rewrite the image
- #
- if ($$dirInfo{NoTiffEnd}) {
- delete $$self{TIFF_END};
- } else {
- # initialize TIFF_END so it will be updated by WriteExif()
- $$self{TIFF_END} = 0;
- }
- if ($canonSig) {
- # write Canon CR2 specially because it has a header we want to preserve,
- # and possibly trailers added by the Canon utilities and/or PhotoMechanic
- $dirInfo{OutFile} = $outfile;
- require Image::ExifTool::CanonRaw;
- Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1;
- } else {
- # write TIFF header (8 bytes [plus optional signature] followed by IFD)
- if ($fileType eq 'EXIF') {
- $otherSig = 'ExifMeta'; # force this signature for all EXIF files
- } elsif (not defined $otherSig) {
- $otherSig = '';
- }
- my $offset = 8 + length($otherSig);
- # construct tiff header
- my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig;
- $dirInfo{NewDataPos} = $offset;
- $dirInfo{HeaderPtr} = \$header;
- # preserve padding between image data blocks in ORF images
- # (otherwise dcraw has problems because it assumes fixed block spacing)
- $dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a;
- my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
- if (not defined $newData) {
- $err = 1;
- } elsif (length($newData)) {
- # update header length in case more was added
- my $hdrLen = length $header;
- if ($hdrLen != 8) {
- Set32u($hdrLen, \$header, 4);
- # also update preview fixup if necessary
- my $pi = $$self{PREVIEW_INFO};
- $$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup};
- }
- if ($$self{TIFF_TYPE} eq 'ARW' and not $err) {
- # write any required ARW trailer and patch other ARW quirks
- require Image::ExifTool::Sony;
- my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData,
- $dirInfo{ImageData});
- $errStr and $self->Error($errStr);
- delete $dirInfo{ImageData}; # (was copied by FinishARW)
- } else {
- Write($outfile, $header, $newData) or $err = 1;
- }
- undef $newData; # free memory
- }
- # copy over image data now if necessary
- if (ref $dirInfo{ImageData} and not $err) {
- $self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1;
- delete $dirInfo{ImageData};
- }
- }
- # make local copy of TIFF_END now (it may be reset when processing trailers)
- my $tiffEnd = $$self{TIFF_END};
- delete $$self{TIFF_END};
- # rewrite trailers if they exist
- if ($raf and $tiffEnd and not $err) {
- my ($buf, $trailInfo);
- $raf->Seek(0, 2) or $err = 1;
- my $extra = $raf->Tell() - $tiffEnd;
- # check for trailer and process if possible
- for (;;) {
- last unless $extra > 12;
- $raf->Seek($tiffEnd); # seek back to end of image
- $trailInfo = IdentifyTrailer($raf);
- last unless $trailInfo;
- my $tbuf = '';
- $$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s)
- $$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary
- # rewrite all trailers to buffer
- unless ($self->ProcessTrailers($trailInfo)) {
- undef $trailInfo;
- $err = 1;
- last;
- }
- # calculate unused bytes before trailer
- $extra = $$trailInfo{DataPos} - $tiffEnd;
- last; # yes, the 'for' loop was just a cheap 'goto'
- }
- # ignore a single zero byte if used for padding
- if ($extra > 0 and $tiffEnd & 0x01) {
- $raf->Seek($tiffEnd, 0) or $err = 1;
- $raf->Read($buf, 1) or $err = 1;
- defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd;
- }
- if ($extra > 0) {
- my $known = $$self{KnownTrailer};
- if ($$self{DEL_GROUP}{Trailer} and not $known) {
- $self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n");
- ++$$self{CHANGED};
- } elsif ($known) {
- $self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n");
- $raf->Seek($tiffEnd, 0) or $err = 1;
- CopyBlock($raf, $outfile, $extra) or $err = 1;
- } else {
- $raf->Seek($tiffEnd, 0) or $err = 1;
- # preserve unknown trailer only if it contains non-null data
- # (Photoshop CS adds a trailer with 2 null bytes)
- my $size = $extra;
- for (;;) {
- my $n = $size > 65536 ? 65536 : $size;
- $raf->Read($buf, $n) == $n or $err = 1, last;
- if ($buf =~ /[^\0]/) {
- $self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n");
- # copy the trailer since it contains non-null data
- Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra;
- Write($outfile, $buf) or $err = 1, last;
- CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n;
- last;
- }
- $size -= $n;
- next if $size > 0;
- $self->VPrint(0, " Deleting blank trailer ($extra bytes)\n");
- last;
- }
- }
- }
- # write trailer buffer if necessary
- $self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo;
- # add any new trailers we are creating
- my $trailPt = $self->AddNewTrailers();
- Write($outfile, $$trailPt) or $err = 1 if $trailPt;
- }
- # check DNG version
- if ($$self{DNGVersion}) {
- my $ver = $$self{DNGVersion};
- # currently support up to DNG version 1.4
- unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.4) {
- $ver =~ tr/ /./;
- $self->Error("DNG Version $ver not yet tested", 1);
- }
- }
- return $err ? -1 : 1;
- }
- #------------------------------------------------------------------------------
- # Return list of tag table keys (ignoring special keys)
- # Inputs: 0) reference to tag table
- # Returns: List of table keys (unsorted)
- sub TagTableKeys($)
- {
- local $_;
- my $tagTablePtr = shift;
- my @keyList;
- foreach (keys %$tagTablePtr) {
- push(@keyList, $_) unless $specialTags{$_};
- }
- return @keyList;
- }
- #------------------------------------------------------------------------------
- # GetTagTable
- # Inputs: 0) table name
- # Returns: tag table reference, or undefined if not found
- # Notes: Always use this function instead of requiring module and using table
- # directly since this function also does the following the first time the table
- # is loaded:
- # - requires new module if necessary
- # - generates default GROUPS hash and Group 0 name from module name
- # - registers Composite tags if Composite table found
- # - saves descriptions for tags in specified table
- # - generates default TAG_PREFIX to be used for unknown tags
- sub GetTagTable($)
- {
- my $tableName = shift or return undef;
- my $table = $allTables{$tableName};
- unless ($table) {
- no strict 'refs';
- unless (%$tableName) {
- # try to load module for this table
- if ($tableName =~ /(.*)::/) {
- my $module = $1;
- if (eval "require $module") {
- # load additional XMP modules if required
- if (not %$tableName and $module eq 'Image::ExifTool::XMP') {
- require 'Image/ExifTool/XMP2.pl';
- }
- } else {
- $@ and warn $@;
- }
- }
- unless (%$tableName) {
- warn "Can't find table $tableName\n";
- return undef;
- }
- }
- no strict 'refs';
- $table = \%$tableName;
- use strict 'refs';
- $$table{TABLE_NAME} = $tableName; # set table name
- ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://;
- # set default group 0 and 1 from module name unless already specified
- my $defaultGroups = $$table{GROUPS};
- $defaultGroups or $defaultGroups = $$table{GROUPS} = { };
- unless ($$defaultGroups{0} and $$defaultGroups{1}) {
- if ($tableName =~ /Image::.*?::([^:]*)/) {
- $$defaultGroups{0} = $1 unless $$defaultGroups{0};
- $$defaultGroups{1} = $1 unless $$defaultGroups{1};
- } else {
- $$defaultGroups{0} = $tableName unless $$defaultGroups{0};
- $$defaultGroups{1} = $tableName unless $$defaultGroups{1};
- }
- }
- $$defaultGroups{2} = 'Other' unless $$defaultGroups{2};
- if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) {
- # initialize some XMP table defaults
- require Image::ExifTool::XMP;
- Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces
- # set default write/check procs
- $$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC};
- $$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC};
- $$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO};
- }
- # generate a tag prefix for unknown tags if necessary
- unless (defined $$table{TAG_PREFIX}) {
- my $tagPrefix;
- if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) {
- ($tagPrefix = $1) =~ s/::/_/g;
- } else {
- $tagPrefix = $tableName;
- }
- $$table{TAG_PREFIX} = $tagPrefix;
- }
- # set up the new table
- SetupTagTable($table);
- # add any user-defined tags
- if (%UserDefined and $UserDefined{$tableName}) {
- my $tagID;
- foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
- next if $specialTags{$tagID};
- delete $$table{$tagID}; # replace any existing entry
- AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1);
- }
- }
- # remember order we loaded the tables in
- push @tableOrder, $tableName;
- # insert newly loaded table into list
- $allTables{$tableName} = $table;
- }
- return $table;
- }
- #------------------------------------------------------------------------------
- # Process an image directory
- # Inputs: 0) ExifTool object reference, 1) directory information reference
- # 2) tag table reference, 3) optional reference to processing procedure
- # Returns: Result from processing (1=success)
- sub ProcessDirectory($$$;$)
- {
- my ($self, $dirInfo, $tagTablePtr, $proc) = @_;
- return 0 unless $tagTablePtr and $dirInfo;
- # use default proc from tag table or EXIF proc as fallback if no proc specified
- $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif;
- # set directory name from default group0 name if not done already
- my $dirName = $$dirInfo{DirName};
- unless ($dirName) {
- $dirName = $$tagTablePtr{GROUPS}{0};
- $dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name)
- $$dirInfo{DirName} = $dirName;
- }
- # guard against cyclical recursion into the same directory
- if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and
- # directories don't overlap if the length is zero
- ($$dirInfo{DirLen} or not defined $$dirInfo{DirLen}))
- {
- my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0);
- if ($$self{PROCESSED}{$addr}) {
- $self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory");
- # patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer
- return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD';
- }
- $$self{PROCESSED}{$addr} = $dirName;
- }
- my $oldOrder = GetByteOrder();
- my $oldIndent = $$self{INDENT};
- my $oldDir = $$self{DIR_NAME};
- $$self{LIST_TAGS} = { }; # don't build lists across different directories
- $$self{INDENT} .= '| ';
- $$self{DIR_NAME} = $dirName;
- push @{$$self{PATH}}, $dirName;
- # process the directory
- my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr);
- pop @{$$self{PATH}};
- $$self{INDENT} = $oldIndent;
- $$self{DIR_NAME} = $oldDir;
- SetByteOrder($oldOrder);
- return $rtnVal;
- }
- #------------------------------------------------------------------------------
- # Get Metadata path
- # Inputs: 0) Exiftool object ref
- # Return: Metadata path string
- sub MetadataPath($)
- {
- my $self = shift;
- return join '-', @{$$self{PATH}}
- }
- #------------------------------------------------------------------------------
- # Get standardized file extension
- # Inputs: 0) file name
- # Returns: standardized extension (all uppercase), or undefined if no extension
- sub GetFileExtension($)
- {
- my $filename = shift;
- my $fileExt;
- if ($filename and $filename =~ /^.*\.([^.]+)$/s) {
- $fileExt = uc($1); # change extension to upper case
- # convert TIF extension to TIFF because we use the
- # extension for the file type tag of TIFF images
- $fileExt eq 'TIF' and $fileExt = 'TIFF';
- }
- return $fileExt;
- }
- #------------------------------------------------------------------------------
- # Get list of tag information hashes for given tag ID
- # Inputs: 0) Tag table reference, 1) tag ID
- # Returns: Array of tag information references
- # Notes: Generates tagInfo hash if necessary
- sub GetTagInfoList($$)
- {
- my ($tagTablePtr, $tagID) = @_;
- my $tagInfo = $$tagTablePtr{$tagID};
- if ($specialTags{$tagID}) {
- # (hopefully this won't happen)
- warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n";
- } elsif (ref $tagInfo eq 'HASH') {
- return ($tagInfo);
- } elsif (ref $tagInfo eq 'ARRAY') {
- return @$tagInfo;
- } elsif ($tagInfo) {
- # create hash with name
- $tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo };
- return ($tagInfo);
- }
- return ();
- }
- #------------------------------------------------------------------------------
- # Find tag information, processing conditional tags
- # Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID
- # 3) optional value reference, 4) optional format type, 5) optional value count
- # Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed
- # Notes: You should always call this routine to find a tag in a table because
- # this routine will evaluate conditional tags.
- # Arguments 3-5 are only required if the information type allows $valPt, $format and/or
- # $count in a Condition, and if not given when needed this routine returns ''.
- sub GetTagInfo($$$;$$$)
- {
- my ($self, $tagTablePtr, $tagID) = @_;
- my ($valPt, $format, $count);
- my @infoArray = GetTagInfoList($tagTablePtr, $tagID);
- # evaluate condition
- my $tagInfo;
- foreach $tagInfo (@infoArray) {
- my $condition = $$tagInfo{Condition};
- if ($condition) {
- ($valPt, $format, $count) = splice(@_, 3) if @_ > 3;
- return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt;
- # set old value for use in condition if needed
- local $SIG{'__WARN__'} = \&SetWarning;
- undef $evalWarning;
- #### eval Condition ($self, [$valPt, $format, $count])
- unless (eval $condition) {
- $@ and $evalWarning = $@;
- $self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning;
- next;
- }
- }
- if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not $$self{OPTIONS}{Verbose}) {
- # don't return Unknown tags unless that option is set
- return undef;
- }
- # return the tag information we found
- return $tagInfo;
- }
- # generate information for unknown tags (numerical only) if required
- if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and
- $tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN})
- {
- my $printConv;
- if (defined $$tagTablePtr{PRINT_CONV}) {
- $printConv = $$tagTablePtr{PRINT_CONV};
- } else {
- # limit length of printout (can be very long)
- $printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val';
- }
- my $hex = sprintf("0x%.4x", $tagID);
- my $prefix = $$tagTablePtr{TAG_PREFIX};
- $tagInfo = {
- Name => "${prefix}_$hex",
- Description => MakeDescription($prefix, $hex),
- Unknown => 1,
- Writable => 0, # can't write unknown tags
- PrintConv => $printConv,
- };
- # add tag information to table
- AddTagToTable($tagTablePtr, $tagID, $tagInfo);
- } else {
- undef $tagInfo;
- }
- return $tagInfo;
- }
- #------------------------------------------------------------------------------
- # Add new tag to table (must use this routine to add new tags to a table)
- # Inputs: 0) reference to tag table, 1) tag ID
- # 2) [optional] reference to tag information hash or simply tag name
- # 3) [optional] flag to avoid adding prefix when generating tag name
- # Notes: - will not overwrite existing entry in table
- # - info need contain no entries when this routine is called
- sub AddTagToTable($$;$$)
- {
- my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_;
- # generate tag info hash if necessary
- $tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH';
- # define necessary entries in information hash
- if ($$tagInfo{Groups}) {
- # fill in default groups from table GROUPS
- foreach (keys %{$$tagTablePtr{GROUPS}}) {
- next if $$tagInfo{Groups}{$_};
- $$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_};
- }
- } else {
- $$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} };
- }
- $$tagInfo{Flags} and ExpandFlags($tagInfo);
- $$tagInfo{GotGroups} = 1,
- $$tagInfo{Table} = $tagTablePtr;
- $$tagInfo{TagID} = $tagID;
- my $name = $$tagInfo{Name};
- if (defined $name) {
- $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
- } else {
- # construct a name from the tag ID
- $name = $tagID;
- $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
- $name = ucfirst $name; # start with uppercase
- # add prefix if specified
- my $prefix = $$tagTablePtr{TAG_PREFIX};
- if ($prefix and not $noPrefix) {
- # make description to prevent tagID from getting mangled by MakeDescription()
- $$tagInfo{Description} = MakeDescription($prefix, $name);
- $name = "${prefix}_$name";
- }
- }
- # tag names must be at least 2 characters long and prefer them to start with a letter
- $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i;
- $$tagInfo{Name} = $name;
- # add tag to table, but never overwrite existing entries (could potentially happen
- # if someone thinks there isn't any tagInfo because a condition wasn't satisfied)
- unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) {
- $$tagTablePtr{$tagID} = $tagInfo;
- }
- }
- #------------------------------------------------------------------------------
- # Handle simple extraction of new tag information
- # Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value,
- # 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent,
- # TagInfo, ProcessProc, RAF
- # Returns: tag key or undef if tag not found
- # Notes: if value is not defined, it is extracted from DataPt using TagInfo
- # Format and Count if provided
- sub HandleTag($$$$;%)
- {
- my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
- my $verbose = $$self{OPTIONS}{Verbose};
- my $pfmt = $parms{Format};
- my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count});
- my $dataPt = $parms{DataPt};
- my ($subdir, $format, $count, $size, $noTagInfo, $rational);
- if ($tagInfo) {
- $subdir = $$tagInfo{SubDirectory}
- } else {
- return undef unless $verbose;
- $tagInfo = { Name => "tag $tag" }; # create temporary tagInfo hash
- $noTagInfo = 1;
- }
- # read value if not done already (not necessary for subdir)
- unless (defined $val or ($subdir and not $$tagInfo{Writable})) {
- my $start = $parms{Start} || 0;
- my $dLen = $dataPt ? length($$dataPt) : -1;
- my $size = $parms{Size};
- $size = $dLen unless defined $size;
- # read from data in memory if possible
- if ($start >= 0 and $start + $size <= $dLen) {
- $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT};
- $format = $pfmt if not $format and $pfmt and $formatSize{$pfmt};
- if ($format) {
- $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational);
- } else {
- $val = substr($$dataPt, $start, $size);
- }
- } else {
- $self->Warn("Error extracting value for $$tagInfo{Name}");
- return undef;
- }
- }
- # do verbose print if necessary
- if ($verbose) {
- undef $tagInfo if $noTagInfo;
- $parms{Value} = $val;
- $parms{Value} .= " ($rational)" if defined $rational;
- $parms{Table} = $tagTablePtr;
- if ($format) {
- $count or $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));
- $parms{Format} = $format . "[$count]";
- }
- $self->VerboseInfo($tag, $tagInfo, %parms);
- }
- if ($tagInfo) {
- if ($subdir) {
- my $subdirStart = $parms{Start};
- my $subdirLen = $parms{Size};
- if ($$subdir{Start}) {
- my $valuePtr = 0;
- #### eval Start ($valuePtr)
- my $off = eval $$subdir{Start};
- $subdirStart += $off;
- $subdirLen -= $off;
- }
- $dataPt or $dataPt = \$val;
- # process subdirectory information
- my %dirInfo = (
- DirName => $$subdir{DirName} || $$tagInfo{Name},
- DataPt => $dataPt,
- DataLen => length $$dataPt,
- DataPos => $parms{DataPos},
- DirStart => $subdirStart,
- DirLen => $subdirLen,
- Parent => $parms{Parent},
- Base => $parms{Base},
- Multi => $$subdir{Multi},
- TagInfo => $tagInfo,
- RAF => $parms{RAF},
- );
- my $oldOrder = GetByteOrder();
- SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
- my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
- $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc});
- SetByteOrder($oldOrder);
- # return now unless directory is writable as a block
- return undef unless $$tagInfo{Writable};
- }
- my $key = $self->FoundTag($tagInfo, $val);
- # save original components of rational numbers
- $$self{RATIONAL}{$key} = $rational if defined $rational and defined $key;
- return $key;
- }
- return undef;
- }
- #------------------------------------------------------------------------------
- # Add tag to hash of extracted information
- # Inputs: 0) ExifTool object reference
- # 1) reference to tagInfo hash or tag name
- # 2) data value (or reference to require hash if Composite)
- # Returns: tag key or undef if no value
- sub FoundTag($$$)
- {
- local $_;
- my ($self, $tagInfo, $value) = @_;
- my ($tag, $noListDel);
- if (ref $tagInfo eq 'HASH') {
- $tag = $$tagInfo{Name} or warn("No tag name\n"), return undef;
- } else {
- $tag = $tagInfo;
- # look for tag in Extra
- $tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag);
- # make temporary hash if tag doesn't exist in Extra
- # (not advised to do this since the tag won't show in list)
- $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
- $$self{OPTIONS}{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
- }
- # get tag priority
- my $priority = $$tagInfo{Priority};
- unless (defined $priority) {
- $priority = $$tagInfo{Table}{PRIORITY};
- $priority = 0 if not defined $priority and $$tagInfo{Avoid};
- }
- my $valueHash = $$self{VALUE};
- if ($$tagInfo{RawConv}) {
- # initialize @val for use in Composite RawConv expressions
- my @val;
- if (ref $value eq 'HASH') {
- foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; }
- }
- my $conv = $$tagInfo{RawConv};
- local $SIG{'__WARN__'} = \&SetWarning;
- undef $evalWarning;
- if (ref $conv eq 'CODE') {
- $value = &$conv($value, $self);
- } else {
- my $val = $value; # do this so eval can use $val
- # NOTE: RawConv is also evaluated in Writer.pl
- #### eval RawConv ($self, $val, $tag, $tagInfo, $priority)
- $value = eval $conv;
- $@ and $evalWarning = $@;
- }
- $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning;
- return undef unless defined $value;
- }
- # handle duplicate tag names
- if (defined $$valueHash{$tag}) {
- # add to list if there is an active list for this tag
- if ($$self{LIST_TAGS}{$tagInfo}) {
- $tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag
- if (defined $$self{NO_LIST}) {
- # accumulate list in TAG_EXTRA "NoList" element
- if (defined $$self{TAG_EXTRA}{$tag}{NoList}) {
- push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value;
- } else {
- $$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ];
- }
- $noListDel = 1; # set flag to delete this tag if re-listed
- } else {
- if (ref $$valueHash{$tag} ne 'ARRAY') {
- $$valueHash{$tag} = [ $$valueHash{$tag} ];
- }
- push @{$$valueHash{$tag}}, $value;
- return $tag; # return without creating a new entry
- }
- }
- # get next available tag key
- my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1;
- my $nextTag = "$tag ($nextInd)";
- #
- # take tag with highest priority
- #
- # promote existing 0-priority tag so it takes precedence over a new 0-tag
- # (unless old tag was a sub-document and new tag isn't)
- my $oldPriority = $$self{PRIORITY}{$tag};
- unless ($oldPriority) {
- if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or
- not $$self{TAG_EXTRA}{$tag}{G3})
- {
- $oldPriority = 1;
- } else {
- $oldPriority = 0; # don't promote sub-document tag over main document
- }
- }
- # set priority for this tag
- if (defined $priority) {
- # increase 0-priority tags if this is the priority directory
- $priority = 1 if not $priority and $$self{DIR_NAME} and
- $$self{DIR_NAME} eq $$self{PRIORITY_DIR};
- } elsif ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}}) {
- $priority = 0; # default is 0 for a LOW_PRIORITY_DIR
- } else {
- $priority = 1; # the normal default
- }
- if ($priority >= $oldPriority and not $$self{DOC_NUM} and not $noListDel) {
- # move existing tag out of the way since this tag is higher priority
- # (NOTE: any new members added here must also be added to DeleteTag())
- $$self{MOVED_KEY} = $nextTag; # used in BuildCompositeTags()
- $$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag};
- $$valueHash{$nextTag} = $$valueHash{$tag};
- $$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag};
- my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag};
- foreach ('TAG_EXTRA','RATIONAL') {
- if ($$self{$_}{$tag}) {
- $$self{$_}{$nextTag} = $$self{$_}{$tag};
- delete $$self{$_}{$tag};
- }
- }
- delete $$self{BOTH}{$tag};
- # update tag key for list if necessary
- $$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo};
- } else {
- $tag = $nextTag; # don't override the existing tag
- }
- $$self{PRIORITY}{$tag} = $priority;
- $$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel;
- } elsif ($priority) {
- # set tag priority (only if exists and is non-zero)
- $$self{PRIORITY}{$tag} = $priority;
- }
- # save the raw value, file order, tagInfo ref, group1 name,
- # and tag key for lists if necessary
- $$valueHash{$tag} = $value;
- $$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND};
- $$self{TAG_INFO}{$tag} = $tagInfo;
- # set dynamic groups 0, 1 and 3 if necessary
- $$self{TAG_EXTRA}{$tag}{G0} = $$self{SET_GROUP0} if $$self{SET_GROUP0};
- $$self{TAG_EXTRA}{$tag}{G1} = $$self{SET_GROUP1} if $$self{SET_GROUP1};
- if ($$self{DOC_NUM}) {
- $$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM};
- if ($$self{DOC_NUM} =~ /^(\d+)/) {
- # keep track of maximum 1st-level sub-document number
- $$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1;
- }
- }
- # save path if requested
- $$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$self{OPTIONS}{SavePath};
- # remember this tagInfo if we will be accumulating values in a list
- # (but don't override earlier list if this may be deleted by NoListDel flag)
- if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) {
- $$self{LIST_TAGS}{$tagInfo} = $tag;
- }
- return $tag;
- }
- #------------------------------------------------------------------------------
- # Make current directory the priority directory if not set already
- # Inputs: 0) ExifTool object reference
- sub SetPriorityDir($)
- {
- my $self = shift;
- $$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR};
- }
- #------------------------------------------------------------------------------
- # Set family 0 or 1 group name specific to this tag instance
- # Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1)
- sub SetGroup($$$;$)
- {
- my ($self, $tagKey, $extra, $fam) = @_;
- $$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra;
- }
- #------------------------------------------------------------------------------
- # Delete specified tag
- # Inputs: 0) ExifTool object ref, 1) tag key
- sub DeleteTag($$)
- {
- my ($self, $tag) = @_;
- delete $$self{VALUE}{$tag};
- delete $$self{FILE_ORDER}{$tag};
- delete $$self{TAG_INFO}{$tag};
- delete $$self{TAG_EXTRA}{$tag};
- delete $$self{PRIORITY}{$tag};
- delete $$self{RATIONAL}{$tag};
- delete $$self{BOTH}{$tag};
- }
- #------------------------------------------------------------------------------
- # Escape all elements of a value
- # Inputs: 0) value, 1) escape proc
- sub DoEscape($$)
- {
- my ($val, $key);
- if (not ref $_[0]) {
- $_[0] = &{$_[1]}($_[0]);
- } elsif (ref $_[0] eq 'ARRAY') {
- foreach $val (@{$_[0]}) {
- DoEscape($val, $_[1]);
- }
- } elsif (ref $_[0] eq 'HASH') {
- foreach $key (keys %{$_[0]}) {
- DoEscape($_[0]{$key}, $_[1]);
- }
- }
- }
- #------------------------------------------------------------------------------
- # Set the FileType and MIMEType tags
- # Inputs: 0) ExifTool object reference
- # 1) Optional file type (uses FILE_TYPE if not specified)
- # 2) Optional MIME type (uses our lookup if not specified)
- # 3) Optional recommended extension (converted to lower case; uses FileType if undef)
- # Notes: Will NOT set file type twice (subsequent calls ignored)
- sub SetFileType($;$$$)
- {
- my ($self, $fileType, $mimeType, $normExt) = @_;
- unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) {
- my $baseType = $$self{FILE_TYPE};
- my $ext = $$self{FILE_EXT};
- $fileType or $fileType = $baseType;
- # handle sub-types which are identified by extension
- if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) {
- my ($f,$e) = @fileTypeLookup{$fileType,$ext};
- if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) {
- # make sure $fileType was a root type and not another sub-type
- $fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]};
- }
- }
- $mimeType or $mimeType = $mimeType{$fileType};
- # use base file type if necessary (except if 'TIFF', which is a special case)
- $mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF';
- unless (defined $normExt) {
- $normExt = $fileTypeExt{$fileType};
- $normExt = $fileType unless defined $normExt;
- }
- $self->FoundTag('FileType', $fileType);
- $self->FoundTag('FileTypeExtension', uc $normExt);
- $self->FoundTag('MIMEType', $mimeType || 'application/unknown');
- }
- }
- #------------------------------------------------------------------------------
- # Override the FileType and MIMEType tags
- # Inputs: 0) ExifTool object ref, 1) file type
- # Notes: does nothing if FileType was not previously defined (ie. when writing)
- sub OverrideFileType($$)
- {
- my ($self, $fileType) = @_;
- if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) {
- $$self{VALUE}{FileType} = $fileType;
- my $normExt = $fileTypeExt{$fileType};
- $normExt = $fileType unless defined $normExt;
- $$self{VALUE}{FileTypeExtension} = uc $normExt;
- # only override MIME type if unique for the derived file type
- $$self{VALUE}{MIMEType} = $mimeType{$fileType} if $mimeType{$fileType};
- if ($$self{OPTIONS}{Verbose}) {
- $self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n");
- $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $$self{VALUE}{MIMEType}\n");
- }
- }
- }
- #------------------------------------------------------------------------------
- # Modify the value of the MIMEType tag
- # Inputs: 0) ExifTool object reference, 1) file or MIME type
- # Notes: combines existing type with new type: ie) a/b + c/d => c/b-d
- sub ModifyMimeType($;$)
- {
- my ($self, $mime) = @_;
- $mime =~ m{/} or $mime = $mimeType{$mime} or return;
- my $old = $$self{VALUE}{MIMEType};
- if (defined $old) {
- my ($a, $b) = split '/', $old;
- my ($c, $d) = split '/', $mime;
- $d =~ s/^x-//;
- $$self{VALUE}{MIMEType} = "$c/$b-$d";
- $self->VPrint(0, " Modified MIMEType = $c/$b-$d\n");
- } else {
- $self->FoundTag('MIMEType', $mime);
- }
- }
- #------------------------------------------------------------------------------
- # Print verbose output
- # Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args
- sub VPrint($$@)
- {
- my $self = shift;
- my $level = shift;
- if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) {
- my $out = $$self{OPTIONS}{TextOut};
- print $out @_;
- print $out "\n" unless $_[-1] =~ /\n$/;
- }
- }
- #------------------------------------------------------------------------------
- # Verbose dump
- # Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options
- sub VerboseDump($$;%)
- {
- my $self = shift;
- my $dataPt = shift;
- if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > 2) {
- my %parms = (
- Prefix => $$self{INDENT},
- Out => $$self{OPTIONS}{TextOut},
- MaxLen => $$self{OPTIONS}{Verbose} < 4 ? 96 : undef,
- );
- HexDump($dataPt, undef, %parms, @_);
- }
- }
- #------------------------------------------------------------------------------
- # Print data in hex
- # Inputs: 0) data
- # Returns: hex string
- # (this is a convenience function for use in debugging PrintConv statements)
- sub PrintHex($)
- {
- my $val = shift;
- return join(' ', unpack('H2' x length($val), $val));
- }
- #------------------------------------------------------------------------------
- # Extract binary data from file
- # 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional
- # Returns: binary data, or undef on error
- # Notes: Returns "Binary data #### bytes" instead of data unless tag is
- # specifically requested or the Binary option is set
- sub ExtractBinary($$$;$)
- {
- my ($self, $offset, $length, $tag) = @_;
- my ($isPreview, $buff);
- if ($tag) {
- if ($tag eq 'PreviewImage') {
- # save PreviewImage start/length in case we want to dump trailer
- $$self{PreviewImageStart} = $offset;
- $$self{PreviewImageLength} = $length;
- $isPreview = 1;
- }
- my $lcTag = lc $tag;
- if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and
- not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag})
- {
- return "Binary data $length bytes";
- }
- }
- unless ($$self{RAF}->Seek($offset,0)
- and $$self{RAF}->Read($buff, $length) == $length)
- {
- $tag or $tag = 'binary data';
- if ($isPreview and not $$self{BuildingComposite}) {
- $$self{PreviewError} = 1;
- } else {
- $self->Warn("Error reading $tag from file", $isPreview);
- }
- return undef;
- }
- return $buff;
- }
- #------------------------------------------------------------------------------
- # Process binary data
- # Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref
- # Returns: 1 on success
- # Notes: dirInfo may contain VarFormatData (reference to empty list) to return
- # details about any variable-length-format tags in the table (used when writing)
- sub ProcessBinaryData($$$)
- {
- my ($self, $dirInfo, $tagTablePtr) = @_;
- my $dataPt = $$dirInfo{DataPt};
- my $offset = $$dirInfo{DirStart} || 0;
- my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset);
- my $base = $$dirInfo{Base} || 0;
- my $verbose = $$self{OPTIONS}{Verbose};
- my $unknown = $$self{OPTIONS}{Unknown};
- my $dataPos = $$dirInfo{DataPos} || 0;
- # get default format ('int8u' unless specified)
- my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u';
- my $increment = $formatSize{$defaultFormat};
- unless ($increment) {
- warn "Unknown format $defaultFormat\n";
- $defaultFormat = 'int8u';
- $increment = $formatSize{$defaultFormat};
- }
- # prepare list of tag numbers to extract
- my (@tags, $topIndex);
- if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) {
- # don't create a stupid number of tags if data is huge
- my $sizeLimit = $size < 65536 ? $size : 65536;
- # scan through entire binary table
- $topIndex = int($sizeLimit/$increment);
- @tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1));
- # add in floating point tag ID's if they exist
- my @ftags = grep /\./, TagTableKeys($tagTablePtr);
- @tags = sort { $a <=> $b } @tags, @ftags if @ftags;
- } elsif ($$dirInfo{DataMember}) {
- @tags = @{$$dirInfo{DataMember}};
- $verbose = 0; # no verbose output of extracted values when writing
- } elsif ($$dirInfo{MixedTags}) {
- # process sorted integer-ID tags only
- @tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr);
- } else {
- # extract known tags in numerical order
- @tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr);
- }
- $self->VerboseDir('BinaryData', undef, $size) if $verbose;
- # avoid creating unknown tags for tags that fail condition if Unknown is 1
- $$self{NO_UNKNOWN} = 1 if $unknown < 2;
- my ($index, %val);
- my $nextIndex = 0;
- my $varSize = 0;
- foreach $index (@tags) {
- my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational);
- if ($$tagTablePtr{$index}) {
- $tagInfo = $self->GetTagInfo($tagTablePtr, $index);
- unless ($tagInfo) {
- next unless defined $tagInfo;
- my $entry = int($index) * $increment + $varSize;
- if ($entry < 0) {
- $entry += $size;
- next if $entry < 0;
- }
- next if $entry >= $size;
- my $more = $size - $entry;
- $more = 128 if $more > 128;
- my $v = substr($$dataPt, $entry+$offset, $more);
- $tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v);
- next unless $tagInfo;
- }
- next if $$tagInfo{Unknown} and
- ($$tagInfo{Unknown} > $unknown or $index < $nextIndex);
- } elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) {
- $tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next;
- } else {
- # don't generate unknown tags in binary tables unless Unknown > 1
- next unless $unknown > 1;
- next if $index < $nextIndex; # skip if data already used
- $tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
- $$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns
- }
- # get relative offset of this entry
- my $entry = int($index) * $increment + $varSize;
- # allow negative indices to represent bytes from end
- if ($entry < 0) {
- $entry += $size;
- next if $entry < 0;
- }
- my $more = $size - $entry;
- last if $more <= 0; # all done if we have reached the end of data
- my $count = 1;
- my $format = $$tagInfo{Format};
- if (not $format) {
- $format = $defaultFormat;
- } elsif ($format eq 'string') {
- # string with no specified count runs to end of block
- $count = $more;
- } elsif ($format eq 'pstring') {
- $format = 'string';
- $count = Get8u($dataPt, ($entry++)+$offset);
- --$more;
- } elsif (not $formatSize{$format}) {
- if ($format =~ /(.*)\[(.*)\]/) {
- # handle format count field
- $format = $1;
- $count = $2;
- # evaluate count to allow count to be based on previous values
- #### eval Format size (%val, $size, $self)
- $count = eval $count;
- $@ and warn("Format $$tagInfo{Name}: $@"), next;
- next if $count < 0;
- # allow a variable-length value of any format
- # (note: the next incremental index points to data immediately after
- # this value, regardless of the size of this value, even if it is zero)
- if ($format =~ s/^var_//) {
- $varSize += $count * ($formatSize{$format} || 1) - $increment;
- $wasVar = 1;
- # save variable size data if required for writing
- if ($$dirInfo{VarFormatData}) {
- push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
- }
- # don't extract value if large and we wanted it just to get
- # the variable-format information when writing
- next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData};
- }
- } elsif ($format =~ /^var_/) {
- # handle variable-length string formats
- $format = substr($format, 4);
- pos($$dataPt) = $entry + $offset;
- undef $count;
- if ($format eq 'ustring') {
- $count = pos($$dataPt) - ($entry+$offset) if $$dataPt =~ /\G(..)*?\0\0/sg;
- $varSize -= 2; # ($count includes base size of 2 bytes)
- } elsif ($format eq 'pstring') {
- $count = Get8u($dataPt, ($entry++)+$offset);
- --$more;
- } elsif ($format eq 'pstr32') {
- last if $more < 4;
- $count = Get32u($dataPt, $entry + $offset);
- $entry += 4;
- $more -= 4;
- } elsif ($format eq 'int16u') {
- # int16u size of binary data to follow
- last if $more < 2;
- $count = Get16u($dataPt, $entry + $offset) + 2;
- $varSize -= 2; # ($count includes size word)
- $format = 'undef';
- } elsif ($$dataPt =~ /\0/g) {
- $count = pos($$dataPt) - ($entry+$offset);
- --$varSize; # ($count includes base size of 1 byte)
- }
- $count = $more if not defined $count or $count > $more;
- $varSize += $count; # shift subsequent indices
- $val = substr($$dataPt, $entry+$offset, $count);
- $val = $self->Decode($val, 'UCS2') if $format eq 'ustring';
- $val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null
- $wasVar = 1;
- # save variable size data if required for writing
- if ($$dirInfo{VarFormatData}) {
- push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
- }
- }
- }
- # hook to allow format, etc to be set dynamically
- if (defined $$tagInfo{Hook}) {
- #### eval Hook ($format, $varSize, $size)
- eval $$tagInfo{Hook};
- # save variable size data if required for writing (in case changed by Hook)
- if ($$dirInfo{VarFormatData}) {
- $#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag
- push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
- }
- }
- if ($unknown > 1) {
- # calculate next valid index for unknown tag
- my $ni = int $index;
- $ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar;
- $saveNextIndex = $nextIndex;
- $nextIndex = $ni unless $nextIndex > $ni;
- }
- # allow large tags to be excluded from extraction
- # (provides a work-around for some tight memory situations)
- next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}};
- # read value now if necessary
- unless (defined $val and not $$tagInfo{SubDirectory}) {
- $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational);
- $mask = $$tagInfo{Mask};
- $val &= $mask if $mask;
- }
- if ($verbose and not $$tagInfo{Hidden}) {
- if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) {
- $len = $count * ($formatSize{$format} || 1);
- $len = $more if $len > $more;
- } else {
- $len = $more;
- }
- $self->VerboseInfo($index, $tagInfo,
- Table => $tagTablePtr,
- Value => $val,
- DataPt => $dataPt,
- Size => $len,
- Start => $entry+$offset,
- Addr => $entry+$offset+$base+$dataPos,
- Format => $format,
- Count => $count,
- Extra => $mask ? sprintf(', mask 0x%.2x',$mask) : undef,
- );
- }
- # parse nested BinaryData directories
- if ($$tagInfo{SubDirectory}) {
- my $subdir = $$tagInfo{SubDirectory};
- my $subTablePtr = GetTagTable($$subdir{TagTable});
- # use specified subdirectory length if given
- if ($$tagInfo{Format} and $formatSize{$format}) {
- $len = $count * $formatSize{$format};
- $len = $more if $len > $more;
- } else {
- $len = $more; # directory size is all of remaining data
- if ($$subTablePtr{PROCESS_PROC} and
- $$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData)
- {
- # the rest of the data will be printed in the subdirectory
- $nextIndex = $size / $increment;
- }
- }
- my $subdirBase = $base;
- if (defined $$subdir{Base}) {
- #### eval Base ($start,$base)
- my $start = $entry + $offset + $dataPos;
- $subdirBase = eval($$subdir{Base}) + $base;
- }
- my $start = $$subdir{Start} || 0;
- my %subdirInfo = (
- DataPt => $dataPt,
- DataPos => $dataPos,
- DataLen => length $$dataPt,
- DirStart => $entry + $offset + $start,
- DirLen => $len - $start,
- Base => $subdirBase,
- );
- delete $$self{NO_UNKNOWN};
- $self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc});
- $$self{NO_UNKNOWN} = 1 if $unknown < 2;
- next;
- }
- if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') {
- my $et = $self;
- #### eval IsOffset ($val, $et)
- $val += $base + $$self{BASE} if eval $$tagInfo{IsOffset};
- }
- $val{$index} = $val;
- my $oldBase;
- if ($$tagInfo{SetBase}) {
- $oldBase = $$self{BASE};
- $$self{BASE} += $base;
- }
- my $key = $self->FoundTag($tagInfo,$val);
- $$self{BASE} = $oldBase if defined $oldBase;
- if ($key) {
- $$self{RATIONAL}{$key} = $rational if defined $rational;
- } else {
- # don't increment nextIndex if we didn't extract a tag
- $nextIndex = $saveNextIndex if defined $saveNextIndex;
- }
- }
- delete $$self{NO_UNKNOWN};
- return 1;
- }
- #..............................................................................
- # Load .ExifTool_config file from user's home directory
- # (use of noConfig is now deprecated, use configFile = '' instead)
- until ($Image::ExifTool::noConfig) {
- my $file = $Image::ExifTool::configFile;
- if (not defined $file) {
- my $config = '.ExifTool_config';
- # get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell)
- my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} ||
- ($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.';
- # look for the config file in 1) the home directory, 2) the program dir
- $file = "$home/$config";
- -r $file or $file = ($0 =~ /(.*[\\\/])/ ? $1 : './') . $config;
- -r $file or last;
- } else {
- length $file or last; # filename of "" disables configuration
- -r $file or warn("Config file not found\n"), last;
- }
- eval { require $file }; # load the config file
- # print warning (minus "Compilation failed" part)
- $@ and $_=$@, s/Compilation failed.*//s, warn $_;
- last;
- }
- # read user-defined lenses (may have been defined by script instead of config file)
- if (@Image::ExifTool::UserDefined::Lenses) {
- foreach (@Image::ExifTool::UserDefined::Lenses) {
- $Image::ExifTool::userLens{$_} = 1;
- }
- }
- # add user-defined file types
- if (%Image::ExifTool::UserDefined::FileTypes) {
- foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) {
- my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_};
- my $type = uc $_;
- ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next;
- if ($$fileInfo{BaseType}) {
- if ($$fileInfo{Description}) {
- $fileTypeLookup{$type} = [ $$fileInfo{BaseType}, $$fileInfo{Description} ];
- } else {
- $fileTypeLookup{$type} = $$fileInfo{BaseType};
- }
- } else {
- $fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ];
- $moduleName{$type} = 0; # not supported
- if ($$fileInfo{Magic}) {
- $magicNumber{$type} = $$fileInfo{Magic};
- push @fileTypes, $type unless grep /^$type$/, @fileTypes;
- }
- }
- $mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType};
- }
- }
- #------------------------------------------------------------------------------
- 1; # end
|