Worksheet.pm 218 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662
  1. # DISCLAIMER OF WARRANTY
  2. # Because this software is licensed free of charge, there is no warranty for the software,
  3. # to the extent permitted by applicable law. Except when otherwise stated in writing
  4. # the copyright holders and/or other parties provide the software "as is" without
  5. # warranty of any kind, either expressed or implied, including, but not limited to,
  6. # the implied warranties of merchantability and fitness for a particular purpose.
  7. # The entire risk as to the quality and performance of the software is with you.
  8. # Should the software prove defective, you assume the cost of all necessary
  9. # servicing, repair, or correction.
  10. # In no event unless required by applicable law or agreed to in writing will any
  11. # copyright holder, or any other party who may modify and/or redistribute the software
  12. # as permitted by the above licence, be liable to you for damages, including any general,
  13. # special, incidental, or consequential damages arising out of the use or inability
  14. # to use the software (including but not limited to loss of data or data being rendered
  15. # inaccurate or losses sustained by you or third parties or a failure of the software
  16. # to operate with any other software), even if such holder or other party
  17. # has been advised of the possibility of such damages.
  18. # AUTHOR
  19. # John McNamara jmcnamara@cpan.org
  20. # COPYRIGHT
  21. # Copyright MM-MMX, John McNamara.
  22. # All Rights Reserved. This module is free software. It may be used,
  23. # redistributed and/or modified under the terms of
  24. # the Artistic License(full text of the Artistic License http://dev.perl.org/licenses/artistic.html).
  25. package Spreadsheet::WriteExcel::Worksheet;
  26. ###############################################################################
  27. #
  28. # Worksheet - A writer class for Excel Worksheets.
  29. #
  30. #
  31. # Used in conjunction with Spreadsheet::WriteExcel
  32. #
  33. # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
  34. #
  35. # Documentation after __END__
  36. #
  37. use Exporter;
  38. use strict;
  39. use Carp;
  40. use Spreadsheet::WriteExcel::BIFFwriter;
  41. use Spreadsheet::WriteExcel::Format;
  42. use Spreadsheet::WriteExcel::Formula;
  43. use vars qw($VERSION @ISA);
  44. @ISA = qw(Spreadsheet::WriteExcel::BIFFwriter);
  45. $VERSION = '2.37';
  46. ###############################################################################
  47. #
  48. # new()
  49. #
  50. # Constructor. Creates a new Worksheet object from a BIFFwriter object
  51. #
  52. sub new {
  53. my $class = shift;
  54. my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
  55. my $rowmax = 65536;
  56. my $colmax = 256;
  57. my $strmax = 0;
  58. $self->{_name} = $_[0];
  59. $self->{_index} = $_[1];
  60. $self->{_encoding} = $_[2];
  61. $self->{_activesheet} = $_[3];
  62. $self->{_firstsheet} = $_[4];
  63. $self->{_url_format} = $_[5];
  64. $self->{_parser} = $_[6];
  65. $self->{_tempdir} = $_[7];
  66. $self->{_str_total} = $_[8];
  67. $self->{_str_unique} = $_[9];
  68. $self->{_str_table} = $_[10];
  69. $self->{_1904} = $_[11];
  70. $self->{_compatibility} = $_[12];
  71. $self->{_palette} = $_[13];
  72. $self->{_sheet_type} = 0x0000;
  73. $self->{_ext_sheets} = [];
  74. $self->{_using_tmpfile} = 1;
  75. $self->{_filehandle} = "";
  76. $self->{_fileclosed} = 0;
  77. $self->{_offset} = 0;
  78. $self->{_xls_rowmax} = $rowmax;
  79. $self->{_xls_colmax} = $colmax;
  80. $self->{_xls_strmax} = $strmax;
  81. $self->{_dim_rowmin} = undef;
  82. $self->{_dim_rowmax} = undef;
  83. $self->{_dim_colmin} = undef;
  84. $self->{_dim_colmax} = undef;
  85. $self->{_colinfo} = [];
  86. $self->{_selection} = [0, 0];
  87. $self->{_panes} = [];
  88. $self->{_active_pane} = 3;
  89. $self->{_frozen} = 0;
  90. $self->{_frozen_no_split} = 1;
  91. $self->{_selected} = 0;
  92. $self->{_hidden} = 0;
  93. $self->{_active} = 0;
  94. $self->{_tab_color} = 0;
  95. $self->{_first_row} = 0;
  96. $self->{_first_col} = 0;
  97. $self->{_display_formulas} = 0;
  98. $self->{_display_headers} = 1;
  99. $self->{_display_zeros} = 1;
  100. $self->{_display_arabic} = 0;
  101. $self->{_paper_size} = 0x0;
  102. $self->{_orientation} = 0x1;
  103. $self->{_header} = '';
  104. $self->{_footer} = '';
  105. $self->{_header_encoding} = 0;
  106. $self->{_footer_encoding} = 0;
  107. $self->{_hcenter} = 0;
  108. $self->{_vcenter} = 0;
  109. $self->{_margin_header} = 0.50;
  110. $self->{_margin_footer} = 0.50;
  111. $self->{_margin_left} = 0.75;
  112. $self->{_margin_right} = 0.75;
  113. $self->{_margin_top} = 1.00;
  114. $self->{_margin_bottom} = 1.00;
  115. $self->{_title_rowmin} = undef;
  116. $self->{_title_rowmax} = undef;
  117. $self->{_title_colmin} = undef;
  118. $self->{_title_colmax} = undef;
  119. $self->{_print_rowmin} = undef;
  120. $self->{_print_rowmax} = undef;
  121. $self->{_print_colmin} = undef;
  122. $self->{_print_colmax} = undef;
  123. $self->{_print_gridlines} = 1;
  124. $self->{_screen_gridlines} = 1;
  125. $self->{_print_headers} = 0;
  126. $self->{_page_order} = 0;
  127. $self->{_black_white} = 0;
  128. $self->{_draft_quality} = 0;
  129. $self->{_print_comments} = 0;
  130. $self->{_page_start} = 1;
  131. $self->{_custom_start} = 0;
  132. $self->{_fit_page} = 0;
  133. $self->{_fit_width} = 0;
  134. $self->{_fit_height} = 0;
  135. $self->{_hbreaks} = [];
  136. $self->{_vbreaks} = [];
  137. $self->{_protect} = 0;
  138. $self->{_password} = undef;
  139. $self->{_col_sizes} = {};
  140. $self->{_row_sizes} = {};
  141. $self->{_col_formats} = {};
  142. $self->{_row_formats} = {};
  143. $self->{_zoom} = 100;
  144. $self->{_print_scale} = 100;
  145. $self->{_page_view} = 0;
  146. $self->{_leading_zeros} = 0;
  147. $self->{_outline_row_level} = 0;
  148. $self->{_outline_style} = 0;
  149. $self->{_outline_below} = 1;
  150. $self->{_outline_right} = 1;
  151. $self->{_outline_on} = 1;
  152. $self->{_write_match} = [];
  153. $self->{_object_ids} = [];
  154. $self->{_images} = {};
  155. $self->{_images_array} = [];
  156. $self->{_charts} = {};
  157. $self->{_charts_array} = [];
  158. $self->{_comments} = {};
  159. $self->{_comments_array} = [];
  160. $self->{_comments_author} = '';
  161. $self->{_comments_author_enc} = 0;
  162. $self->{_comments_visible} = 0;
  163. $self->{_filter_area} = [];
  164. $self->{_filter_count} = 0;
  165. $self->{_filter_on} = 0;
  166. $self->{_writing_url} = 0;
  167. $self->{_db_indices} = [];
  168. $self->{_validations} = [];
  169. bless $self, $class;
  170. $self->_initialize();
  171. return $self;
  172. }
  173. ###############################################################################
  174. #
  175. # _initialize()
  176. #
  177. # Open a tmp file to store the majority of the Worksheet data. If this fails,
  178. # for example due to write permissions, store the data in memory. This can be
  179. # slow for large files.
  180. #
  181. sub _initialize {
  182. my $self = shift;
  183. my $fh;
  184. my $tmp_dir;
  185. # The following code is complicated by Windows limitations. Porters can
  186. # choose a more direct method.
  187. # In the default case we use IO::File->new_tmpfile(). This may fail, in
  188. # particular with IIS on Windows, so we allow the user to specify a temp
  189. # directory via File::Temp.
  190. #
  191. if (defined $self->{_tempdir}) {
  192. # Delay loading File:Temp to reduce the module dependencies.
  193. eval { require File::Temp };
  194. die "The File::Temp module must be installed in order ".
  195. "to call set_tempdir().\n" if $@;
  196. # Trap but ignore File::Temp errors.
  197. eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
  198. # Store the failed tmp dir in case of errors.
  199. $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
  200. }
  201. else {
  202. $fh = IO::File->new_tmpfile();
  203. # Store the failed tmp dir in case of errors.
  204. $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
  205. }
  206. # Check if the temp file creation was successful. Else store data in memory.
  207. if ($fh) {
  208. # binmode file whether platform requires it or not.
  209. binmode($fh);
  210. # Store filehandle
  211. $self->{_filehandle} = $fh;
  212. }
  213. else {
  214. # Set flag to store data in memory if XX::tempfile() failed.
  215. $self->{_using_tmpfile} = 0;
  216. if ($self->{_index} == 0 && $^W) {
  217. my $dir = $self->{_tempdir} || File::Spec->tmpdir();
  218. warn "Unable to create temp files in $tmp_dir. Data will be ".
  219. "stored in memory. Refer to set_tempdir() in the ".
  220. "Spreadsheet::WriteExcel documentation.\n" ;
  221. }
  222. }
  223. }
  224. ###############################################################################
  225. #
  226. # _close()
  227. #
  228. # Add data to the beginning of the workbook (note the reverse order)
  229. # and to the end of the workbook.
  230. #
  231. sub _close {
  232. my $self = shift;
  233. ################################################
  234. # Prepend in reverse order!!
  235. #
  236. # Prepend the sheet dimensions
  237. $self->_store_dimensions();
  238. # Prepend the autofilter filters.
  239. $self->_store_autofilters;
  240. # Prepend the sheet autofilter info.
  241. $self->_store_autofilterinfo();
  242. # Prepend the sheet filtermode record.
  243. $self->_store_filtermode();
  244. # Prepend the COLINFO records if they exist
  245. if (@{$self->{_colinfo}}){
  246. my @colinfo = @{$self->{_colinfo}};
  247. while (@colinfo) {
  248. my $arrayref = pop @colinfo;
  249. $self->_store_colinfo(@$arrayref);
  250. }
  251. }
  252. # Prepend the DEFCOLWIDTH record
  253. $self->_store_defcol();
  254. # Prepend the sheet password
  255. $self->_store_password();
  256. # Prepend the sheet protection
  257. $self->_store_protect();
  258. $self->_store_obj_protect();
  259. # Prepend the page setup
  260. $self->_store_setup();
  261. # Prepend the bottom margin
  262. $self->_store_margin_bottom();
  263. # Prepend the top margin
  264. $self->_store_margin_top();
  265. # Prepend the right margin
  266. $self->_store_margin_right();
  267. # Prepend the left margin
  268. $self->_store_margin_left();
  269. # Prepend the page vertical centering
  270. $self->_store_vcenter();
  271. # Prepend the page horizontal centering
  272. $self->_store_hcenter();
  273. # Prepend the page footer
  274. $self->_store_footer();
  275. # Prepend the page header
  276. $self->_store_header();
  277. # Prepend the vertical page breaks
  278. $self->_store_vbreak();
  279. # Prepend the horizontal page breaks
  280. $self->_store_hbreak();
  281. # Prepend WSBOOL
  282. $self->_store_wsbool();
  283. # Prepend the default row height.
  284. $self->_store_defrow();
  285. # Prepend GUTS
  286. $self->_store_guts();
  287. # Prepend GRIDSET
  288. $self->_store_gridset();
  289. # Prepend PRINTGRIDLINES
  290. $self->_store_print_gridlines();
  291. # Prepend PRINTHEADERS
  292. $self->_store_print_headers();
  293. #
  294. # End of prepend. Read upwards from here.
  295. ################################################
  296. # Append
  297. $self->_store_table();
  298. $self->_store_images();
  299. $self->_store_charts();
  300. $self->_store_filters();
  301. $self->_store_comments();
  302. $self->_store_window2();
  303. $self->_store_page_view();
  304. $self->_store_zoom();
  305. $self->_store_panes(@{$self->{_panes}}) if @{$self->{_panes}};
  306. $self->_store_selection(@{$self->{_selection}});
  307. $self->_store_validation_count();
  308. $self->_store_validations();
  309. $self->_store_tab_color();
  310. $self->_store_eof();
  311. # Prepend the BOF and INDEX records
  312. $self->_store_index();
  313. $self->_store_bof(0x0010);
  314. }
  315. ###############################################################################
  316. #
  317. # _compatibility_mode()
  318. #
  319. # Set the compatibility mode.
  320. #
  321. # See the explanation in Workbook::compatibility_mode(). This private method
  322. # is mainly used for test purposes.
  323. #
  324. sub _compatibility_mode {
  325. my $self = shift;
  326. if (defined($_[0])) {
  327. $self->{_compatibility} = $_[0];
  328. }
  329. else {
  330. $self->{_compatibility} = 1;
  331. }
  332. }
  333. ###############################################################################
  334. #
  335. # get_name().
  336. #
  337. # Retrieve the worksheet name.
  338. #
  339. # Note, there is no set_name() method because names are used in formulas and
  340. # converted to internal indices. Allowing the user to change sheet names
  341. # after they have been set in add_worksheet() is asking for trouble.
  342. #
  343. sub get_name {
  344. my $self = shift;
  345. return $self->{_name};
  346. }
  347. ###############################################################################
  348. #
  349. # get_data().
  350. #
  351. # Retrieves data from memory in one chunk, or from disk in $buffer
  352. # sized chunks.
  353. #
  354. sub get_data {
  355. my $self = shift;
  356. my $buffer = 4096;
  357. my $tmp;
  358. # Return data stored in memory
  359. if (defined $self->{_data}) {
  360. $tmp = $self->{_data};
  361. $self->{_data} = undef;
  362. my $fh = $self->{_filehandle};
  363. seek($fh, 0, 0) if $self->{_using_tmpfile};
  364. return $tmp;
  365. }
  366. # Return data stored on disk
  367. if ($self->{_using_tmpfile}) {
  368. return $tmp if read($self->{_filehandle}, $tmp, $buffer);
  369. }
  370. # No data to return
  371. return undef;
  372. }
  373. ###############################################################################
  374. #
  375. # select()
  376. #
  377. # Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
  378. # highlighted.
  379. #
  380. sub select {
  381. my $self = shift;
  382. $self->{_hidden} = 0; # Selected worksheet can't be hidden.
  383. $self->{_selected} = 1;
  384. }
  385. ###############################################################################
  386. #
  387. # activate()
  388. #
  389. # Set this worksheet as the active worksheet, i.e. the worksheet that is
  390. # displayed when the workbook is opened. Also set it as selected.
  391. #
  392. sub activate {
  393. my $self = shift;
  394. $self->{_hidden} = 0; # Active worksheet can't be hidden.
  395. $self->{_selected} = 1;
  396. ${$self->{_activesheet}} = $self->{_index};
  397. }
  398. ###############################################################################
  399. #
  400. # hide()
  401. #
  402. # Hide this worksheet.
  403. #
  404. sub hide {
  405. my $self = shift;
  406. $self->{_hidden} = 1;
  407. # A hidden worksheet shouldn't be active or selected.
  408. $self->{_selected} = 0;
  409. ${$self->{_activesheet}} = 0;
  410. ${$self->{_firstsheet}} = 0;
  411. }
  412. ###############################################################################
  413. #
  414. # set_first_sheet()
  415. #
  416. # Set this worksheet as the first visible sheet. This is necessary
  417. # when there are a large number of worksheets and the activated
  418. # worksheet is not visible on the screen.
  419. #
  420. sub set_first_sheet {
  421. my $self = shift;
  422. $self->{_hidden} = 0; # Active worksheet can't be hidden.
  423. ${$self->{_firstsheet}} = $self->{_index};
  424. }
  425. ###############################################################################
  426. #
  427. # protect($password)
  428. #
  429. # Set the worksheet protection flag to prevent accidental modification and to
  430. # hide formulas if the locked and hidden format properties have been set.
  431. #
  432. sub protect {
  433. my $self = shift;
  434. $self->{_protect} = 1;
  435. $self->{_password} = $self->_encode_password($_[0]) if defined $_[0];
  436. }
  437. ###############################################################################
  438. #
  439. # set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
  440. #
  441. # Set the width of a single column or a range of columns.
  442. # See also: _store_colinfo
  443. #
  444. sub set_column {
  445. my $self = shift;
  446. my @data = @_;
  447. my $cell = $data[0];
  448. # Check for a cell reference in A1 notation and substitute row and column
  449. if ($cell =~ /^\D/) {
  450. @data = $self->_substitute_cellref(@_);
  451. # Returned values $row1 and $row2 aren't required here. Remove them.
  452. shift @data; # $row1
  453. splice @data, 1, 1; # $row2
  454. }
  455. return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
  456. return if not defined $data[0]; # Columns must be defined.
  457. return if not defined $data[1];
  458. # Assume second column is the same as first if 0. Avoids KB918419 bug.
  459. $data[1] = $data[0] if $data[1] == 0;
  460. # Ensure 2nd col is larger than first. Also for KB918419 bug.
  461. ($data[0], $data[1]) = ($data[1], $data[0]) if $data[0] > $data[1];
  462. # Limit columns to Excel max of 255.
  463. $data[0] = 255 if $data[0] > 255;
  464. $data[1] = 255 if $data[1] > 255;
  465. push @{$self->{_colinfo}}, [ @data ];
  466. # Store the col sizes for use when calculating image vertices taking
  467. # hidden columns into account. Also store the column formats.
  468. #
  469. my $width = $data[4] ? 0 : $data[2]; # Set width to zero if col is hidden
  470. $width ||= 0; # Ensure width isn't undef.
  471. my $format = $data[3];
  472. my ($firstcol, $lastcol) = @data;
  473. foreach my $col ($firstcol .. $lastcol) {
  474. $self->{_col_sizes}->{$col} = $width;
  475. $self->{_col_formats}->{$col} = $format if defined $format;
  476. }
  477. }
  478. ###############################################################################
  479. #
  480. # set_selection()
  481. #
  482. # Set which cell or cells are selected in a worksheet: see also the
  483. # sub _store_selection
  484. #
  485. sub set_selection {
  486. my $self = shift;
  487. # Check for a cell reference in A1 notation and substitute row and column
  488. if ($_[0] =~ /^\D/) {
  489. @_ = $self->_substitute_cellref(@_);
  490. }
  491. $self->{_selection} = [ @_ ];
  492. }
  493. ###############################################################################
  494. #
  495. # freeze_panes()
  496. #
  497. # Set panes and mark them as frozen. See also _store_panes().
  498. #
  499. sub freeze_panes {
  500. my $self = shift;
  501. # Check for a cell reference in A1 notation and substitute row and column
  502. if ($_[0] =~ /^\D/) {
  503. @_ = $self->_substitute_cellref(@_);
  504. }
  505. # Extra flag indicated a split and freeze.
  506. $self->{_frozen_no_split} = 0 if $_[4];
  507. $self->{_frozen} = 1;
  508. $self->{_panes} = [ @_ ];
  509. }
  510. ###############################################################################
  511. #
  512. # split_panes()
  513. #
  514. # Set panes and mark them as split. See also _store_panes().
  515. #
  516. sub split_panes {
  517. my $self = shift;
  518. $self->{_frozen} = 0;
  519. $self->{_frozen_no_split} = 0;
  520. $self->{_panes} = [ @_ ];
  521. }
  522. # Older method name for backwards compatibility.
  523. *thaw_panes = *split_panes;
  524. ###############################################################################
  525. #
  526. # set_portrait()
  527. #
  528. # Set the page orientation as portrait.
  529. #
  530. sub set_portrait {
  531. my $self = shift;
  532. $self->{_orientation} = 1;
  533. }
  534. ###############################################################################
  535. #
  536. # set_landscape()
  537. #
  538. # Set the page orientation as landscape.
  539. #
  540. sub set_landscape {
  541. my $self = shift;
  542. $self->{_orientation} = 0;
  543. }
  544. ###############################################################################
  545. #
  546. # set_page_view()
  547. #
  548. # Set the page view mode for Mac Excel.
  549. #
  550. sub set_page_view {
  551. my $self = shift;
  552. $self->{_page_view} = defined $_[0] ? $_[0] : 1;
  553. }
  554. ###############################################################################
  555. #
  556. # set_tab_color()
  557. #
  558. # Set the colour of the worksheet colour.
  559. #
  560. sub set_tab_color {
  561. my $self = shift;
  562. my $color = &Spreadsheet::WriteExcel::Format::_get_color($_[0]);
  563. $color = 0 if $color == 0x7FFF; # Default color.
  564. $self->{_tab_color} = $color;
  565. }
  566. ###############################################################################
  567. #
  568. # set_paper()
  569. #
  570. # Set the paper type. Ex. 1 = US Letter, 9 = A4
  571. #
  572. sub set_paper {
  573. my $self = shift;
  574. $self->{_paper_size} = $_[0] || 0;
  575. }
  576. ###############################################################################
  577. #
  578. # set_header()
  579. #
  580. # Set the page header caption and optional margin.
  581. #
  582. sub set_header {
  583. my $self = shift;
  584. my $string = $_[0] || '';
  585. my $margin = $_[1] || 0.50;
  586. my $encoding = $_[2] || 0;
  587. # Handle utf8 strings in perl 5.8.
  588. if ($] >= 5.008) {
  589. require Encode;
  590. if (Encode::is_utf8($string)) {
  591. $string = Encode::encode("UTF-16BE", $string);
  592. $encoding = 1;
  593. }
  594. }
  595. my $limit = $encoding ? 255 *2 : 255;
  596. if (length $string >= $limit) {
  597. carp 'Header string must be less than 255 characters';
  598. return;
  599. }
  600. $self->{_header} = $string;
  601. $self->{_margin_header} = $margin;
  602. $self->{_header_encoding} = $encoding;
  603. }
  604. ###############################################################################
  605. #
  606. # set_footer()
  607. #
  608. # Set the page footer caption and optional margin.
  609. #
  610. sub set_footer {
  611. my $self = shift;
  612. my $string = $_[0] || '';
  613. my $margin = $_[1] || 0.50;
  614. my $encoding = $_[2] || 0;
  615. # Handle utf8 strings in perl 5.8.
  616. if ($] >= 5.008) {
  617. require Encode;
  618. if (Encode::is_utf8($string)) {
  619. $string = Encode::encode("UTF-16BE", $string);
  620. $encoding = 1;
  621. }
  622. }
  623. my $limit = $encoding ? 255 *2 : 255;
  624. if (length $string >= $limit) {
  625. carp 'Footer string must be less than 255 characters';
  626. return;
  627. }
  628. $self->{_footer} = $string;
  629. $self->{_margin_footer} = $margin;
  630. $self->{_footer_encoding} = $encoding;
  631. }
  632. ###############################################################################
  633. #
  634. # center_horizontally()
  635. #
  636. # Center the page horizontally.
  637. #
  638. sub center_horizontally {
  639. my $self = shift;
  640. if (defined $_[0]) {
  641. $self->{_hcenter} = $_[0];
  642. }
  643. else {
  644. $self->{_hcenter} = 1;
  645. }
  646. }
  647. ###############################################################################
  648. #
  649. # center_vertically()
  650. #
  651. # Center the page horizontally.
  652. #
  653. sub center_vertically {
  654. my $self = shift;
  655. if (defined $_[0]) {
  656. $self->{_vcenter} = $_[0];
  657. }
  658. else {
  659. $self->{_vcenter} = 1;
  660. }
  661. }
  662. ###############################################################################
  663. #
  664. # set_margins()
  665. #
  666. # Set all the page margins to the same value in inches.
  667. #
  668. sub set_margins {
  669. my $self = shift;
  670. $self->set_margin_left($_[0]);
  671. $self->set_margin_right($_[0]);
  672. $self->set_margin_top($_[0]);
  673. $self->set_margin_bottom($_[0]);
  674. }
  675. ###############################################################################
  676. #
  677. # set_margins_LR()
  678. #
  679. # Set the left and right margins to the same value in inches.
  680. #
  681. sub set_margins_LR {
  682. my $self = shift;
  683. $self->set_margin_left($_[0]);
  684. $self->set_margin_right($_[0]);
  685. }
  686. ###############################################################################
  687. #
  688. # set_margins_TB()
  689. #
  690. # Set the top and bottom margins to the same value in inches.
  691. #
  692. sub set_margins_TB {
  693. my $self = shift;
  694. $self->set_margin_top($_[0]);
  695. $self->set_margin_bottom($_[0]);
  696. }
  697. ###############################################################################
  698. #
  699. # set_margin_left()
  700. #
  701. # Set the left margin in inches.
  702. #
  703. sub set_margin_left {
  704. my $self = shift;
  705. $self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
  706. }
  707. ###############################################################################
  708. #
  709. # set_margin_right()
  710. #
  711. # Set the right margin in inches.
  712. #
  713. sub set_margin_right {
  714. my $self = shift;
  715. $self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
  716. }
  717. ###############################################################################
  718. #
  719. # set_margin_top()
  720. #
  721. # Set the top margin in inches.
  722. #
  723. sub set_margin_top {
  724. my $self = shift;
  725. $self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
  726. }
  727. ###############################################################################
  728. #
  729. # set_margin_bottom()
  730. #
  731. # Set the bottom margin in inches.
  732. #
  733. sub set_margin_bottom {
  734. my $self = shift;
  735. $self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
  736. }
  737. ###############################################################################
  738. #
  739. # repeat_rows($first_row, $last_row)
  740. #
  741. # Set the rows to repeat at the top of each printed page. See also the
  742. # _store_name_xxxx() methods in Workbook.pm.
  743. #
  744. sub repeat_rows {
  745. my $self = shift;
  746. $self->{_title_rowmin} = $_[0];
  747. $self->{_title_rowmax} = $_[1] || $_[0]; # Second row is optional
  748. }
  749. ###############################################################################
  750. #
  751. # repeat_columns($first_col, $last_col)
  752. #
  753. # Set the columns to repeat at the left hand side of each printed page.
  754. # See also the _store_names() methods in Workbook.pm.
  755. #
  756. sub repeat_columns {
  757. my $self = shift;
  758. # Check for a cell reference in A1 notation and substitute row and column
  759. if ($_[0] =~ /^\D/) {
  760. @_ = $self->_substitute_cellref(@_);
  761. # Returned values $row1 and $row2 aren't required here. Remove them.
  762. shift @_; # $row1
  763. splice @_, 1, 1; # $row2
  764. }
  765. $self->{_title_colmin} = $_[0];
  766. $self->{_title_colmax} = $_[1] || $_[0]; # Second col is optional
  767. }
  768. ###############################################################################
  769. #
  770. # print_area($first_row, $first_col, $last_row, $last_col)
  771. #
  772. # Set the area of each worksheet that will be printed. See also the
  773. # _store_names() methods in Workbook.pm.
  774. #
  775. sub print_area {
  776. my $self = shift;
  777. # Check for a cell reference in A1 notation and substitute row and column
  778. if ($_[0] =~ /^\D/) {
  779. @_ = $self->_substitute_cellref(@_);
  780. }
  781. return if @_ != 4; # Require 4 parameters
  782. $self->{_print_rowmin} = $_[0];
  783. $self->{_print_colmin} = $_[1];
  784. $self->{_print_rowmax} = $_[2];
  785. $self->{_print_colmax} = $_[3];
  786. }
  787. ###############################################################################
  788. #
  789. # autofilter($first_row, $first_col, $last_row, $last_col)
  790. #
  791. # Set the autofilter area in the worksheet.
  792. #
  793. sub autofilter {
  794. my $self = shift;
  795. # Check for a cell reference in A1 notation and substitute row and column
  796. if ($_[0] =~ /^\D/) {
  797. @_ = $self->_substitute_cellref(@_);
  798. }
  799. return if @_ != 4; # Require 4 parameters
  800. my ($row1, $col1, $row2, $col2) = @_;
  801. # Reverse max and min values if necessary.
  802. ($row1, $row2) = ($row2, $row1) if $row2 < $row1;
  803. ($col1, $col2) = ($col2, $col1) if $col2 < $col1;
  804. # Store the Autofilter information
  805. $self->{_filter_area} = [$row1, $row2, $col1, $col2];
  806. $self->{_filter_count} = 1+ $col2 -$col1;
  807. }
  808. ###############################################################################
  809. #
  810. # filter_column($column, $criteria, ...)
  811. #
  812. # Set the column filter criteria.
  813. #
  814. sub filter_column {
  815. my $self = shift;
  816. my $col = $_[0];
  817. my $expression = $_[1];
  818. croak "Must call autofilter() before filter_column()"
  819. unless $self->{_filter_count};
  820. croak "Incorrect number of arguments to filter_column()" unless @_ == 2;
  821. # Check for a column reference in A1 notation and substitute.
  822. if ($col =~ /^\D/) {
  823. # Convert col ref to a cell ref and then to a col number.
  824. (undef, $col) = $self->_substitute_cellref($col . '1');
  825. }
  826. my (undef, undef, $col_first, $col_last) = @{$self->{_filter_area}};
  827. # Reject column if it is outside filter range.
  828. if ($col < $col_first or $col > $col_last) {
  829. croak "Column '$col' outside autofilter() column range " .
  830. "($col_first .. $col_last)";
  831. }
  832. my @tokens = $self->_extract_filter_tokens($expression);
  833. croak "Incorrect number of tokens in expression '$expression'"
  834. unless (@tokens == 3 or @tokens == 7);
  835. @tokens = $self->_parse_filter_expression($expression, @tokens);
  836. $self->{_filter_cols}->{$col} = [@tokens];
  837. $self->{_filter_on} = 1;
  838. }
  839. ###############################################################################
  840. #
  841. # _extract_filter_tokens($expression)
  842. #
  843. # Extract the tokens from the filter expression. The tokens are mainly non-
  844. # whitespace groups. The only tricky part is to extract string tokens that
  845. # contain whitespace and/or quoted double quotes (Excel's escaped quotes).
  846. #
  847. # Examples: 'x < 2000'
  848. # 'x > 2000 and x < 5000'
  849. # 'x = "foo"'
  850. # 'x = "foo bar"'
  851. # 'x = "foo "" bar"'
  852. #
  853. sub _extract_filter_tokens {
  854. my $self = shift;
  855. my $expression = $_[0];
  856. return unless $expression;
  857. my @tokens = ($expression =~ /"(?:[^"]|"")*"|\S+/g); #"
  858. # Remove leading and trailing quotes and unescape other quotes
  859. for (@tokens) {
  860. s/^"//; #"
  861. s/"$//; #"
  862. s/""/"/g; #"
  863. }
  864. return @tokens;
  865. }
  866. ###############################################################################
  867. #
  868. # _parse_filter_expression(@token)
  869. #
  870. # Converts the tokens of a possibly conditional expression into 1 or 2
  871. # sub expressions for further parsing.
  872. #
  873. # Examples:
  874. # ('x', '==', 2000) -> exp1
  875. # ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
  876. #
  877. sub _parse_filter_expression {
  878. my $self = shift;
  879. my $expression = shift;
  880. my @tokens = @_;
  881. # The number of tokens will be either 3 (for 1 expression)
  882. # or 7 (for 2 expressions).
  883. #
  884. if (@tokens == 7) {
  885. my $conditional = $tokens[3];
  886. if ($conditional =~ /^(and|&&)$/) {
  887. $conditional = 0;
  888. }
  889. elsif ($conditional =~ /^(or|\|\|)$/) {
  890. $conditional = 1;
  891. }
  892. else {
  893. croak "Token '$conditional' is not a valid conditional " .
  894. "in filter expression '$expression'";
  895. }
  896. my @expression_1 = $self->_parse_filter_tokens($expression,
  897. @tokens[0, 1, 2]);
  898. my @expression_2 = $self->_parse_filter_tokens($expression,
  899. @tokens[4, 5, 6]);
  900. return (@expression_1, $conditional, @expression_2);
  901. }
  902. else {
  903. return $self->_parse_filter_tokens($expression, @tokens);
  904. }
  905. }
  906. ###############################################################################
  907. #
  908. # _parse_filter_tokens(@token)
  909. #
  910. # Parse the 3 tokens of a filter expression and return the operator and token.
  911. #
  912. sub _parse_filter_tokens {
  913. my $self = shift;
  914. my $expression = shift;
  915. my @tokens = @_;
  916. my %operators = (
  917. '==' => 2,
  918. '=' => 2,
  919. '=~' => 2,
  920. 'eq' => 2,
  921. '!=' => 5,
  922. '!~' => 5,
  923. 'ne' => 5,
  924. '<>' => 5,
  925. '<' => 1,
  926. '<=' => 3,
  927. '>' => 4,
  928. '>=' => 6,
  929. );
  930. my $operator = $operators{$tokens[1]};
  931. my $token = $tokens[2];
  932. # Special handling of "Top" filter expressions.
  933. if ($tokens[0] =~ /^top|bottom$/i) {
  934. my $value = $tokens[1];
  935. if ($value =~ /\D/ or
  936. $value < 1 or
  937. $value > 500)
  938. {
  939. croak "The value '$value' in expression '$expression' " .
  940. "must be in the range 1 to 500";
  941. }
  942. $token = lc $token;
  943. if ($token ne 'items' and $token ne '%') {
  944. croak "The type '$token' in expression '$expression' " .
  945. "must be either 'items' or '%'";
  946. }
  947. if ($tokens[0] =~ /^top$/i) {
  948. $operator = 30;
  949. }
  950. else {
  951. $operator = 32;
  952. }
  953. if ($tokens[2] eq '%') {
  954. $operator++;
  955. }
  956. $token = $value;
  957. }
  958. if (not $operator and $tokens[0]) {
  959. croak "Token '$tokens[1]' is not a valid operator " .
  960. "in filter expression '$expression'";
  961. }
  962. # Special handling for Blanks/NonBlanks.
  963. if ($token =~ /^blanks|nonblanks$/i) {
  964. # Only allow Equals or NotEqual in this context.
  965. if ($operator != 2 and $operator != 5) {
  966. croak "The operator '$tokens[1]' in expression '$expression' " .
  967. "is not valid in relation to Blanks/NonBlanks'";
  968. }
  969. $token = lc $token;
  970. # The operator should always be 2 (=) to flag a "simple" equality in
  971. # the binary record. Therefore we convert <> to =.
  972. if ($token eq 'blanks') {
  973. if ($operator == 5) {
  974. $operator = 2;
  975. $token = 'nonblanks';
  976. }
  977. }
  978. else {
  979. if ($operator == 5) {
  980. $operator = 2;
  981. $token = 'blanks';
  982. }
  983. }
  984. }
  985. # if the string token contains an Excel match character then change the
  986. # operator type to indicate a non "simple" equality.
  987. if ($operator == 2 and $token =~ /[*?]/) {
  988. $operator = 22;
  989. }
  990. return ($operator, $token);
  991. }
  992. ###############################################################################
  993. #
  994. # hide_gridlines()
  995. #
  996. # Set the option to hide gridlines on the screen and the printed page.
  997. # There are two ways of doing this in the Excel BIFF format: The first is by
  998. # setting the DspGrid field of the WINDOW2 record, this turns off the screen
  999. # and subsequently the print gridline. The second method is to via the
  1000. # PRINTGRIDLINES and GRIDSET records, this turns off the printed gridlines
  1001. # only. The first method is probably sufficient for most cases. The second
  1002. # method is supported for backwards compatibility. Porters take note.
  1003. #
  1004. sub hide_gridlines {
  1005. my $self = shift;
  1006. my $option = $_[0];
  1007. $option = 1 unless defined $option; # Default to hiding printed gridlines
  1008. if ($option == 0) {
  1009. $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
  1010. $self->{_screen_gridlines} = 1;
  1011. }
  1012. elsif ($option == 1) {
  1013. $self->{_print_gridlines} = 0;
  1014. $self->{_screen_gridlines} = 1;
  1015. }
  1016. else {
  1017. $self->{_print_gridlines} = 0;
  1018. $self->{_screen_gridlines} = 0;
  1019. }
  1020. }
  1021. ###############################################################################
  1022. #
  1023. # print_row_col_headers()
  1024. #
  1025. # Set the option to print the row and column headers on the printed page.
  1026. # See also the _store_print_headers() method below.
  1027. #
  1028. sub print_row_col_headers {
  1029. my $self = shift;
  1030. if (defined $_[0]) {
  1031. $self->{_print_headers} = $_[0];
  1032. }
  1033. else {
  1034. $self->{_print_headers} = 1;
  1035. }
  1036. }
  1037. ###############################################################################
  1038. #
  1039. # fit_to_pages($width, $height)
  1040. #
  1041. # Store the vertical and horizontal number of pages that will define the
  1042. # maximum area printed. See also _store_setup() and _store_wsbool() below.
  1043. #
  1044. sub fit_to_pages {
  1045. my $self = shift;
  1046. $self->{_fit_page} = 1;
  1047. $self->{_fit_width} = $_[0] || 0;
  1048. $self->{_fit_height} = $_[1] || 0;
  1049. }
  1050. ###############################################################################
  1051. #
  1052. # set_h_pagebreaks(@breaks)
  1053. #
  1054. # Store the horizontal page breaks on a worksheet.
  1055. #
  1056. sub set_h_pagebreaks {
  1057. my $self = shift;
  1058. push @{$self->{_hbreaks}}, @_;
  1059. }
  1060. ###############################################################################
  1061. #
  1062. # set_v_pagebreaks(@breaks)
  1063. #
  1064. # Store the vertical page breaks on a worksheet.
  1065. #
  1066. sub set_v_pagebreaks {
  1067. my $self = shift;
  1068. push @{$self->{_vbreaks}}, @_;
  1069. }
  1070. ###############################################################################
  1071. #
  1072. # set_zoom($scale)
  1073. #
  1074. # Set the worksheet zoom factor.
  1075. #
  1076. sub set_zoom {
  1077. my $self = shift;
  1078. my $scale = $_[0] || 100;
  1079. # Confine the scale to Excel's range
  1080. if ($scale < 10 or $scale > 400) {
  1081. carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
  1082. $scale = 100;
  1083. }
  1084. $self->{_zoom} = int $scale;
  1085. }
  1086. ###############################################################################
  1087. #
  1088. # set_print_scale($scale)
  1089. #
  1090. # Set the scale factor for the printed page.
  1091. #
  1092. sub set_print_scale {
  1093. my $self = shift;
  1094. my $scale = $_[0] || 100;
  1095. # Confine the scale to Excel's range
  1096. if ($scale < 10 or $scale > 400) {
  1097. carp "Print scale $scale outside range: 10 <= zoom <= 400";
  1098. $scale = 100;
  1099. }
  1100. # Turn off "fit to page" option
  1101. $self->{_fit_page} = 0;
  1102. $self->{_print_scale} = int $scale;
  1103. }
  1104. ###############################################################################
  1105. #
  1106. # keep_leading_zeros()
  1107. #
  1108. # Causes the write() method to treat integers with a leading zero as a string.
  1109. # This ensures that any leading zeros such, as in zip codes, are maintained.
  1110. #
  1111. sub keep_leading_zeros {
  1112. my $self = shift;
  1113. if (defined $_[0]) {
  1114. $self->{_leading_zeros} = $_[0];
  1115. }
  1116. else {
  1117. $self->{_leading_zeros} = 1;
  1118. }
  1119. }
  1120. ###############################################################################
  1121. #
  1122. # show_comments()
  1123. #
  1124. # Make any comments in the worksheet visible.
  1125. #
  1126. sub show_comments {
  1127. my $self = shift;
  1128. $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
  1129. }
  1130. ###############################################################################
  1131. #
  1132. # set_comments_author()
  1133. #
  1134. # Set the default author of the cell comments.
  1135. #
  1136. sub set_comments_author {
  1137. my $self = shift;
  1138. $self->{_comments_author} = defined $_[0] ? $_[0] : '';
  1139. $self->{_comments_author_enc} = $_[1] ? 1 : 0;
  1140. }
  1141. ###############################################################################
  1142. #
  1143. # right_to_left()
  1144. #
  1145. # Display the worksheet right to left for some eastern versions of Excel.
  1146. #
  1147. sub right_to_left {
  1148. my $self = shift;
  1149. $self->{_display_arabic} = defined $_[0] ? $_[0] : 1;
  1150. }
  1151. ###############################################################################
  1152. #
  1153. # hide_zero()
  1154. #
  1155. # Hide cell zero values.
  1156. #
  1157. sub hide_zero {
  1158. my $self = shift;
  1159. $self->{_display_zeros} = defined $_[0] ? not $_[0] : 0;
  1160. }
  1161. ###############################################################################
  1162. #
  1163. # print_across()
  1164. #
  1165. # Set the order in which pages are printed.
  1166. #
  1167. sub print_across {
  1168. my $self = shift;
  1169. $self->{_page_order} = defined $_[0] ? $_[0] : 1;
  1170. }
  1171. ###############################################################################
  1172. #
  1173. # set_start_page()
  1174. #
  1175. # Set the start page number.
  1176. #
  1177. sub set_start_page {
  1178. my $self = shift;
  1179. return unless defined $_[0];
  1180. $self->{_page_start} = $_[0];
  1181. $self->{_custom_start} = 1;
  1182. }
  1183. ###############################################################################
  1184. #
  1185. # set_first_row_column()
  1186. #
  1187. # Set the topmost and leftmost visible row and column.
  1188. # TODO: Document this when tested fully for interaction with panes.
  1189. #
  1190. sub set_first_row_column {
  1191. my $self = shift;
  1192. my $row = $_[0] || 0;
  1193. my $col = $_[1] || 0;
  1194. $row = 65535 if $row > 65535;
  1195. $col = 255 if $col > 255;
  1196. $self->{_first_row} = $row;
  1197. $self->{_first_col} = $col;
  1198. }
  1199. ###############################################################################
  1200. #
  1201. # add_write_handler($re, $code_ref)
  1202. #
  1203. # Allow the user to add their own matches and handlers to the write() method.
  1204. #
  1205. sub add_write_handler {
  1206. my $self = shift;
  1207. return unless @_ == 2;
  1208. return unless ref $_[1] eq 'CODE';
  1209. push @{$self->{_write_match}}, [ @_ ];
  1210. }
  1211. ###############################################################################
  1212. #
  1213. # write($row, $col, $token, $format)
  1214. #
  1215. # Parse $token and call appropriate write method. $row and $column are zero
  1216. # indexed. $format is optional.
  1217. #
  1218. # The write_url() methods have a flag to prevent recursion when writing a
  1219. # string that looks like a url.
  1220. #
  1221. # Returns: return value of called subroutine
  1222. #
  1223. sub write {
  1224. my $self = shift;
  1225. # Check for a cell reference in A1 notation and substitute row and column
  1226. if ($_[0] =~ /^\D/) {
  1227. @_ = $self->_substitute_cellref(@_);
  1228. }
  1229. my $token = $_[2];
  1230. # Handle undefs as blanks
  1231. $token = '' unless defined $token;
  1232. # First try user defined matches.
  1233. for my $aref (@{$self->{_write_match}}) {
  1234. my $re = $aref->[0];
  1235. my $sub = $aref->[1];
  1236. if ($token =~ /$re/) {
  1237. my $match = &$sub($self, @_);
  1238. return $match if defined $match;
  1239. }
  1240. }
  1241. # Match an array ref.
  1242. if (ref $token eq "ARRAY") {
  1243. return $self->write_row(@_);
  1244. }
  1245. # Match integer with leading zero(s)
  1246. elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
  1247. return $self->write_string(@_);
  1248. }
  1249. # Match number
  1250. elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
  1251. return $self->write_number(@_);
  1252. }
  1253. # Match http, https or ftp URL
  1254. elsif ($token =~ m|^[fh]tt?ps?://| and not $self->{_writing_url}) {
  1255. return $self->write_url(@_);
  1256. }
  1257. # Match mailto:
  1258. elsif ($token =~ m/^mailto:/ and not $self->{_writing_url}) {
  1259. return $self->write_url(@_);
  1260. }
  1261. # Match internal or external sheet link
  1262. elsif ($token =~ m[^(?:in|ex)ternal:] and not $self->{_writing_url}) {
  1263. return $self->write_url(@_);
  1264. }
  1265. # Match formula
  1266. elsif ($token =~ /^=/) {
  1267. return $self->write_formula(@_);
  1268. }
  1269. # Match blank
  1270. elsif ($token eq '') {
  1271. splice @_, 2, 1; # remove the empty string from the parameter list
  1272. return $self->write_blank(@_);
  1273. }
  1274. else {
  1275. return $self->write_string(@_);
  1276. }
  1277. }
  1278. ###############################################################################
  1279. #
  1280. # write_row($row, $col, $array_ref, $format)
  1281. #
  1282. # Write a row of data starting from ($row, $col). Call write_col() if any of
  1283. # the elements of the array ref are in turn array refs. This allows the writing
  1284. # of 1D or 2D arrays of data in one go.
  1285. #
  1286. # Returns: the first encountered error value or zero for no errors
  1287. #
  1288. sub write_row {
  1289. my $self = shift;
  1290. # Check for a cell reference in A1 notation and substitute row and column
  1291. if ($_[0] =~ /^\D/) {
  1292. @_ = $self->_substitute_cellref(@_);
  1293. }
  1294. # Catch non array refs passed by user.
  1295. if (ref $_[2] ne 'ARRAY') {
  1296. croak "Not an array ref in call to write_row()$!";
  1297. }
  1298. my $row = shift;
  1299. my $col = shift;
  1300. my $tokens = shift;
  1301. my @options = @_;
  1302. my $error = 0;
  1303. my $ret;
  1304. foreach my $token (@$tokens) {
  1305. # Check for nested arrays
  1306. if (ref $token eq "ARRAY") {
  1307. $ret = $self->write_col($row, $col, $token, @options);
  1308. } else {
  1309. $ret = $self->write ($row, $col, $token, @options);
  1310. }
  1311. # Return only the first error encountered, if any.
  1312. $error ||= $ret;
  1313. $col++;
  1314. }
  1315. return $error;
  1316. }
  1317. ###############################################################################
  1318. #
  1319. # write_col($row, $col, $array_ref, $format)
  1320. #
  1321. # Write a column of data starting from ($row, $col). Call write_row() if any of
  1322. # the elements of the array ref are in turn array refs. This allows the writing
  1323. # of 1D or 2D arrays of data in one go.
  1324. #
  1325. # Returns: the first encountered error value or zero for no errors
  1326. #
  1327. sub write_col {
  1328. my $self = shift;
  1329. # Check for a cell reference in A1 notation and substitute row and column
  1330. if ($_[0] =~ /^\D/) {
  1331. @_ = $self->_substitute_cellref(@_);
  1332. }
  1333. # Catch non array refs passed by user.
  1334. if (ref $_[2] ne 'ARRAY') {
  1335. croak "Not an array ref in call to write_row()$!";
  1336. }
  1337. my $row = shift;
  1338. my $col = shift;
  1339. my $tokens = shift;
  1340. my @options = @_;
  1341. my $error = 0;
  1342. my $ret;
  1343. foreach my $token (@$tokens) {
  1344. # write() will deal with any nested arrays
  1345. $ret = $self->write($row, $col, $token, @options);
  1346. # Return only the first error encountered, if any.
  1347. $error ||= $ret;
  1348. $row++;
  1349. }
  1350. return $error;
  1351. }
  1352. ###############################################################################
  1353. #
  1354. # write_comment($row, $col, $comment)
  1355. #
  1356. # Write a comment to the specified row and column (zero indexed).
  1357. #
  1358. # Returns 0 : normal termination
  1359. # -1 : insufficient number of arguments
  1360. # -2 : row or column out of range
  1361. #
  1362. sub write_comment {
  1363. my $self = shift;
  1364. # Check for a cell reference in A1 notation and substitute row and column
  1365. if ($_[0] =~ /^\D/) {
  1366. @_ = $self->_substitute_cellref(@_);
  1367. }
  1368. if (@_ < 3) { return -1 } # Check the number of args
  1369. my $row = $_[0];
  1370. my $col = $_[1];
  1371. # Check for pairs of optional arguments, i.e. an odd number of args.
  1372. croak "Uneven number of additional arguments" unless @_ % 2;
  1373. # Check that row and col are valid and store max and min values
  1374. return -2 if $self->_check_dimensions($row, $col);
  1375. # We have to avoid duplicate comments in cells or else Excel will complain.
  1376. $self->{_comments}->{$row}->{$col} = [ $self->_comment_params(@_) ];
  1377. }
  1378. ###############################################################################
  1379. #
  1380. # _XF()
  1381. #
  1382. # Returns an index to the XF record in the workbook.
  1383. #
  1384. # Note: this is a function, not a method.
  1385. #
  1386. sub _XF {
  1387. my $self = $_[0];
  1388. my $row = $_[1];
  1389. my $col = $_[2];
  1390. my $format = $_[3];
  1391. my $error = "Error: refer to merge_range() in the documentation. " .
  1392. "Can't use previously merged format in non-merged cell";
  1393. if (ref($format)) {
  1394. # Temp code to prevent merged formats in non-merged cells.
  1395. croak $error if $format->{_used_merge} == 1;
  1396. $format->{_used_merge} = -1;
  1397. return $format->get_xf_index();
  1398. }
  1399. elsif (exists $self->{_row_formats}->{$row}) {
  1400. # Temp code to prevent merged formats in non-merged cells.
  1401. croak $error if $self->{_row_formats}->{$row}->{_used_merge} == 1;
  1402. $self->{_row_formats}->{$row}->{_used_merge} = -1;
  1403. return $self->{_row_formats}->{$row}->get_xf_index();
  1404. }
  1405. elsif (exists $self->{_col_formats}->{$col}) {
  1406. # Temp code to prevent merged formats in non-merged cells.
  1407. croak $error if $self->{_col_formats}->{$col}->{_used_merge} == 1;
  1408. $self->{_col_formats}->{$col}->{_used_merge} = -1;
  1409. return $self->{_col_formats}->{$col}->get_xf_index();
  1410. }
  1411. else {
  1412. return 0x0F;
  1413. }
  1414. }
  1415. ###############################################################################
  1416. ###############################################################################
  1417. #
  1418. # Internal methods
  1419. #
  1420. ###############################################################################
  1421. #
  1422. # _append(), overridden.
  1423. #
  1424. # Store Worksheet data in memory using the base class _append() or to a
  1425. # temporary file, the default.
  1426. #
  1427. sub _append {
  1428. my $self = shift;
  1429. my $data = '';
  1430. if ($self->{_using_tmpfile}) {
  1431. $data = join('', @_);
  1432. # Add CONTINUE records if necessary
  1433. $data = $self->_add_continue($data) if length($data) > $self->{_limit};
  1434. # Protect print() from -l on the command line.
  1435. local $\ = undef;
  1436. print {$self->{_filehandle}} $data;
  1437. $self->{_datasize} += length($data);
  1438. }
  1439. else {
  1440. $data = $self->SUPER::_append(@_);
  1441. }
  1442. return $data;
  1443. }
  1444. ###############################################################################
  1445. #
  1446. # _substitute_cellref()
  1447. #
  1448. # Substitute an Excel cell reference in A1 notation for zero based row and
  1449. # column values in an argument list.
  1450. #
  1451. # Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
  1452. #
  1453. sub _substitute_cellref {
  1454. my $self = shift;
  1455. my $cell = uc(shift);
  1456. # Convert a column range: 'A:A' or 'B:G'.
  1457. # A range such as A:A is equivalent to A1:65536, so add rows as required
  1458. if ($cell =~ /\$?([A-I]?[A-Z]):\$?([A-I]?[A-Z])/) {
  1459. my ($row1, $col1) = $self->_cell_to_rowcol($1 .'1');
  1460. my ($row2, $col2) = $self->_cell_to_rowcol($2 .'65536');
  1461. return $row1, $col1, $row2, $col2, @_;
  1462. }
  1463. # Convert a cell range: 'A1:B7'
  1464. if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+):\$?([A-I]?[A-Z]\$?\d+)/) {
  1465. my ($row1, $col1) = $self->_cell_to_rowcol($1);
  1466. my ($row2, $col2) = $self->_cell_to_rowcol($2);
  1467. return $row1, $col1, $row2, $col2, @_;
  1468. }
  1469. # Convert a cell reference: 'A1' or 'AD2000'
  1470. if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+)/) {
  1471. my ($row1, $col1) = $self->_cell_to_rowcol($1);
  1472. return $row1, $col1, @_;
  1473. }
  1474. croak("Unknown cell reference $cell");
  1475. }
  1476. ###############################################################################
  1477. #
  1478. # _cell_to_rowcol($cell_ref)
  1479. #
  1480. # Convert an Excel cell reference in A1 notation to a zero based row and column
  1481. # reference; converts C1 to (0, 2).
  1482. #
  1483. # Returns: row, column
  1484. #
  1485. sub _cell_to_rowcol {
  1486. my $self = shift;
  1487. my $cell = shift;
  1488. $cell =~ /\$?([A-I]?[A-Z])\$?(\d+)/;
  1489. my $col = $1;
  1490. my $row = $2;
  1491. # Convert base26 column string to number
  1492. # All your Base are belong to us.
  1493. my @chars = split //, $col;
  1494. my $expn = 0;
  1495. $col = 0;
  1496. while (@chars) {
  1497. my $char = pop(@chars); # LS char first
  1498. $col += (ord($char) -ord('A') +1) * (26**$expn);
  1499. $expn++;
  1500. }
  1501. # Convert 1-index to zero-index
  1502. $row--;
  1503. $col--;
  1504. return $row, $col;
  1505. }
  1506. ###############################################################################
  1507. #
  1508. # _sort_pagebreaks()
  1509. #
  1510. #
  1511. # This is an internal method that is used to filter elements of the array of
  1512. # pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
  1513. # 1. Removes duplicate entries from the list.
  1514. # 2. Sorts the list.
  1515. # 3. Removes 0 from the list if present.
  1516. #
  1517. sub _sort_pagebreaks {
  1518. my $self= shift;
  1519. my %hash;
  1520. my @array;
  1521. @hash{@_} = undef; # Hash slice to remove duplicates
  1522. @array = sort {$a <=> $b} keys %hash; # Numerical sort
  1523. shift @array if $array[0] == 0; # Remove zero
  1524. # 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
  1525. # It is slightly higher in Excel 97/200, approx. 1026
  1526. splice(@array, 1000) if (@array > 1000);
  1527. return @array
  1528. }
  1529. ###############################################################################
  1530. #
  1531. # _encode_password($password)
  1532. #
  1533. # Based on the algorithm provided by Daniel Rentz of OpenOffice.
  1534. #
  1535. #
  1536. sub _encode_password {
  1537. use integer;
  1538. my $self = shift;
  1539. my $plaintext = $_[0];
  1540. my $password;
  1541. my $count;
  1542. my @chars;
  1543. my $i = 0;
  1544. $count = @chars = split //, $plaintext;
  1545. foreach my $char (@chars) {
  1546. my $low_15;
  1547. my $high_15;
  1548. $char = ord($char) << ++$i;
  1549. $low_15 = $char & 0x7fff;
  1550. $high_15 = $char & 0x7fff << 15;
  1551. $high_15 = $high_15 >> 15;
  1552. $char = $low_15 | $high_15;
  1553. }
  1554. $password = 0x0000;
  1555. $password ^= $_ for @chars;
  1556. $password ^= $count;
  1557. $password ^= 0xCE4B;
  1558. return $password;
  1559. }
  1560. ###############################################################################
  1561. #
  1562. # outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
  1563. #
  1564. # This method sets the properties for outlining and grouping. The defaults
  1565. # correspond to Excel's defaults.
  1566. #
  1567. sub outline_settings {
  1568. my $self = shift;
  1569. $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
  1570. $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
  1571. $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
  1572. $self->{_outline_style} = $_[3] || 0;
  1573. # Ensure this is a boolean vale for Window2
  1574. $self->{_outline_on} = 1 if $self->{_outline_on};
  1575. }
  1576. ###############################################################################
  1577. ###############################################################################
  1578. #
  1579. # BIFF RECORDS
  1580. #
  1581. ###############################################################################
  1582. #
  1583. # write_number($row, $col, $num, $format)
  1584. #
  1585. # Write a double to the specified row and column (zero indexed).
  1586. # An integer can be written as a double. Excel will display an
  1587. # integer. $format is optional.
  1588. #
  1589. # Returns 0 : normal termination
  1590. # -1 : insufficient number of arguments
  1591. # -2 : row or column out of range
  1592. #
  1593. sub write_number {
  1594. my $self = shift;
  1595. # Check for a cell reference in A1 notation and substitute row and column
  1596. if ($_[0] =~ /^\D/) {
  1597. @_ = $self->_substitute_cellref(@_);
  1598. }
  1599. if (@_ < 3) { return -1 } # Check the number of args
  1600. my $record = 0x0203; # Record identifier
  1601. my $length = 0x000E; # Number of bytes to follow
  1602. my $row = $_[0]; # Zero indexed row
  1603. my $col = $_[1]; # Zero indexed column
  1604. my $num = $_[2];
  1605. my $xf = _XF($self, $row, $col, $_[3]); # The cell format
  1606. # Check that row and col are valid and store max and min values
  1607. return -2 if $self->_check_dimensions($row, $col);
  1608. my $header = pack("vv", $record, $length);
  1609. my $data = pack("vvv", $row, $col, $xf);
  1610. my $xl_double = pack("d", $num);
  1611. if ($self->{_byte_order}) { $xl_double = reverse $xl_double }
  1612. # Store the data or write immediately depending on the compatibility mode.
  1613. if ($self->{_compatibility}) {
  1614. $self->{_table}->[$row]->[$col] = $header . $data . $xl_double;
  1615. }
  1616. else {
  1617. $self->_append($header, $data, $xl_double);
  1618. }
  1619. return 0;
  1620. }
  1621. ###############################################################################
  1622. #
  1623. # write_string ($row, $col, $string, $format)
  1624. #
  1625. # Write a string to the specified row and column (zero indexed).
  1626. # NOTE: there is an Excel 5 defined limit of 255 characters.
  1627. # $format is optional.
  1628. # Returns 0 : normal termination
  1629. # -1 : insufficient number of arguments
  1630. # -2 : row or column out of range
  1631. # -3 : long string truncated to 255 chars
  1632. #
  1633. sub write_string {
  1634. my $self = shift;
  1635. # Check for a cell reference in A1 notation and substitute row and column
  1636. if ($_[0] =~ /^\D/) {
  1637. @_ = $self->_substitute_cellref(@_);
  1638. }
  1639. if (@_ < 3) { return -1 } # Check the number of args
  1640. my $record = 0x00FD; # Record identifier
  1641. my $length = 0x000A; # Bytes to follow
  1642. my $row = $_[0]; # Zero indexed row
  1643. my $col = $_[1]; # Zero indexed column
  1644. my $strlen = length($_[2]);
  1645. my $str = $_[2];
  1646. my $xf = _XF($self, $row, $col, $_[3]); # The cell format
  1647. my $encoding = 0x0;
  1648. my $str_error = 0;
  1649. # Handle utf8 strings in perl 5.8.
  1650. if ($] >= 5.008) {
  1651. require Encode;
  1652. if (Encode::is_utf8($str)) {
  1653. my $tmp = Encode::encode("UTF-16LE", $str);
  1654. return $self->write_utf16le_string($row, $col, $tmp, $_[3]);
  1655. }
  1656. }
  1657. # Check that row and col are valid and store max and min values
  1658. return -2 if $self->_check_dimensions($row, $col);
  1659. # Limit the string to the max number of chars.
  1660. if ($strlen > 32767) {
  1661. $str = substr($str, 0, 32767);
  1662. $str_error = -3;
  1663. }
  1664. # Prepend the string with the type.
  1665. my $str_header = pack("vC", length($str), $encoding);
  1666. $str = $str_header . $str;
  1667. if (not exists ${$self->{_str_table}}->{$str}) {
  1668. ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
  1669. }
  1670. ${$self->{_str_total}}++;
  1671. my $header = pack("vv", $record, $length);
  1672. my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
  1673. # Store the data or write immediately depending on the compatibility mode.
  1674. if ($self->{_compatibility}) {
  1675. $self->{_table}->[$row]->[$col] = $header . $data;
  1676. }
  1677. else {
  1678. $self->_append($header, $data);
  1679. }
  1680. return $str_error;
  1681. }
  1682. ###############################################################################
  1683. #
  1684. # write_blank($row, $col, $format)
  1685. #
  1686. # Write a blank cell to the specified row and column (zero indexed).
  1687. # A blank cell is used to specify formatting without adding a string
  1688. # or a number.
  1689. #
  1690. # A blank cell without a format serves no purpose. Therefore, we don't write
  1691. # a BLANK record unless a format is specified. This is mainly an optimisation
  1692. # for the write_row() and write_col() methods.
  1693. #
  1694. # Returns 0 : normal termination (including no format)
  1695. # -1 : insufficient number of arguments
  1696. # -2 : row or column out of range
  1697. #
  1698. sub write_blank {
  1699. my $self = shift;
  1700. # Check for a cell reference in A1 notation and substitute row and column
  1701. if ($_[0] =~ /^\D/) {
  1702. @_ = $self->_substitute_cellref(@_);
  1703. }
  1704. # Check the number of args
  1705. return -1 if @_ < 2;
  1706. # Don't write a blank cell unless it has a format
  1707. return 0 if not defined $_[2];
  1708. my $record = 0x0201; # Record identifier
  1709. my $length = 0x0006; # Number of bytes to follow
  1710. my $row = $_[0]; # Zero indexed row
  1711. my $col = $_[1]; # Zero indexed column
  1712. my $xf = _XF($self, $row, $col, $_[2]); # The cell format
  1713. # Check that row and col are valid and store max and min values
  1714. return -2 if $self->_check_dimensions($row, $col);
  1715. my $header = pack("vv", $record, $length);
  1716. my $data = pack("vvv", $row, $col, $xf);
  1717. # Store the data or write immediately depending on the compatibility mode.
  1718. if ($self->{_compatibility}) {
  1719. $self->{_table}->[$row]->[$col] = $header . $data;
  1720. }
  1721. else {
  1722. $self->_append($header, $data);
  1723. }
  1724. return 0;
  1725. }
  1726. ###############################################################################
  1727. #
  1728. # write_formula($row, $col, $formula, $format, $value)
  1729. #
  1730. # Write a formula to the specified row and column (zero indexed).
  1731. # The textual representation of the formula is passed to the parser in
  1732. # Formula.pm which returns a packed binary string.
  1733. #
  1734. # $format is optional.
  1735. #
  1736. # $value is an optional result of the formula that can be supplied by the user.
  1737. #
  1738. # Returns 0 : normal termination
  1739. # -1 : insufficient number of arguments
  1740. # -2 : row or column out of range
  1741. #
  1742. sub write_formula {
  1743. my $self = shift;
  1744. # Check for a cell reference in A1 notation and substitute row and column
  1745. if ($_[0] =~ /^\D/) {
  1746. @_ = $self->_substitute_cellref(@_);
  1747. }
  1748. if (@_ < 3) { return -1 } # Check the number of args
  1749. my $record = 0x0006; # Record identifier
  1750. my $length; # Bytes to follow
  1751. my $row = $_[0]; # Zero indexed row
  1752. my $col = $_[1]; # Zero indexed column
  1753. my $formula = $_[2]; # The formula text string
  1754. my $value = $_[4]; # The formula text string
  1755. my $xf = _XF($self, $row, $col, $_[3]); # The cell format
  1756. my $chn = 0x0000; # Must be zero
  1757. my $is_string = 0; # Formula evaluates to str
  1758. my $num; # Current value of formula
  1759. my $grbit; # Option flags
  1760. # Excel normally stores the last calculated value of the formula in $num.
  1761. # Clearly we are not in a position to calculate this "a priori". Instead
  1762. # we set $num to zero and set the option flags in $grbit to ensure
  1763. # automatic calculation of the formula when the file is opened.
  1764. # As a workaround for some non-Excel apps we also allow the user to
  1765. # specify the result of the formula.
  1766. #
  1767. ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
  1768. # Check that row and col are valid and store max and min values
  1769. return -2 if $self->_check_dimensions($row, $col);
  1770. # Strip the = sign at the beginning of the formula string
  1771. $formula =~ s(^=)();
  1772. my $tmp = $formula;
  1773. # Parse the formula using the parser in Formula.pm
  1774. my $parser = $self->{_parser};
  1775. # In order to raise formula errors from the point of view of the calling
  1776. # program we use an eval block and re-raise the error from here.
  1777. #
  1778. eval { $formula = $parser->parse_formula($formula) };
  1779. if ($@) {
  1780. $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
  1781. croak $@; # Re-raise the error
  1782. }
  1783. my $formlen = length($formula); # Length of the binary string
  1784. $length = 0x16 + $formlen; # Length of the record data
  1785. my $header = pack("vv", $record, $length);
  1786. my $data = pack("vvv", $row, $col, $xf);
  1787. $data .= $num;
  1788. $data .= pack("vVv", $grbit, $chn, $formlen);
  1789. # The STRING record if the formula evaluates to a string.
  1790. my $string = '';
  1791. $string = $self->_get_formula_string($value) if $is_string;
  1792. # Store the data or write immediately depending on the compatibility mode.
  1793. if ($self->{_compatibility}) {
  1794. $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
  1795. }
  1796. else {
  1797. $self->_append($header, $data, $formula, $string);
  1798. }
  1799. return 0;
  1800. }
  1801. ###############################################################################
  1802. #
  1803. # _encode_formula_result()
  1804. #
  1805. # Encode the user supplied result for a formula.
  1806. #
  1807. sub _encode_formula_result {
  1808. my $self = shift;
  1809. my $value = $_[0]; # Result to be encoded.
  1810. my $is_string = 0; # Formula evaluates to str.
  1811. my $num; # Current value of formula.
  1812. my $grbit; # Option flags.
  1813. if (not defined $value) {
  1814. $grbit = 0x03;
  1815. $num = pack "d", 0;
  1816. }
  1817. else {
  1818. # The user specified the result of the formula. We turn off the recalc
  1819. # flag and check the result type.
  1820. $grbit = 0x00;
  1821. if ($value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
  1822. # Value is a number.
  1823. $num = pack "d", $value;
  1824. }
  1825. else {
  1826. my %bools = (
  1827. 'TRUE' => [1, 1],
  1828. 'FALSE' => [1, 0],
  1829. '#NULL!' => [2, 0],
  1830. '#DIV/0!' => [2, 7],
  1831. '#VALUE!' => [2, 15],
  1832. '#REF!' => [2, 23],
  1833. '#NAME?' => [2, 29],
  1834. '#NUM!' => [2, 36],
  1835. '#N/A' => [2, 42],
  1836. );
  1837. if (exists $bools{$value}) {
  1838. # Value is a boolean.
  1839. $num = pack "vvvv", $bools{$value}->[0],
  1840. $bools{$value}->[1],
  1841. 0,
  1842. 0xFFFF;
  1843. }
  1844. else {
  1845. # Value is a string.
  1846. $num = pack "vvvv", 0,
  1847. 0,
  1848. 0,
  1849. 0xFFFF;
  1850. $is_string = 1;
  1851. }
  1852. }
  1853. }
  1854. return ($num, $grbit, $is_string);
  1855. }
  1856. ###############################################################################
  1857. #
  1858. # _get_formula_string()
  1859. #
  1860. # Pack the string value when a formula evaluates to a string. The value cannot
  1861. # be calculated by the module and thus must be supplied by the user.
  1862. #
  1863. sub _get_formula_string {
  1864. my $self = shift;
  1865. my $record = 0x0207; # Record identifier
  1866. my $length = 0x00; # Bytes to follow
  1867. my $string = $_[0]; # Formula string.
  1868. my $strlen = length $_[0]; # Length of the formula string (chars).
  1869. my $encoding = 0; # String encoding.
  1870. # Handle utf8 strings in perl 5.8.
  1871. if ($] >= 5.008) {
  1872. require Encode;
  1873. if (Encode::is_utf8($string)) {
  1874. $string = Encode::encode("UTF-16BE", $string);
  1875. $encoding = 1;
  1876. }
  1877. }
  1878. $length = 0x03 + length $string; # Length of the record data
  1879. my $header = pack("vv", $record, $length);
  1880. my $data = pack("vC", $strlen, $encoding);
  1881. return $header . $data . $string;
  1882. }
  1883. ###############################################################################
  1884. #
  1885. # store_formula($formula)
  1886. #
  1887. # Pre-parse a formula. This is used in conjunction with repeat_formula()
  1888. # to repetitively rewrite a formula without re-parsing it.
  1889. #
  1890. sub store_formula {
  1891. my $self = shift;
  1892. my $formula = $_[0]; # The formula text string
  1893. # Strip the = sign at the beginning of the formula string
  1894. $formula =~ s(^=)();
  1895. # Parse the formula using the parser in Formula.pm
  1896. my $parser = $self->{_parser};
  1897. # In order to raise formula errors from the point of view of the calling
  1898. # program we use an eval block and re-raise the error from here.
  1899. #
  1900. my @tokens;
  1901. eval { @tokens = $parser->parse_formula($formula) };
  1902. if ($@) {
  1903. $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
  1904. croak $@; # Re-raise the error
  1905. }
  1906. # Return the parsed tokens in an anonymous array
  1907. return [@tokens];
  1908. }
  1909. ###############################################################################
  1910. #
  1911. # repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
  1912. #
  1913. # Write a formula to the specified row and column (zero indexed) by
  1914. # substituting $pattern $replacement pairs in the $formula created via
  1915. # store_formula(). This allows the user to repetitively rewrite a formula
  1916. # without the significant overhead of parsing.
  1917. #
  1918. # Returns 0 : normal termination
  1919. # -1 : insufficient number of arguments
  1920. # -2 : row or column out of range
  1921. #
  1922. sub repeat_formula {
  1923. my $self = shift;
  1924. # Check for a cell reference in A1 notation and substitute row and column
  1925. if ($_[0] =~ /^\D/) {
  1926. @_ = $self->_substitute_cellref(@_);
  1927. }
  1928. if (@_ < 2) { return -1 } # Check the number of args
  1929. my $record = 0x0006; # Record identifier
  1930. my $length; # Bytes to follow
  1931. my $row = shift; # Zero indexed row
  1932. my $col = shift; # Zero indexed column
  1933. my $formula_ref = shift; # Array ref with formula tokens
  1934. my $format = shift; # XF format
  1935. my @pairs = @_; # Pattern/replacement pairs
  1936. # Enforce an even number of arguments in the pattern/replacement list
  1937. croak "Odd number of elements in pattern/replacement list" if @pairs %2;
  1938. # Check that $formula is an array ref
  1939. croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
  1940. my @tokens = @$formula_ref;
  1941. # Ensure that there are tokens to substitute
  1942. croak "No tokens in formula" unless @tokens;
  1943. # As a temporary and undocumented measure we allow the user to specify the
  1944. # result of the formula by appending a result => $value pair to the end
  1945. # of the arguments.
  1946. my $value = undef;
  1947. if ($pairs[-2] eq 'result') {
  1948. $value = pop @pairs;
  1949. pop @pairs;
  1950. }
  1951. while (@pairs) {
  1952. my $pattern = shift @pairs;
  1953. my $replace = shift @pairs;
  1954. foreach my $token (@tokens) {
  1955. last if $token =~ s/$pattern/$replace/;
  1956. }
  1957. }
  1958. # Change the parameters in the formula cached by the Formula.pm object
  1959. my $parser = $self->{_parser};
  1960. my $formula = $parser->parse_tokens(@tokens);
  1961. croak "Unrecognised token in formula" unless defined $formula;
  1962. my $xf = _XF($self, $row, $col, $format); # The cell format
  1963. my $chn = 0x0000; # Must be zero
  1964. my $is_string = 0; # Formula evaluates to str
  1965. my $num; # Current value of formula
  1966. my $grbit; # Option flags
  1967. # Excel normally stores the last calculated value of the formula in $num.
  1968. # Clearly we are not in a position to calculate this "a priori". Instead
  1969. # we set $num to zero and set the option flags in $grbit to ensure
  1970. # automatic calculation of the formula when the file is opened.
  1971. # As a workaround for some non-Excel apps we also allow the user to
  1972. # specify the result of the formula.
  1973. #
  1974. ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
  1975. # Check that row and col are valid and store max and min values
  1976. return -2 if $self->_check_dimensions($row, $col);
  1977. my $formlen = length($formula); # Length of the binary string
  1978. $length = 0x16 + $formlen; # Length of the record data
  1979. my $header = pack("vv", $record, $length);
  1980. my $data = pack("vvv", $row, $col, $xf);
  1981. $data .= $num;
  1982. $data .= pack("vVv", $grbit, $chn, $formlen);
  1983. # The STRING record if the formula evaluates to a string.
  1984. my $string = '';
  1985. $string = $self->_get_formula_string($value) if $is_string;
  1986. # Store the data or write immediately depending on the compatibility mode.
  1987. if ($self->{_compatibility}) {
  1988. $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
  1989. }
  1990. else {
  1991. $self->_append($header, $data, $formula, $string);
  1992. }
  1993. return 0;
  1994. }
  1995. ###############################################################################
  1996. #
  1997. # write_url($row, $col, $url, $string, $format)
  1998. #
  1999. # Write a hyperlink. This is comprised of two elements: the visible label and
  2000. # the invisible link. The visible label is the same as the link unless an
  2001. # alternative string is specified.
  2002. #
  2003. # The parameters $string and $format are optional and their order is
  2004. # interchangeable for backward compatibility reasons.
  2005. #
  2006. # The hyperlink can be to a http, ftp, mail, internal sheet, or external
  2007. # directory url.
  2008. #
  2009. # Returns 0 : normal termination
  2010. # -1 : insufficient number of arguments
  2011. # -2 : row or column out of range
  2012. # -3 : long string truncated to 255 chars
  2013. #
  2014. sub write_url {
  2015. my $self = shift;
  2016. # Check for a cell reference in A1 notation and substitute row and column
  2017. if ($_[0] =~ /^\D/) {
  2018. @_ = $self->_substitute_cellref(@_);
  2019. }
  2020. # Check the number of args
  2021. return -1 if @_ < 3;
  2022. # Add start row and col to arg list
  2023. return $self->write_url_range($_[0], $_[1], @_);
  2024. }
  2025. ###############################################################################
  2026. #
  2027. # write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
  2028. #
  2029. # This is the more general form of write_url(). It allows a hyperlink to be
  2030. # written to a range of cells. This function also decides the type of hyperlink
  2031. # to be written. These are either, Web (http, ftp, mailto), Internal
  2032. # (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
  2033. #
  2034. # See also write_url() above for a general description and return values.
  2035. #
  2036. sub write_url_range {
  2037. my $self = shift;
  2038. # Check for a cell reference in A1 notation and substitute row and column
  2039. if ($_[0] =~ /^\D/) {
  2040. @_ = $self->_substitute_cellref(@_);
  2041. }
  2042. # Check the number of args
  2043. return -1 if @_ < 5;
  2044. # Reverse the order of $string and $format if necessary. We work on a copy
  2045. # in order to protect the callers args. We don't use "local @_" in case of
  2046. # perl50005 threads.
  2047. #
  2048. my @args = @_;
  2049. ($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];
  2050. my $url = $args[4];
  2051. # Check for internal/external sheet links or default to web link
  2052. return $self->_write_url_internal(@args) if $url =~ m[^internal:];
  2053. return $self->_write_url_external(@args) if $url =~ m[^external:];
  2054. return $self->_write_url_web(@args);
  2055. }
  2056. ###############################################################################
  2057. #
  2058. # _write_url_web($row1, $col1, $row2, $col2, $url, $string, $format)
  2059. #
  2060. # Used to write http, ftp and mailto hyperlinks.
  2061. # The link type ($options) is 0x03 is the same as absolute dir ref without
  2062. # sheet. However it is differentiated by the $unknown2 data stream.
  2063. #
  2064. # See also write_url() above for a general description and return values.
  2065. #
  2066. sub _write_url_web {
  2067. my $self = shift;
  2068. my $record = 0x01B8; # Record identifier
  2069. my $length = 0x00000; # Bytes to follow
  2070. my $row1 = $_[0]; # Start row
  2071. my $col1 = $_[1]; # Start column
  2072. my $row2 = $_[2]; # End row
  2073. my $col2 = $_[3]; # End column
  2074. my $url = $_[4]; # URL string
  2075. my $str = $_[5]; # Alternative label
  2076. my $xf = $_[6] || $self->{_url_format};# The cell format
  2077. # Write the visible label but protect against url recursion in write().
  2078. $str = $url unless defined $str;
  2079. $self->{_writing_url} = 1;
  2080. my $error = $self->write($row1, $col1, $str, $xf);
  2081. $self->{_writing_url} = 0;
  2082. return $error if $error == -2;
  2083. # Pack the undocumented parts of the hyperlink stream
  2084. my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
  2085. my $unknown2 = pack("H*", "E0C9EA79F9BACE118C8200AA004BA90B");
  2086. # Pack the option flags
  2087. my $options = pack("V", 0x03);
  2088. # URL encoding.
  2089. my $encoding = 0;
  2090. # Convert an Utf8 URL type and to a null terminated wchar string.
  2091. if ($] >= 5.008) {
  2092. require Encode;
  2093. if (Encode::is_utf8($url)) {
  2094. $url = Encode::encode("UTF-16LE", $url);
  2095. $url .= "\0\0"; # URL is null terminated.
  2096. $encoding = 1;
  2097. }
  2098. }
  2099. # Convert an Ascii URL type and to a null terminated wchar string.
  2100. if ($encoding == 0) {
  2101. $url .= "\0";
  2102. $url = pack 'v*', unpack 'c*', $url;
  2103. }
  2104. # Pack the length of the URL
  2105. my $url_len = pack("V", length($url));
  2106. # Calculate the data length
  2107. $length = 0x34 + length($url);
  2108. # Pack the header data
  2109. my $header = pack("vv", $record, $length);
  2110. my $data = pack("vvvv", $row1, $row2, $col1, $col2);
  2111. # Write the packed data
  2112. $self->_append( $header,
  2113. $data,
  2114. $unknown1,
  2115. $options,
  2116. $unknown2,
  2117. $url_len,
  2118. $url);
  2119. return $error;
  2120. }
  2121. ###############################################################################
  2122. #
  2123. # _write_url_internal($row1, $col1, $row2, $col2, $url, $string, $format)
  2124. #
  2125. # Used to write internal reference hyperlinks such as "Sheet1!A1".
  2126. #
  2127. # See also write_url() above for a general description and return values.
  2128. #
  2129. sub _write_url_internal {
  2130. my $self = shift;
  2131. my $record = 0x01B8; # Record identifier
  2132. my $length = 0x00000; # Bytes to follow
  2133. my $row1 = $_[0]; # Start row
  2134. my $col1 = $_[1]; # Start column
  2135. my $row2 = $_[2]; # End row
  2136. my $col2 = $_[3]; # End column
  2137. my $url = $_[4]; # URL string
  2138. my $str = $_[5]; # Alternative label
  2139. my $xf = $_[6] || $self->{_url_format};# The cell format
  2140. # Strip URL type
  2141. $url =~ s[^internal:][];
  2142. # Write the visible label but protect against url recursion in write().
  2143. $str = $url unless defined $str;
  2144. $self->{_writing_url} = 1;
  2145. my $error = $self->write($row1, $col1, $str, $xf);
  2146. $self->{_writing_url} = 0;
  2147. return $error if $error == -2;
  2148. # Pack the undocumented parts of the hyperlink stream
  2149. my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
  2150. # Pack the option flags
  2151. my $options = pack("V", 0x08);
  2152. # URL encoding.
  2153. my $encoding = 0;
  2154. # Convert an Utf8 URL type and to a null terminated wchar string.
  2155. if ($] >= 5.008) {
  2156. require Encode;
  2157. if (Encode::is_utf8($url)) {
  2158. # Quote sheet name if not already, i.e., Sheet!A1 to 'Sheet!A1'.
  2159. $url =~ s/^(.+)!/'$1'!/ if not $url =~ /^'/;
  2160. $url = Encode::encode("UTF-16LE", $url);
  2161. $url .= "\0\0"; # URL is null terminated.
  2162. $encoding = 1;
  2163. }
  2164. }
  2165. # Convert an Ascii URL type and to a null terminated wchar string.
  2166. if ($encoding == 0) {
  2167. $url .= "\0";
  2168. $url = pack 'v*', unpack 'c*', $url;
  2169. }
  2170. # Pack the length of the URL as chars (not wchars)
  2171. my $url_len = pack("V", int(length($url)/2));
  2172. # Calculate the data length
  2173. $length = 0x24 + length($url);
  2174. # Pack the header data
  2175. my $header = pack("vv", $record, $length);
  2176. my $data = pack("vvvv", $row1, $row2, $col1, $col2);
  2177. # Write the packed data
  2178. $self->_append( $header,
  2179. $data,
  2180. $unknown1,
  2181. $options,
  2182. $url_len,
  2183. $url);
  2184. return $error;
  2185. }
  2186. ###############################################################################
  2187. #
  2188. # _write_url_external($row1, $col1, $row2, $col2, $url, $string, $format)
  2189. #
  2190. # Write links to external directory names such as 'c:\foo.xls',
  2191. # c:\foo.xls#Sheet1!A1', '../../foo.xls'. and '../../foo.xls#Sheet1!A1'.
  2192. #
  2193. # Note: Excel writes some relative links with the $dir_long string. We ignore
  2194. # these cases for the sake of simpler code.
  2195. #
  2196. # See also write_url() above for a general description and return values.
  2197. #
  2198. sub _write_url_external {
  2199. my $self = shift;
  2200. # Network drives are different. We will handle them separately
  2201. # MS/Novell network drives and shares start with \\
  2202. return $self->_write_url_external_net(@_) if $_[4] =~ m[^external:\\\\];
  2203. my $record = 0x01B8; # Record identifier
  2204. my $length = 0x00000; # Bytes to follow
  2205. my $row1 = $_[0]; # Start row
  2206. my $col1 = $_[1]; # Start column
  2207. my $row2 = $_[2]; # End row
  2208. my $col2 = $_[3]; # End column
  2209. my $url = $_[4]; # URL string
  2210. my $str = $_[5]; # Alternative label
  2211. my $xf = $_[6] || $self->{_url_format};# The cell format
  2212. # Strip URL type and change Unix dir separator to Dos style (if needed)
  2213. #
  2214. $url =~ s[^external:][];
  2215. $url =~ s[/][\\]g;
  2216. # Write the visible label but protect against url recursion in write().
  2217. ($str = $url) =~ s[\#][ - ] unless defined $str;
  2218. $self->{_writing_url} = 1;
  2219. my $error = $self->write($row1, $col1, $str, $xf);
  2220. $self->{_writing_url} = 0;
  2221. return $error if $error == -2;
  2222. # Determine if the link is relative or absolute:
  2223. # Absolute if link starts with DOS drive specifier like C:
  2224. # Otherwise default to 0x00 for relative link.
  2225. #
  2226. my $absolute = 0x00;
  2227. $absolute = 0x02 if $url =~ m/^[A-Za-z]:/;
  2228. # Determine if the link contains a sheet reference and change some of the
  2229. # parameters accordingly.
  2230. # Split the dir name and sheet name (if it exists)
  2231. #
  2232. my ($dir_long , $sheet) = split /\#/, $url;
  2233. my $link_type = 0x01 | $absolute;
  2234. my $sheet_len;
  2235. if (defined $sheet) {
  2236. $link_type |= 0x08;
  2237. $sheet_len = pack("V", length($sheet) + 0x01);
  2238. $sheet = join("\0", split('', $sheet));
  2239. $sheet .= "\0\0\0";
  2240. }
  2241. else {
  2242. $sheet_len = '';
  2243. $sheet = '';
  2244. }
  2245. # Pack the link type
  2246. $link_type = pack("V", $link_type);
  2247. # Calculate the up-level dir count e.g. (..\..\..\ == 3)
  2248. my $up_count = 0;
  2249. $up_count++ while $dir_long =~ s[^\.\.\\][];
  2250. $up_count = pack("v", $up_count);
  2251. # Store the short dos dir name (null terminated)
  2252. my $dir_short = $dir_long . "\0";
  2253. # Store the long dir name as a wchar string (non-null terminated)
  2254. $dir_long = join("\0", split('', $dir_long));
  2255. $dir_long = $dir_long . "\0";
  2256. # Pack the lengths of the dir strings
  2257. my $dir_short_len = pack("V", length $dir_short );
  2258. my $dir_long_len = pack("V", length $dir_long );
  2259. my $stream_len = pack("V", length($dir_long) + 0x06);
  2260. # Pack the undocumented parts of the hyperlink stream
  2261. my $unknown1 =pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000' );
  2262. my $unknown2 =pack("H*",'0303000000000000C000000000000046' );
  2263. my $unknown3 =pack("H*",'FFFFADDE000000000000000000000000000000000000000');
  2264. my $unknown4 =pack("v", 0x03 );
  2265. # Pack the main data stream
  2266. my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
  2267. $unknown1 .
  2268. $link_type .
  2269. $unknown2 .
  2270. $up_count .
  2271. $dir_short_len.
  2272. $dir_short .
  2273. $unknown3 .
  2274. $stream_len .
  2275. $dir_long_len .
  2276. $unknown4 .
  2277. $dir_long .
  2278. $sheet_len .
  2279. $sheet ;
  2280. # Pack the header data
  2281. $length = length $data;
  2282. my $header = pack("vv", $record, $length);
  2283. # Write the packed data
  2284. $self->_append($header, $data);
  2285. return $error;
  2286. }
  2287. ###############################################################################
  2288. #
  2289. # _write_url_external_net($row1, $col1, $row2, $col2, $url, $string, $format)
  2290. #
  2291. # Write links to external MS/Novell network drives and shares such as
  2292. # '//NETWORK/share/foo.xls' and '//NETWORK/share/foo.xls#Sheet1!A1'.
  2293. #
  2294. # See also write_url() above for a general description and return values.
  2295. #
  2296. sub _write_url_external_net {
  2297. my $self = shift;
  2298. my $record = 0x01B8; # Record identifier
  2299. my $length = 0x00000; # Bytes to follow
  2300. my $row1 = $_[0]; # Start row
  2301. my $col1 = $_[1]; # Start column
  2302. my $row2 = $_[2]; # End row
  2303. my $col2 = $_[3]; # End column
  2304. my $url = $_[4]; # URL string
  2305. my $str = $_[5]; # Alternative label
  2306. my $xf = $_[6] || $self->{_url_format};# The cell format
  2307. # Strip URL type and change Unix dir separator to Dos style (if needed)
  2308. #
  2309. $url =~ s[^external:][];
  2310. $url =~ s[/][\\]g;
  2311. # Write the visible label but protect against url recursion in write().
  2312. ($str = $url) =~ s[\#][ - ] unless defined $str;
  2313. $self->{_writing_url} = 1;
  2314. my $error = $self->write($row1, $col1, $str, $xf);
  2315. $self->{_writing_url} = 0;
  2316. return $error if $error == -2;
  2317. # Determine if the link contains a sheet reference and change some of the
  2318. # parameters accordingly.
  2319. # Split the dir name and sheet name (if it exists)
  2320. #
  2321. my ($dir_long , $sheet) = split /\#/, $url;
  2322. my $link_type = 0x0103; # Always absolute
  2323. my $sheet_len;
  2324. if (defined $sheet) {
  2325. $link_type |= 0x08;
  2326. $sheet_len = pack("V", length($sheet) + 0x01);
  2327. $sheet = join("\0", split('', $sheet));
  2328. $sheet .= "\0\0\0";
  2329. }
  2330. else {
  2331. $sheet_len = '';
  2332. $sheet = '';
  2333. }
  2334. # Pack the link type
  2335. $link_type = pack("V", $link_type);
  2336. # Make the string null terminated
  2337. $dir_long = $dir_long . "\0";
  2338. # Pack the lengths of the dir string
  2339. my $dir_long_len = pack("V", length $dir_long);
  2340. # Store the long dir name as a wchar string (non-null terminated)
  2341. $dir_long = join("\0", split('', $dir_long));
  2342. $dir_long = $dir_long . "\0";
  2343. # Pack the undocumented part of the hyperlink stream
  2344. my $unknown1 = pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000');
  2345. # Pack the main data stream
  2346. my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
  2347. $unknown1 .
  2348. $link_type .
  2349. $dir_long_len .
  2350. $dir_long .
  2351. $sheet_len .
  2352. $sheet ;
  2353. # Pack the header data
  2354. $length = length $data;
  2355. my $header = pack("vv", $record, $length);
  2356. # Write the packed data
  2357. $self->_append($header, $data);
  2358. return $error;
  2359. }
  2360. ###############################################################################
  2361. #
  2362. # write_date_time ($row, $col, $string, $format)
  2363. #
  2364. # Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
  2365. # number representing an Excel date. $format is optional.
  2366. #
  2367. # Returns 0 : normal termination
  2368. # -1 : insufficient number of arguments
  2369. # -2 : row or column out of range
  2370. # -3 : Invalid date_time, written as string
  2371. #
  2372. sub write_date_time {
  2373. my $self = shift;
  2374. # Check for a cell reference in A1 notation and substitute row and column
  2375. if ($_[0] =~ /^\D/) {
  2376. @_ = $self->_substitute_cellref(@_);
  2377. }
  2378. if (@_ < 3) { return -1 } # Check the number of args
  2379. my $row = $_[0]; # Zero indexed row
  2380. my $col = $_[1]; # Zero indexed column
  2381. my $str = $_[2];
  2382. # Check that row and col are valid and store max and min values
  2383. return -2 if $self->_check_dimensions($row, $col);
  2384. my $error = 0;
  2385. my $date_time = $self->convert_date_time($str);
  2386. if (defined $date_time) {
  2387. $error = $self->write_number($row, $col, $date_time, $_[3]);
  2388. }
  2389. else {
  2390. # The date isn't valid so write it as a string.
  2391. $self->write_string($row, $col, $str, $_[3]);
  2392. $error = -3;
  2393. }
  2394. return $error;
  2395. }
  2396. ###############################################################################
  2397. #
  2398. # convert_date_time($date_time_string)
  2399. #
  2400. # The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
  2401. # and converts it to a decimal number representing a valid Excel date.
  2402. #
  2403. # Dates and times in Excel are represented by real numbers. The integer part of
  2404. # the number stores the number of days since the epoch and the fractional part
  2405. # stores the percentage of the day in seconds. The epoch can be either 1900 or
  2406. # 1904.
  2407. #
  2408. # Parameter: Date and time string in one of the following formats:
  2409. # yyyy-mm-ddThh:mm:ss.ss # Standard
  2410. # yyyy-mm-ddT # Date only
  2411. # Thh:mm:ss.ss # Time only
  2412. #
  2413. # Returns:
  2414. # A decimal number representing a valid Excel date, or
  2415. # undef if the date is invalid.
  2416. #
  2417. sub convert_date_time {
  2418. my $self = shift;
  2419. my $date_time = $_[0];
  2420. my $days = 0; # Number of days since epoch
  2421. my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
  2422. my ($year, $month, $day);
  2423. my ($hour, $min, $sec);
  2424. # Strip leading and trailing whitespace.
  2425. $date_time =~ s/^\s+//;
  2426. $date_time =~ s/\s+$//;
  2427. # Check for invalid date char.
  2428. return if $date_time =~ /[^0-9T:\-\.Z]/;
  2429. # Check for "T" after date or before time.
  2430. return unless $date_time =~ /\dT|T\d/;
  2431. # Strip trailing Z in ISO8601 date.
  2432. $date_time =~ s/Z$//;
  2433. # Split into date and time.
  2434. my ($date, $time) = split /T/, $date_time;
  2435. # We allow the time portion of the input DateTime to be optional.
  2436. if ($time ne '') {
  2437. # Match hh:mm:ss.sss+ where the seconds are optional
  2438. if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
  2439. $hour = $1;
  2440. $min = $2;
  2441. $sec = $4 || 0;
  2442. }
  2443. else {
  2444. return undef; # Not a valid time format.
  2445. }
  2446. # Some boundary checks
  2447. return if $hour >= 24;
  2448. return if $min >= 60;
  2449. return if $sec >= 60;
  2450. # Excel expresses seconds as a fraction of the number in 24 hours.
  2451. $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
  2452. }
  2453. # We allow the date portion of the input DateTime to be optional.
  2454. return $seconds if $date eq '';
  2455. # Match date as yyyy-mm-dd.
  2456. if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
  2457. $year = $1;
  2458. $month = $2;
  2459. $day = $3;
  2460. }
  2461. else {
  2462. return undef; # Not a valid date format.
  2463. }
  2464. # Set the epoch as 1900 or 1904. Defaults to 1900.
  2465. my $date_1904 = $self->{_1904};
  2466. # Special cases for Excel.
  2467. if (not $date_1904) {
  2468. return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
  2469. return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
  2470. return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
  2471. }
  2472. # We calculate the date by calculating the number of days since the epoch
  2473. # and adjust for the number of leap days. We calculate the number of leap
  2474. # days by normalising the year in relation to the epoch. Thus the year 2000
  2475. # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
  2476. #
  2477. my $epoch = $date_1904 ? 1904 : 1900;
  2478. my $offset = $date_1904 ? 4 : 0;
  2479. my $norm = 300;
  2480. my $range = $year -$epoch;
  2481. # Set month days and check for leap year.
  2482. my @mdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  2483. my $leap = 0;
  2484. $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
  2485. $mdays[1] = 29 if $leap;
  2486. # Some boundary checks
  2487. return if $year < $epoch or $year > 9999;
  2488. return if $month < 1 or $month > 12;
  2489. return if $day < 1 or $day > $mdays[$month -1];
  2490. # Accumulate the number of days since the epoch.
  2491. $days = $day; # Add days for current month
  2492. $days += $mdays[$_] for 0 .. $month -2; # Add days for past months
  2493. $days += $range *365; # Add days for past years
  2494. $days += int(($range) / 4); # Add leapdays
  2495. $days -= int(($range +$offset) /100); # Subtract 100 year leapdays
  2496. $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
  2497. $days -= $leap; # Already counted above
  2498. # Adjust for Excel erroneously treating 1900 as a leap year.
  2499. $days++ if $date_1904 == 0 and $days > 59;
  2500. return $days + $seconds;
  2501. }
  2502. ###############################################################################
  2503. #
  2504. # set_row($row, $height, $XF, $hidden, $level)
  2505. #
  2506. # This method is used to set the height and XF format for a row.
  2507. # Writes the BIFF record ROW.
  2508. #
  2509. sub set_row {
  2510. my $self = shift;
  2511. my $record = 0x0208; # Record identifier
  2512. my $length = 0x0010; # Number of bytes to follow
  2513. my $row = $_[0]; # Row Number
  2514. my $colMic = 0x0000; # First defined column
  2515. my $colMac = 0x0000; # Last defined column
  2516. my $miyRw; # Row height
  2517. my $irwMac = 0x0000; # Used by Excel to optimise loading
  2518. my $reserved = 0x0000; # Reserved
  2519. my $grbit = 0x0000; # Option flags
  2520. my $ixfe; # XF index
  2521. my $height = $_[1]; # Format object
  2522. my $format = $_[2]; # Format object
  2523. my $hidden = $_[3] || 0; # Hidden flag
  2524. my $level = $_[4] || 0; # Outline level
  2525. my $collapsed = $_[5] || 0; # Collapsed row
  2526. return unless defined $row; # Ensure at least $row is specified.
  2527. # Check that row and col are valid and store max and min values
  2528. return -2 if $self->_check_dimensions($row, 0, 0, 1);
  2529. # Check for a format object
  2530. if (ref $format) {
  2531. $ixfe = $format->get_xf_index();
  2532. }
  2533. else {
  2534. $ixfe = 0x0F;
  2535. }
  2536. # Set the row height in units of 1/20 of a point. Note, some heights may
  2537. # not be obtained exactly due to rounding in Excel.
  2538. #
  2539. if (defined $height) {
  2540. $miyRw = $height *20;
  2541. }
  2542. else {
  2543. $miyRw = 0xff; # The default row height
  2544. $height = 0;
  2545. }
  2546. # Set the limits for the outline levels (0 <= x <= 7).
  2547. $level = 0 if $level < 0;
  2548. $level = 7 if $level > 7;
  2549. $self->{_outline_row_level} = $level if $level >$self->{_outline_row_level};
  2550. # Set the options flags.
  2551. # 0x10: The fCollapsed flag indicates that the row contains the "+"
  2552. # when an outline group is collapsed.
  2553. # 0x20: The fDyZero height flag indicates a collapsed or hidden row.
  2554. # 0x40: The fUnsynced flag is used to show that the font and row heights
  2555. # are not compatible. This is usually the case for WriteExcel.
  2556. # 0x80: The fGhostDirty flag indicates that the row has been formatted.
  2557. #
  2558. $grbit |= $level;
  2559. $grbit |= 0x0010 if $collapsed;
  2560. $grbit |= 0x0020 if $hidden;
  2561. $grbit |= 0x0040;
  2562. $grbit |= 0x0080 if $format;
  2563. $grbit |= 0x0100;
  2564. my $header = pack("vv", $record, $length);
  2565. my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
  2566. $irwMac,$reserved, $grbit, $ixfe);
  2567. # Store the data or write immediately depending on the compatibility mode.
  2568. if ($self->{_compatibility}) {
  2569. $self->{_row_data}->{$_[0]} = $header . $data;
  2570. }
  2571. else {
  2572. $self->_append($header, $data);
  2573. }
  2574. # Store the row sizes for use when calculating image vertices.
  2575. # Also store the column formats.
  2576. $self->{_row_sizes}->{$_[0]} = $height;
  2577. $self->{_row_formats}->{$_[0]} = $format if defined $format;
  2578. }
  2579. ###############################################################################
  2580. #
  2581. # _write_row_default()
  2582. #
  2583. # Write a default row record, in compatibility mode, for rows that don't have
  2584. # user specified values..
  2585. #
  2586. sub _write_row_default {
  2587. my $self = shift;
  2588. my $record = 0x0208; # Record identifier
  2589. my $length = 0x0010; # Number of bytes to follow
  2590. my $row = $_[0]; # Row Number
  2591. my $colMic = $_[1]; # First defined column
  2592. my $colMac = $_[2]; # Last defined column
  2593. my $miyRw = 0xFF; # Row height
  2594. my $irwMac = 0x0000; # Used by Excel to optimise loading
  2595. my $reserved = 0x0000; # Reserved
  2596. my $grbit = 0x0100; # Option flags
  2597. my $ixfe = 0x0F; # XF index
  2598. my $header = pack("vv", $record, $length);
  2599. my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
  2600. $irwMac,$reserved, $grbit, $ixfe);
  2601. $self->_append($header, $data);
  2602. }
  2603. ###############################################################################
  2604. #
  2605. # _check_dimensions($row, $col, $ignore_row, $ignore_col)
  2606. #
  2607. # Check that $row and $col are valid and store max and min values for use in
  2608. # DIMENSIONS record. See, _store_dimensions().
  2609. #
  2610. # The $ignore_row/$ignore_col flags is used to indicate that we wish to
  2611. # perform the dimension check without storing the value.
  2612. #
  2613. # The ignore flags are use by set_row() and data_validate.
  2614. #
  2615. sub _check_dimensions {
  2616. my $self = shift;
  2617. my $row = $_[0];
  2618. my $col = $_[1];
  2619. my $ignore_row = $_[2];
  2620. my $ignore_col = $_[3];
  2621. return -2 if not defined $row;
  2622. return -2 if $row >= $self->{_xls_rowmax};
  2623. return -2 if not defined $col;
  2624. return -2 if $col >= $self->{_xls_colmax};
  2625. if (not $ignore_row) {
  2626. if (not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin}) {
  2627. $self->{_dim_rowmin} = $row;
  2628. }
  2629. if (not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax}) {
  2630. $self->{_dim_rowmax} = $row;
  2631. }
  2632. }
  2633. if (not $ignore_col) {
  2634. if (not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin}) {
  2635. $self->{_dim_colmin} = $col;
  2636. }
  2637. if (not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax}) {
  2638. $self->{_dim_colmax} = $col;
  2639. }
  2640. }
  2641. return 0;
  2642. }
  2643. ###############################################################################
  2644. #
  2645. # _store_dimensions()
  2646. #
  2647. # Writes Excel DIMENSIONS to define the area in which there is cell data.
  2648. #
  2649. # Notes:
  2650. # Excel stores the max row/col as row/col +1.
  2651. # Max and min values of 0 are used to indicate that no cell data.
  2652. # We set the undef member data to 0 since it is used by _store_table().
  2653. # Inserting images or charts doesn't change the DIMENSION data.
  2654. #
  2655. sub _store_dimensions {
  2656. my $self = shift;
  2657. my $record = 0x0200; # Record identifier
  2658. my $length = 0x000E; # Number of bytes to follow
  2659. my $row_min; # First row
  2660. my $row_max; # Last row plus 1
  2661. my $col_min; # First column
  2662. my $col_max; # Last column plus 1
  2663. my $reserved = 0x0000; # Reserved by Excel
  2664. if (defined $self->{_dim_rowmin}) {$row_min = $self->{_dim_rowmin} }
  2665. else {$row_min = 0 }
  2666. if (defined $self->{_dim_rowmax}) {$row_max = $self->{_dim_rowmax} + 1}
  2667. else {$row_max = 0 }
  2668. if (defined $self->{_dim_colmin}) {$col_min = $self->{_dim_colmin} }
  2669. else {$col_min = 0 }
  2670. if (defined $self->{_dim_colmax}) {$col_max = $self->{_dim_colmax} + 1}
  2671. else {$col_max = 0 }
  2672. # Set member data to the new max/min value for use by _store_table().
  2673. $self->{_dim_rowmin} = $row_min;
  2674. $self->{_dim_rowmax} = $row_max;
  2675. $self->{_dim_colmin} = $col_min;
  2676. $self->{_dim_colmax} = $col_max;
  2677. my $header = pack("vv", $record, $length);
  2678. my $data = pack("VVvvv", $row_min, $row_max,
  2679. $col_min, $col_max, $reserved);
  2680. $self->_prepend($header, $data);
  2681. }
  2682. ###############################################################################
  2683. #
  2684. # _store_window2()
  2685. #
  2686. # Write BIFF record Window2.
  2687. #
  2688. sub _store_window2 {
  2689. use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
  2690. my $self = shift;
  2691. my $record = 0x023E; # Record identifier
  2692. my $length = 0x0012; # Number of bytes to follow
  2693. my $grbit = 0x00B6; # Option flags
  2694. my $rwTop = $self->{_first_row}; # Top visible row
  2695. my $colLeft = $self->{_first_col}; # Leftmost visible column
  2696. my $rgbHdr = 0x00000040; # Row/col heading, grid color
  2697. my $wScaleSLV = 0x0000; # Zoom in page break preview
  2698. my $wScaleNormal = 0x0000; # Zoom in normal view
  2699. my $reserved = 0x00000000;
  2700. # The options flags that comprise $grbit
  2701. my $fDspFmla = $self->{_display_formulas}; # 0 - bit
  2702. my $fDspGrid = $self->{_screen_gridlines}; # 1
  2703. my $fDspRwCol = $self->{_display_headers}; # 2
  2704. my $fFrozen = $self->{_frozen}; # 3
  2705. my $fDspZeros = $self->{_display_zeros}; # 4
  2706. my $fDefaultHdr = 1; # 5
  2707. my $fArabic = $self->{_display_arabic}; # 6
  2708. my $fDspGuts = $self->{_outline_on}; # 7
  2709. my $fFrozenNoSplit = $self->{_frozen_no_split}; # 0 - bit
  2710. my $fSelected = $self->{_selected}; # 1
  2711. my $fPaged = $self->{_active}; # 2
  2712. my $fBreakPreview = 0; # 3
  2713. $grbit = $fDspFmla;
  2714. $grbit |= $fDspGrid << 1;
  2715. $grbit |= $fDspRwCol << 2;
  2716. $grbit |= $fFrozen << 3;
  2717. $grbit |= $fDspZeros << 4;
  2718. $grbit |= $fDefaultHdr << 5;
  2719. $grbit |= $fArabic << 6;
  2720. $grbit |= $fDspGuts << 7;
  2721. $grbit |= $fFrozenNoSplit << 8;
  2722. $grbit |= $fSelected << 9;
  2723. $grbit |= $fPaged << 10;
  2724. $grbit |= $fBreakPreview << 11;
  2725. my $header = pack("vv", $record, $length);
  2726. my $data = pack("vvvVvvV", $grbit, $rwTop, $colLeft, $rgbHdr,
  2727. $wScaleSLV, $wScaleNormal, $reserved );
  2728. $self->_append($header, $data);
  2729. }
  2730. ###############################################################################
  2731. #
  2732. # _store_page_view()
  2733. #
  2734. # Set page view mode. Only applicable to Mac Excel.
  2735. #
  2736. sub _store_page_view {
  2737. my $self = shift;
  2738. return unless $self->{_page_view};
  2739. my $data = pack "H*", 'C8081100C808000000000040000000000900000000';
  2740. $self->_append($data);
  2741. }
  2742. ###############################################################################
  2743. #
  2744. # _store_tab_color()
  2745. #
  2746. # Write the Tab Color BIFF record.
  2747. #
  2748. sub _store_tab_color {
  2749. my $self = shift;
  2750. my $color = $self->{_tab_color};
  2751. return unless $color;
  2752. my $record = 0x0862; # Record identifier
  2753. my $length = 0x0014; # Number of bytes to follow
  2754. my $zero = 0x0000;
  2755. my $unknown = 0x0014;
  2756. my $header = pack("vv", $record, $length);
  2757. my $data = pack("vvvvvvvvvv", $record, $zero, $zero, $zero, $zero,
  2758. $zero, $unknown, $zero, $color, $zero);
  2759. $self->_append($header, $data);
  2760. }
  2761. ###############################################################################
  2762. #
  2763. # _store_defrow()
  2764. #
  2765. # Write BIFF record DEFROWHEIGHT.
  2766. #
  2767. sub _store_defrow {
  2768. my $self = shift;
  2769. my $record = 0x0225; # Record identifier
  2770. my $length = 0x0004; # Number of bytes to follow
  2771. my $grbit = 0x0000; # Options.
  2772. my $height = 0x00FF; # Default row height
  2773. my $header = pack("vv", $record, $length);
  2774. my $data = pack("vv", $grbit, $height);
  2775. $self->_prepend($header, $data);
  2776. }
  2777. ###############################################################################
  2778. #
  2779. # _store_defcol()
  2780. #
  2781. # Write BIFF record DEFCOLWIDTH.
  2782. #
  2783. sub _store_defcol {
  2784. my $self = shift;
  2785. my $record = 0x0055; # Record identifier
  2786. my $length = 0x0002; # Number of bytes to follow
  2787. my $colwidth = 0x0008; # Default column width
  2788. my $header = pack("vv", $record, $length);
  2789. my $data = pack("v", $colwidth);
  2790. $self->_prepend($header, $data);
  2791. }
  2792. ###############################################################################
  2793. #
  2794. # _store_colinfo($firstcol, $lastcol, $width, $format, $hidden)
  2795. #
  2796. # Write BIFF record COLINFO to define column widths
  2797. #
  2798. # Note: The SDK says the record length is 0x0B but Excel writes a 0x0C
  2799. # length record.
  2800. #
  2801. sub _store_colinfo {
  2802. my $self = shift;
  2803. my $record = 0x007D; # Record identifier
  2804. my $length = 0x000B; # Number of bytes to follow
  2805. my $colFirst = $_[0] || 0; # First formatted column
  2806. my $colLast = $_[1] || 0; # Last formatted column
  2807. my $width = $_[2] || 8.43; # Col width in user units, 8.43 is default
  2808. my $coldx; # Col width in internal units
  2809. my $pixels; # Col width in pixels
  2810. # Excel rounds the column width to the nearest pixel. Therefore we first
  2811. # convert to pixels and then to the internal units. The pixel to users-units
  2812. # relationship is different for values less than 1.
  2813. #
  2814. if ($width < 1) {
  2815. $pixels = int($width *12);
  2816. }
  2817. else {
  2818. $pixels = int($width *7 ) +5;
  2819. }
  2820. $coldx = int($pixels *256/7);
  2821. my $ixfe; # XF index
  2822. my $grbit = 0x0000; # Option flags
  2823. my $reserved = 0x00; # Reserved
  2824. my $format = $_[3]; # Format object
  2825. my $hidden = $_[4] || 0; # Hidden flag
  2826. my $level = $_[5] || 0; # Outline level
  2827. my $collapsed = $_[6] || 0; # Outline level
  2828. # Check for a format object
  2829. if (ref $format) {
  2830. $ixfe = $format->get_xf_index();
  2831. }
  2832. else {
  2833. $ixfe = 0x0F;
  2834. }
  2835. # Set the limits for the outline levels (0 <= x <= 7).
  2836. $level = 0 if $level < 0;
  2837. $level = 7 if $level > 7;
  2838. # Set the options flags. (See set_row() for more details).
  2839. $grbit |= 0x0001 if $hidden;
  2840. $grbit |= $level << 8;
  2841. $grbit |= 0x1000 if $collapsed;
  2842. my $header = pack("vv", $record, $length);
  2843. my $data = pack("vvvvvC", $colFirst, $colLast, $coldx,
  2844. $ixfe, $grbit, $reserved);
  2845. $self->_prepend($header, $data);
  2846. }
  2847. ###############################################################################
  2848. #
  2849. # _store_filtermode()
  2850. #
  2851. # Write BIFF record FILTERMODE to indicate that the worksheet contains
  2852. # AUTOFILTER record, ie. autofilters with a filter set.
  2853. #
  2854. sub _store_filtermode {
  2855. my $self = shift;
  2856. my $record = 0x009B; # Record identifier
  2857. my $length = 0x0000; # Number of bytes to follow
  2858. # Only write the record if the worksheet contains a filtered autofilter.
  2859. return unless $self->{_filter_on};
  2860. my $header = pack("vv", $record, $length);
  2861. $self->_prepend($header);
  2862. }
  2863. ###############################################################################
  2864. #
  2865. # _store_autofilterinfo()
  2866. #
  2867. # Write BIFF record AUTOFILTERINFO.
  2868. #
  2869. sub _store_autofilterinfo {
  2870. my $self = shift;
  2871. my $record = 0x009D; # Record identifier
  2872. my $length = 0x0002; # Number of bytes to follow
  2873. my $num_filters = $self->{_filter_count};
  2874. # Only write the record if the worksheet contains an autofilter.
  2875. return unless $self->{_filter_count};
  2876. my $header = pack("vv", $record, $length);
  2877. my $data = pack("v", $num_filters);
  2878. $self->_prepend($header, $data);
  2879. }
  2880. ###############################################################################
  2881. #
  2882. # _store_selection($first_row, $first_col, $last_row, $last_col)
  2883. #
  2884. # Write BIFF record SELECTION.
  2885. #
  2886. sub _store_selection {
  2887. my $self = shift;
  2888. my $record = 0x001D; # Record identifier
  2889. my $length = 0x000F; # Number of bytes to follow
  2890. my $pnn = $self->{_active_pane}; # Pane position
  2891. my $rwAct = $_[0]; # Active row
  2892. my $colAct = $_[1]; # Active column
  2893. my $irefAct = 0; # Active cell ref
  2894. my $cref = 1; # Number of refs
  2895. my $rwFirst = $_[0]; # First row in reference
  2896. my $colFirst = $_[1]; # First col in reference
  2897. my $rwLast = $_[2] || $rwFirst; # Last row in reference
  2898. my $colLast = $_[3] || $colFirst; # Last col in reference
  2899. # Swap last row/col for first row/col as necessary
  2900. if ($rwFirst > $rwLast) {
  2901. ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
  2902. }
  2903. if ($colFirst > $colLast) {
  2904. ($colFirst, $colLast) = ($colLast, $colFirst);
  2905. }
  2906. my $header = pack("vv", $record, $length);
  2907. my $data = pack("CvvvvvvCC", $pnn, $rwAct, $colAct,
  2908. $irefAct, $cref,
  2909. $rwFirst, $rwLast,
  2910. $colFirst, $colLast);
  2911. $self->_append($header, $data);
  2912. }
  2913. ###############################################################################
  2914. #
  2915. # _store_externcount($count)
  2916. #
  2917. # Write BIFF record EXTERNCOUNT to indicate the number of external sheet
  2918. # references in a worksheet.
  2919. #
  2920. # Excel only stores references to external sheets that are used in formulas.
  2921. # For simplicity we store references to all the sheets in the workbook
  2922. # regardless of whether they are used or not. This reduces the overall
  2923. # complexity and eliminates the need for a two way dialogue between the formula
  2924. # parser the worksheet objects.
  2925. #
  2926. sub _store_externcount {
  2927. my $self = shift;
  2928. my $record = 0x0016; # Record identifier
  2929. my $length = 0x0002; # Number of bytes to follow
  2930. my $cxals = $_[0]; # Number of external references
  2931. my $header = pack("vv", $record, $length);
  2932. my $data = pack("v", $cxals);
  2933. $self->_prepend($header, $data);
  2934. }
  2935. ###############################################################################
  2936. #
  2937. # _store_externsheet($sheetname)
  2938. #
  2939. #
  2940. # Writes the Excel BIFF EXTERNSHEET record. These references are used by
  2941. # formulas. A formula references a sheet name via an index. Since we store a
  2942. # reference to all of the external worksheets the EXTERNSHEET index is the same
  2943. # as the worksheet index.
  2944. #
  2945. sub _store_externsheet {
  2946. my $self = shift;
  2947. my $record = 0x0017; # Record identifier
  2948. my $length; # Number of bytes to follow
  2949. my $sheetname = $_[0]; # Worksheet name
  2950. my $cch; # Length of sheet name
  2951. my $rgch; # Filename encoding
  2952. # References to the current sheet are encoded differently to references to
  2953. # external sheets.
  2954. #
  2955. if ($self->{_name} eq $sheetname) {
  2956. $sheetname = '';
  2957. $length = 0x02; # The following 2 bytes
  2958. $cch = 1; # The following byte
  2959. $rgch = 0x02; # Self reference
  2960. }
  2961. else {
  2962. $length = 0x02 + length($_[0]);
  2963. $cch = length($sheetname);
  2964. $rgch = 0x03; # Reference to a sheet in the current workbook
  2965. }
  2966. my $header = pack("vv", $record, $length);
  2967. my $data = pack("CC", $cch, $rgch);
  2968. $self->_prepend($header, $data, $sheetname);
  2969. }
  2970. ###############################################################################
  2971. #
  2972. # _store_panes()
  2973. #
  2974. #
  2975. # Writes the Excel BIFF PANE record.
  2976. # The panes can either be frozen or thawed (unfrozen).
  2977. # Frozen panes are specified in terms of a integer number of rows and columns.
  2978. # Thawed panes are specified in terms of Excel's units for rows and columns.
  2979. #
  2980. sub _store_panes {
  2981. my $self = shift;
  2982. my $record = 0x0041; # Record identifier
  2983. my $length = 0x000A; # Number of bytes to follow
  2984. my $y = $_[0] || 0; # Vertical split position
  2985. my $x = $_[1] || 0; # Horizontal split position
  2986. my $rwTop = $_[2]; # Top row visible
  2987. my $colLeft = $_[3]; # Leftmost column visible
  2988. my $no_split = $_[4]; # No used here.
  2989. my $pnnAct = $_[5]; # Active pane
  2990. # Code specific to frozen or thawed panes.
  2991. if ($self->{_frozen}) {
  2992. # Set default values for $rwTop and $colLeft
  2993. $rwTop = $y unless defined $rwTop;
  2994. $colLeft = $x unless defined $colLeft;
  2995. }
  2996. else {
  2997. # Set default values for $rwTop and $colLeft
  2998. $rwTop = 0 unless defined $rwTop;
  2999. $colLeft = 0 unless defined $colLeft;
  3000. # Convert Excel's row and column units to the internal units.
  3001. # The default row height is 12.75
  3002. # The default column width is 8.43
  3003. # The following slope and intersection values were interpolated.
  3004. #
  3005. $y = 20*$y + 255;
  3006. $x = 113.879*$x + 390;
  3007. }
  3008. # Determine which pane should be active. There is also the undocumented
  3009. # option to override this should it be necessary: may be removed later.
  3010. #
  3011. if (not defined $pnnAct) {
  3012. $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
  3013. $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
  3014. $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
  3015. $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
  3016. }
  3017. $self->{_active_pane} = $pnnAct; # Used in _store_selection
  3018. my $header = pack("vv", $record, $length);
  3019. my $data = pack("vvvvv", $x, $y, $rwTop, $colLeft, $pnnAct);
  3020. $self->_append($header, $data);
  3021. }
  3022. ###############################################################################
  3023. #
  3024. # _store_setup()
  3025. #
  3026. # Store the page setup SETUP BIFF record.
  3027. #
  3028. sub _store_setup {
  3029. use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
  3030. my $self = shift;
  3031. my $record = 0x00A1; # Record identifier
  3032. my $length = 0x0022; # Number of bytes to follow
  3033. my $iPaperSize = $self->{_paper_size}; # Paper size
  3034. my $iScale = $self->{_print_scale}; # Print scaling factor
  3035. my $iPageStart = $self->{_page_start}; # Starting page number
  3036. my $iFitWidth = $self->{_fit_width}; # Fit to number of pages wide
  3037. my $iFitHeight = $self->{_fit_height}; # Fit to number of pages high
  3038. my $grbit = 0x00; # Option flags
  3039. my $iRes = 0x0258; # Print resolution
  3040. my $iVRes = 0x0258; # Vertical print resolution
  3041. my $numHdr = $self->{_margin_header}; # Header Margin
  3042. my $numFtr = $self->{_margin_footer}; # Footer Margin
  3043. my $iCopies = 0x01; # Number of copies
  3044. my $fLeftToRight = $self->{_page_order}; # Print over then down
  3045. my $fLandscape = $self->{_orientation}; # Page orientation
  3046. my $fNoPls = 0x0; # Setup not read from printer
  3047. my $fNoColor = $self->{_black_white}; # Print black and white
  3048. my $fDraft = $self->{_draft_quality}; # Print draft quality
  3049. my $fNotes = $self->{_print_comments};# Print notes
  3050. my $fNoOrient = 0x0; # Orientation not set
  3051. my $fUsePage = $self->{_custom_start}; # Use custom starting page
  3052. $grbit = $fLeftToRight;
  3053. $grbit |= $fLandscape << 1;
  3054. $grbit |= $fNoPls << 2;
  3055. $grbit |= $fNoColor << 3;
  3056. $grbit |= $fDraft << 4;
  3057. $grbit |= $fNotes << 5;
  3058. $grbit |= $fNoOrient << 6;
  3059. $grbit |= $fUsePage << 7;
  3060. $numHdr = pack("d", $numHdr);
  3061. $numFtr = pack("d", $numFtr);
  3062. if ($self->{_byte_order}) {
  3063. $numHdr = reverse $numHdr;
  3064. $numFtr = reverse $numFtr;
  3065. }
  3066. my $header = pack("vv", $record, $length);
  3067. my $data1 = pack("vvvvvvvv", $iPaperSize,
  3068. $iScale,
  3069. $iPageStart,
  3070. $iFitWidth,
  3071. $iFitHeight,
  3072. $grbit,
  3073. $iRes,
  3074. $iVRes);
  3075. my $data2 = $numHdr .$numFtr;
  3076. my $data3 = pack("v", $iCopies);
  3077. $self->_prepend($header, $data1, $data2, $data3);
  3078. }
  3079. ###############################################################################
  3080. #
  3081. # _store_header()
  3082. #
  3083. # Store the header caption BIFF record.
  3084. #
  3085. sub _store_header {
  3086. my $self = shift;
  3087. my $record = 0x0014; # Record identifier
  3088. my $length; # Bytes to follow
  3089. my $str = $self->{_header}; # header string
  3090. my $cch = length($str); # Length of header string
  3091. my $encoding = $self->{_header_encoding}; # Character encoding
  3092. # Character length is num of chars not num of bytes
  3093. $cch /= 2 if $encoding;
  3094. # Change the UTF-16 name from BE to LE
  3095. $str = pack 'n*', unpack 'v*', $str if $encoding;
  3096. $length = 3 + length($str);
  3097. my $header = pack("vv", $record, $length);
  3098. my $data = pack("vC", $cch, $encoding);
  3099. $self->_prepend($header, $data, $str);
  3100. }
  3101. ###############################################################################
  3102. #
  3103. # _store_footer()
  3104. #
  3105. # Store the footer caption BIFF record.
  3106. #
  3107. sub _store_footer {
  3108. my $self = shift;
  3109. my $record = 0x0015; # Record identifier
  3110. my $length; # Bytes to follow
  3111. my $str = $self->{_footer}; # footer string
  3112. my $cch = length($str); # Length of footer string
  3113. my $encoding = $self->{_footer_encoding}; # Character encoding
  3114. # Character length is num of chars not num of bytes
  3115. $cch /= 2 if $encoding;
  3116. # Change the UTF-16 name from BE to LE
  3117. $str = pack 'n*', unpack 'v*', $str if $encoding;
  3118. $length = 3 + length($str);
  3119. my $header = pack("vv", $record, $length);
  3120. my $data = pack("vC", $cch, $encoding);
  3121. $self->_prepend($header, $data, $str);
  3122. }
  3123. ###############################################################################
  3124. #
  3125. # _store_hcenter()
  3126. #
  3127. # Store the horizontal centering HCENTER BIFF record.
  3128. #
  3129. sub _store_hcenter {
  3130. my $self = shift;
  3131. my $record = 0x0083; # Record identifier
  3132. my $length = 0x0002; # Bytes to follow
  3133. my $fHCenter = $self->{_hcenter}; # Horizontal centering
  3134. my $header = pack("vv", $record, $length);
  3135. my $data = pack("v", $fHCenter);
  3136. $self->_prepend($header, $data);
  3137. }
  3138. ###############################################################################
  3139. #
  3140. # _store_vcenter()
  3141. #
  3142. # Store the vertical centering VCENTER BIFF record.
  3143. #
  3144. sub _store_vcenter {
  3145. my $self = shift;
  3146. my $record = 0x0084; # Record identifier
  3147. my $length = 0x0002; # Bytes to follow
  3148. my $fVCenter = $self->{_vcenter}; # Horizontal centering
  3149. my $header = pack("vv", $record, $length);
  3150. my $data = pack("v", $fVCenter);
  3151. $self->_prepend($header, $data);
  3152. }
  3153. ###############################################################################
  3154. #
  3155. # _store_margin_left()
  3156. #
  3157. # Store the LEFTMARGIN BIFF record.
  3158. #
  3159. sub _store_margin_left {
  3160. my $self = shift;
  3161. my $record = 0x0026; # Record identifier
  3162. my $length = 0x0008; # Bytes to follow
  3163. my $margin = $self->{_margin_left}; # Margin in inches
  3164. my $header = pack("vv", $record, $length);
  3165. my $data = pack("d", $margin);
  3166. if ($self->{_byte_order}) { $data = reverse $data }
  3167. $self->_prepend($header, $data);
  3168. }
  3169. ###############################################################################
  3170. #
  3171. # _store_margin_right()
  3172. #
  3173. # Store the RIGHTMARGIN BIFF record.
  3174. #
  3175. sub _store_margin_right {
  3176. my $self = shift;
  3177. my $record = 0x0027; # Record identifier
  3178. my $length = 0x0008; # Bytes to follow
  3179. my $margin = $self->{_margin_right}; # Margin in inches
  3180. my $header = pack("vv", $record, $length);
  3181. my $data = pack("d", $margin);
  3182. if ($self->{_byte_order}) { $data = reverse $data }
  3183. $self->_prepend($header, $data);
  3184. }
  3185. ###############################################################################
  3186. #
  3187. # _store_margin_top()
  3188. #
  3189. # Store the TOPMARGIN BIFF record.
  3190. #
  3191. sub _store_margin_top {
  3192. my $self = shift;
  3193. my $record = 0x0028; # Record identifier
  3194. my $length = 0x0008; # Bytes to follow
  3195. my $margin = $self->{_margin_top}; # Margin in inches
  3196. my $header = pack("vv", $record, $length);
  3197. my $data = pack("d", $margin);
  3198. if ($self->{_byte_order}) { $data = reverse $data }
  3199. $self->_prepend($header, $data);
  3200. }
  3201. ###############################################################################
  3202. #
  3203. # _store_margin_bottom()
  3204. #
  3205. # Store the BOTTOMMARGIN BIFF record.
  3206. #
  3207. sub _store_margin_bottom {
  3208. my $self = shift;
  3209. my $record = 0x0029; # Record identifier
  3210. my $length = 0x0008; # Bytes to follow
  3211. my $margin = $self->{_margin_bottom}; # Margin in inches
  3212. my $header = pack("vv", $record, $length);
  3213. my $data = pack("d", $margin);
  3214. if ($self->{_byte_order}) { $data = reverse $data }
  3215. $self->_prepend($header, $data);
  3216. }
  3217. ###############################################################################
  3218. #
  3219. # merge_cells($first_row, $first_col, $last_row, $last_col)
  3220. #
  3221. # This is an Excel97/2000 method. It is required to perform more complicated
  3222. # merging than the normal align merge in Format.pm
  3223. #
  3224. sub merge_cells {
  3225. my $self = shift;
  3226. # Check for a cell reference in A1 notation and substitute row and column
  3227. if ($_[0] =~ /^\D/) {
  3228. @_ = $self->_substitute_cellref(@_);
  3229. }
  3230. my $record = 0x00E5; # Record identifier
  3231. my $length = 0x000A; # Bytes to follow
  3232. my $cref = 1; # Number of refs
  3233. my $rwFirst = $_[0]; # First row in reference
  3234. my $colFirst = $_[1]; # First col in reference
  3235. my $rwLast = $_[2] || $rwFirst; # Last row in reference
  3236. my $colLast = $_[3] || $colFirst; # Last col in reference
  3237. # Excel doesn't allow a single cell to be merged
  3238. return if $rwFirst == $rwLast and $colFirst == $colLast;
  3239. # Swap last row/col with first row/col as necessary
  3240. ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
  3241. ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
  3242. my $header = pack("vv", $record, $length);
  3243. my $data = pack("vvvvv", $cref,
  3244. $rwFirst, $rwLast,
  3245. $colFirst, $colLast);
  3246. $self->_append($header, $data);
  3247. }
  3248. ###############################################################################
  3249. #
  3250. # merge_range($row1, $col1, $row2, $col2, $string, $format, $encoding)
  3251. #
  3252. # This is a wrapper to ensure correct use of the merge_cells method, i.e., write
  3253. # the first cell of the range, write the formatted blank cells in the range and
  3254. # then call the merge_cells record. Failing to do the steps in this order will
  3255. # cause Excel 97 to crash.
  3256. #
  3257. sub merge_range {
  3258. my $self = shift;
  3259. # Check for a cell reference in A1 notation and substitute row and column
  3260. if ($_[0] =~ /^\D/) {
  3261. @_ = $self->_substitute_cellref(@_);
  3262. }
  3263. croak "Incorrect number of arguments" if @_ != 6 and @_ != 7;
  3264. croak "Format argument is not a format object" unless ref $_[5];
  3265. my $rwFirst = $_[0];
  3266. my $colFirst = $_[1];
  3267. my $rwLast = $_[2];
  3268. my $colLast = $_[3];
  3269. my $string = $_[4];
  3270. my $format = $_[5];
  3271. my $encoding = $_[6] ? 1 : 0;
  3272. # Temp code to prevent merged formats in non-merged cells.
  3273. my $error = "Error: refer to merge_range() in the documentation. " .
  3274. "Can't use previously non-merged format in merged cells";
  3275. croak $error if $format->{_used_merge} == -1;
  3276. $format->{_used_merge} = 0; # Until the end of this function.
  3277. # Set the merge_range property of the format object. For BIFF8+.
  3278. $format->set_merge_range();
  3279. # Excel doesn't allow a single cell to be merged
  3280. croak "Can't merge single cell" if $rwFirst == $rwLast and
  3281. $colFirst == $colLast;
  3282. # Swap last row/col with first row/col as necessary
  3283. ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
  3284. ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
  3285. # Write the first cell
  3286. if ($encoding) {
  3287. $self->write_utf16be_string($rwFirst, $colFirst, $string, $format);
  3288. }
  3289. else {
  3290. $self->write ($rwFirst, $colFirst, $string, $format);
  3291. }
  3292. # Pad out the rest of the area with formatted blank cells.
  3293. for my $row ($rwFirst .. $rwLast) {
  3294. for my $col ($colFirst .. $colLast) {
  3295. next if $row == $rwFirst and $col == $colFirst;
  3296. $self->write_blank($row, $col, $format);
  3297. }
  3298. }
  3299. $self->merge_cells($rwFirst, $colFirst, $rwLast, $colLast);
  3300. # Temp code to prevent merged formats in non-merged cells.
  3301. $format->{_used_merge} = 1;
  3302. }
  3303. ###############################################################################
  3304. #
  3305. # _store_print_headers()
  3306. #
  3307. # Write the PRINTHEADERS BIFF record.
  3308. #
  3309. sub _store_print_headers {
  3310. my $self = shift;
  3311. my $record = 0x002a; # Record identifier
  3312. my $length = 0x0002; # Bytes to follow
  3313. my $fPrintRwCol = $self->{_print_headers}; # Boolean flag
  3314. my $header = pack("vv", $record, $length);
  3315. my $data = pack("v", $fPrintRwCol);
  3316. $self->_prepend($header, $data);
  3317. }
  3318. ###############################################################################
  3319. #
  3320. # _store_print_gridlines()
  3321. #
  3322. # Write the PRINTGRIDLINES BIFF record. Must be used in conjunction with the
  3323. # GRIDSET record.
  3324. #
  3325. sub _store_print_gridlines {
  3326. my $self = shift;
  3327. my $record = 0x002b; # Record identifier
  3328. my $length = 0x0002; # Bytes to follow
  3329. my $fPrintGrid = $self->{_print_gridlines}; # Boolean flag
  3330. my $header = pack("vv", $record, $length);
  3331. my $data = pack("v", $fPrintGrid);
  3332. $self->_prepend($header, $data);
  3333. }
  3334. ###############################################################################
  3335. #
  3336. # _store_gridset()
  3337. #
  3338. # Write the GRIDSET BIFF record. Must be used in conjunction with the
  3339. # PRINTGRIDLINES record.
  3340. #
  3341. sub _store_gridset {
  3342. my $self = shift;
  3343. my $record = 0x0082; # Record identifier
  3344. my $length = 0x0002; # Bytes to follow
  3345. my $fGridSet = not $self->{_print_gridlines}; # Boolean flag
  3346. my $header = pack("vv", $record, $length);
  3347. my $data = pack("v", $fGridSet);
  3348. $self->_prepend($header, $data);
  3349. }
  3350. ###############################################################################
  3351. #
  3352. # _store_guts()
  3353. #
  3354. # Write the GUTS BIFF record. This is used to configure the gutter margins
  3355. # where Excel outline symbols are displayed. The visibility of the gutters is
  3356. # controlled by a flag in WSBOOL. See also _store_wsbool().
  3357. #
  3358. # We are all in the gutter but some of us are looking at the stars.
  3359. #
  3360. sub _store_guts {
  3361. my $self = shift;
  3362. my $record = 0x0080; # Record identifier
  3363. my $length = 0x0008; # Bytes to follow
  3364. my $dxRwGut = 0x0000; # Size of row gutter
  3365. my $dxColGut = 0x0000; # Size of col gutter
  3366. my $row_level = $self->{_outline_row_level};
  3367. my $col_level = 0;
  3368. # Calculate the maximum column outline level. The equivalent calculation
  3369. # for the row outline level is carried out in set_row().
  3370. #
  3371. foreach my $colinfo (@{$self->{_colinfo}}) {
  3372. # Skip cols without outline level info.
  3373. next if @{$colinfo} < 6;
  3374. $col_level = @{$colinfo}[5] if @{$colinfo}[5] > $col_level;
  3375. }
  3376. # Set the limits for the outline levels (0 <= x <= 7).
  3377. $col_level = 0 if $col_level < 0;
  3378. $col_level = 7 if $col_level > 7;
  3379. # The displayed level is one greater than the max outline levels
  3380. $row_level++ if $row_level > 0;
  3381. $col_level++ if $col_level > 0;
  3382. my $header = pack("vv", $record, $length);
  3383. my $data = pack("vvvv", $dxRwGut, $dxColGut, $row_level, $col_level);
  3384. $self->_prepend($header, $data);
  3385. }
  3386. ###############################################################################
  3387. #
  3388. # _store_wsbool()
  3389. #
  3390. # Write the WSBOOL BIFF record, mainly for fit-to-page. Used in conjunction
  3391. # with the SETUP record.
  3392. #
  3393. sub _store_wsbool {
  3394. my $self = shift;
  3395. my $record = 0x0081; # Record identifier
  3396. my $length = 0x0002; # Bytes to follow
  3397. my $grbit = 0x0000; # Option flags
  3398. # Set the option flags
  3399. $grbit |= 0x0001; # Auto page breaks visible
  3400. $grbit |= 0x0020 if $self->{_outline_style}; # Auto outline styles
  3401. $grbit |= 0x0040 if $self->{_outline_below}; # Outline summary below
  3402. $grbit |= 0x0080 if $self->{_outline_right}; # Outline summary right
  3403. $grbit |= 0x0100 if $self->{_fit_page}; # Page setup fit to page
  3404. $grbit |= 0x0400 if $self->{_outline_on}; # Outline symbols displayed
  3405. my $header = pack("vv", $record, $length);
  3406. my $data = pack("v", $grbit);
  3407. $self->_prepend($header, $data);
  3408. }
  3409. ###############################################################################
  3410. #
  3411. # _store_hbreak()
  3412. #
  3413. # Write the HORIZONTALPAGEBREAKS BIFF record.
  3414. #
  3415. sub _store_hbreak {
  3416. my $self = shift;
  3417. # Return if the user hasn't specified pagebreaks
  3418. return unless @{$self->{_hbreaks}};
  3419. # Sort and filter array of page breaks
  3420. my @breaks = $self->_sort_pagebreaks(@{$self->{_hbreaks}});
  3421. my $record = 0x001b; # Record identifier
  3422. my $cbrk = scalar @breaks; # Number of page breaks
  3423. my $length = 2 + 6*$cbrk; # Bytes to follow
  3424. my $header = pack("vv", $record, $length);
  3425. my $data = pack("v", $cbrk);
  3426. # Append each page break
  3427. foreach my $break (@breaks) {
  3428. $data .= pack("vvv", $break, 0x0000, 0x00ff);
  3429. }
  3430. $self->_prepend($header, $data);
  3431. }
  3432. ###############################################################################
  3433. #
  3434. # _store_vbreak()
  3435. #
  3436. # Write the VERTICALPAGEBREAKS BIFF record.
  3437. #
  3438. sub _store_vbreak {
  3439. my $self = shift;
  3440. # Return if the user hasn't specified pagebreaks
  3441. return unless @{$self->{_vbreaks}};
  3442. # Sort and filter array of page breaks
  3443. my @breaks = $self->_sort_pagebreaks(@{$self->{_vbreaks}});
  3444. my $record = 0x001a; # Record identifier
  3445. my $cbrk = scalar @breaks; # Number of page breaks
  3446. my $length = 2 + 6*$cbrk; # Bytes to follow
  3447. my $header = pack("vv", $record, $length);
  3448. my $data = pack("v", $cbrk);
  3449. # Append each page break
  3450. foreach my $break (@breaks) {
  3451. $data .= pack("vvv", $break, 0x0000, 0xffff);
  3452. }
  3453. $self->_prepend($header, $data);
  3454. }
  3455. ###############################################################################
  3456. #
  3457. # _store_protect()
  3458. #
  3459. # Set the Biff PROTECT record to indicate that the worksheet is protected.
  3460. #
  3461. sub _store_protect {
  3462. my $self = shift;
  3463. # Exit unless sheet protection has been specified
  3464. return unless $self->{_protect};
  3465. my $record = 0x0012; # Record identifier
  3466. my $length = 0x0002; # Bytes to follow
  3467. my $fLock = $self->{_protect}; # Worksheet is protected
  3468. my $header = pack("vv", $record, $length);
  3469. my $data = pack("v", $fLock);
  3470. $self->_prepend($header, $data);
  3471. }
  3472. ###############################################################################
  3473. #
  3474. # _store_obj_protect()
  3475. #
  3476. # Set the Biff OBJPROTECT record to indicate that objects are protected.
  3477. #
  3478. sub _store_obj_protect {
  3479. my $self = shift;
  3480. # Exit unless sheet protection has been specified
  3481. return unless $self->{_protect};
  3482. my $record = 0x0063; # Record identifier
  3483. my $length = 0x0002; # Bytes to follow
  3484. my $fLock = $self->{_protect}; # Worksheet is protected
  3485. my $header = pack("vv", $record, $length);
  3486. my $data = pack("v", $fLock);
  3487. $self->_prepend($header, $data);
  3488. }
  3489. ###############################################################################
  3490. #
  3491. # _store_password()
  3492. #
  3493. # Write the worksheet PASSWORD record.
  3494. #
  3495. sub _store_password {
  3496. my $self = shift;
  3497. # Exit unless sheet protection and password have been specified
  3498. return unless $self->{_protect} and defined $self->{_password};
  3499. my $record = 0x0013; # Record identifier
  3500. my $length = 0x0002; # Bytes to follow
  3501. my $wPassword = $self->{_password}; # Encoded password
  3502. my $header = pack("vv", $record, $length);
  3503. my $data = pack("v", $wPassword);
  3504. $self->_prepend($header, $data);
  3505. }
  3506. #
  3507. # Note about compatibility mode.
  3508. #
  3509. # Excel doesn't require every possible Biff record to be present in a file.
  3510. # In particular if the indexing records INDEX, ROW and DBCELL aren't present
  3511. # it just ignores the fact and reads the cells anyway. This is also true of
  3512. # the EXTSST record. Gnumeric and OOo also take this approach. This allows
  3513. # WriteExcel to ignore these records in order to minimise the amount of data
  3514. # stored in memory. However, other third party applications that read Excel
  3515. # files often expect these records to be present. In "compatibility mode"
  3516. # WriteExcel writes these records and tries to be as close to an Excel
  3517. # generated file as possible.
  3518. #
  3519. # This requires additional data to be stored in memory until the file is
  3520. # about to be written. This incurs a memory and speed penalty and may not be
  3521. # suitable for very large files.
  3522. #
  3523. ###############################################################################
  3524. #
  3525. # _store_table()
  3526. #
  3527. # Write cell data stored in the worksheet row/col table.
  3528. #
  3529. # This is only used when compatibity_mode() is in operation.
  3530. #
  3531. # This method writes ROW data, then cell data (NUMBER, LABELSST, etc) and then
  3532. # DBCELL records in blocks of 32 rows. This is explained in detail (for a
  3533. # change) in the Excel SDK and in the OOo Excel file format doc.
  3534. #
  3535. sub _store_table {
  3536. my $self = shift;
  3537. return unless $self->{_compatibility};
  3538. # Offset from the DBCELL record back to the first ROW of the 32 row block.
  3539. my $row_offset = 0;
  3540. # Track rows that have cell data or modified by set_row().
  3541. my @written_rows;
  3542. # Write the ROW records with updated max/min col fields.
  3543. #
  3544. for my $row (0 .. $self->{_dim_rowmax} -1) {
  3545. # Skip unless there is cell data in row or the row has been modified.
  3546. next unless $self->{_table}->[$row] or $self->{_row_data}->{$row};
  3547. # Store the rows with data.
  3548. push @written_rows, $row;
  3549. # Increase the row offset by the length of a ROW record;
  3550. $row_offset += 20;
  3551. # The max/min cols in the ROW records are the same as in DIMENSIONS.
  3552. my $col_min = $self->{_dim_colmin};
  3553. my $col_max = $self->{_dim_colmax};
  3554. # Write a user specified ROW record (modified by set_row()).
  3555. if ($self->{_row_data}->{$row}) {
  3556. # Rewrite the min and max cols for user defined row record.
  3557. my $packed_row = $self->{_row_data}->{$row};
  3558. substr $packed_row, 6, 4, pack('vv', $col_min, $col_max);
  3559. $self->_append($packed_row);
  3560. }
  3561. else {
  3562. # Write a default Row record if there isn't a user defined ROW.
  3563. $self->_write_row_default($row, $col_min, $col_max);
  3564. }
  3565. # If 32 rows have been written or we are at the last row in the
  3566. # worksheet then write the cell data and the DBCELL record.
  3567. #
  3568. if (@written_rows == 32 or $row == $self->{_dim_rowmax} -1) {
  3569. # Offsets to the first cell of each row.
  3570. my @cell_offsets;
  3571. push @cell_offsets, $row_offset - 20;
  3572. # Write the cell data in each row and sum their lengths for the
  3573. # cell offsets.
  3574. #
  3575. for my $row (@written_rows) {
  3576. my $cell_offset = 0;
  3577. for my $col (@{$self->{_table}->[$row]}) {
  3578. next unless $col;
  3579. $self->_append($col);
  3580. my $length = length $col;
  3581. $row_offset += $length;
  3582. $cell_offset += $length;
  3583. }
  3584. push @cell_offsets, $cell_offset;
  3585. }
  3586. # The last offset isn't required.
  3587. pop @cell_offsets;
  3588. # Stores the DBCELL offset for use in the INDEX record.
  3589. push @{$self->{_db_indices}}, $self->{_datasize};
  3590. # Write the DBCELL record.
  3591. $self->_store_dbcell($row_offset, @cell_offsets);
  3592. # Clear the variable for the next block of rows.
  3593. @written_rows = ();
  3594. @cell_offsets = ();
  3595. $row_offset = 0;
  3596. }
  3597. }
  3598. }
  3599. ###############################################################################
  3600. #
  3601. # _store_dbcell()
  3602. #
  3603. # Store the DBCELL record using the offset calculated in _store_table().
  3604. #
  3605. # This is only used when compatibity_mode() is in operation.
  3606. #
  3607. sub _store_dbcell {
  3608. my $self = shift;
  3609. my $row_offset = shift;
  3610. my @cell_offsets = @_;
  3611. my $record = 0x00D7; # Record identifier
  3612. my $length = 4 + 2 * @cell_offsets; # Bytes to follow
  3613. my $header = pack 'vv', $record, $length;
  3614. my $data = pack 'V', $row_offset;
  3615. $data .= pack 'v', $_ for @cell_offsets;
  3616. $self->_append($header, $data);
  3617. }
  3618. ###############################################################################
  3619. #
  3620. # _store_index()
  3621. #
  3622. # Store the INDEX record using the DBCELL offsets calculated in _store_table().
  3623. #
  3624. # This is only used when compatibity_mode() is in operation.
  3625. #
  3626. sub _store_index {
  3627. my $self = shift;
  3628. return unless $self->{_compatibility};
  3629. my @indices = @{$self->{_db_indices}};
  3630. my $reserved = 0x00000000;
  3631. my $row_min = $self->{_dim_rowmin};
  3632. my $row_max = $self->{_dim_rowmax};
  3633. my $record = 0x020B; # Record identifier
  3634. my $length = 16 + 4 * @indices; # Bytes to follow
  3635. my $header = pack 'vv', $record, $length;
  3636. my $data = pack 'VVVV', $reserved,
  3637. $row_min,
  3638. $row_max,
  3639. $reserved;
  3640. for my $index (@indices) {
  3641. $data .= pack 'V', $index + $self->{_offset} + 20 + $length +4;
  3642. }
  3643. $self->_prepend($header, $data);
  3644. }
  3645. ###############################################################################
  3646. #
  3647. # insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
  3648. #
  3649. # Insert a chart into a worksheet. The $chart argument should be a Chart
  3650. # object or else it is assumed to be a filename of an external binary file.
  3651. # The latter is for backwards compatibility.
  3652. #
  3653. sub insert_chart {
  3654. my $self = shift;
  3655. # Check for a cell reference in A1 notation and substitute row and column
  3656. if ($_[0] =~ /^\D/) {
  3657. @_ = $self->_substitute_cellref(@_);
  3658. }
  3659. my $row = $_[0];
  3660. my $col = $_[1];
  3661. my $chart = $_[2];
  3662. my $x_offset = $_[3] || 0;
  3663. my $y_offset = $_[4] || 0;
  3664. my $scale_x = $_[5] || 1;
  3665. my $scale_y = $_[6] || 1;
  3666. croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
  3667. if ( ref $chart ) {
  3668. # Check for a Chart object.
  3669. croak "Not a Chart object in insert_chart()"
  3670. unless $chart->isa( 'Spreadsheet::WriteExcel::Chart' );
  3671. # Check that the chart is an embedded style chart.
  3672. croak "Not a embedded style Chart object in insert_chart()"
  3673. unless $chart->{_embedded};
  3674. }
  3675. else {
  3676. # Assume an external bin filename.
  3677. croak "Couldn't locate $chart in insert_chart(): $!" unless -e $chart;
  3678. }
  3679. $self->{_charts}->{$row}->{$col} = [
  3680. $row,
  3681. $col,
  3682. $chart,
  3683. $x_offset,
  3684. $y_offset,
  3685. $scale_x,
  3686. $scale_y,
  3687. ];
  3688. }
  3689. # Older method name for backwards compatibility.
  3690. *embed_chart = *insert_chart;
  3691. ###############################################################################
  3692. #
  3693. # insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
  3694. #
  3695. # Insert an image into the worksheet.
  3696. #
  3697. sub insert_image {
  3698. my $self = shift;
  3699. # Check for a cell reference in A1 notation and substitute row and column
  3700. if ($_[0] =~ /^\D/) {
  3701. @_ = $self->_substitute_cellref(@_);
  3702. }
  3703. my $row = $_[0];
  3704. my $col = $_[1];
  3705. my $image = $_[2];
  3706. my $x_offset = $_[3] || 0;
  3707. my $y_offset = $_[4] || 0;
  3708. my $scale_x = $_[5] || 1;
  3709. my $scale_y = $_[6] || 1;
  3710. croak "Insufficient arguments in insert_image()" unless @_ >= 3;
  3711. croak "Couldn't locate $image: $!" unless -e $image;
  3712. $self->{_images}->{$row}->{$col} = [
  3713. $row,
  3714. $col,
  3715. $image,
  3716. $x_offset,
  3717. $y_offset,
  3718. $scale_x,
  3719. $scale_y,
  3720. ];
  3721. }
  3722. # Older method name for backwards compatibility.
  3723. *insert_bitmap = *insert_image;
  3724. ###############################################################################
  3725. #
  3726. # _position_object()
  3727. #
  3728. # Calculate the vertices that define the position of a graphical object within
  3729. # the worksheet.
  3730. #
  3731. # +------------+------------+
  3732. # | A | B |
  3733. # +-----+------------+------------+
  3734. # | |(x1,y1) | |
  3735. # | 1 |(A1)._______|______ |
  3736. # | | | | |
  3737. # | | | | |
  3738. # +-----+----| BITMAP |-----+
  3739. # | | | | |
  3740. # | 2 | |______________. |
  3741. # | | | (B2)|
  3742. # | | | (x2,y2)|
  3743. # +---- +------------+------------+
  3744. #
  3745. # Example of a bitmap that covers some of the area from cell A1 to cell B2.
  3746. #
  3747. # Based on the width and height of the bitmap we need to calculate 8 vars:
  3748. # $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
  3749. # The width and height of the cells are also variable and have to be taken into
  3750. # account.
  3751. # The values of $col_start and $row_start are passed in from the calling
  3752. # function. The values of $col_end and $row_end are calculated by subtracting
  3753. # the width and height of the bitmap from the width and height of the
  3754. # underlying cells.
  3755. # The vertices are expressed as a percentage of the underlying cell width as
  3756. # follows (rhs values are in pixels):
  3757. #
  3758. # x1 = X / W *1024
  3759. # y1 = Y / H *256
  3760. # x2 = (X-1) / W *1024
  3761. # y2 = (Y-1) / H *256
  3762. #
  3763. # Where: X is distance from the left side of the underlying cell
  3764. # Y is distance from the top of the underlying cell
  3765. # W is the width of the cell
  3766. # H is the height of the cell
  3767. #
  3768. # Note: the SDK incorrectly states that the height should be expressed as a
  3769. # percentage of 1024.
  3770. #
  3771. sub _position_object {
  3772. my $self = shift;
  3773. my $col_start; # Col containing upper left corner of object
  3774. my $x1; # Distance to left side of object
  3775. my $row_start; # Row containing top left corner of object
  3776. my $y1; # Distance to top of object
  3777. my $col_end; # Col containing lower right corner of object
  3778. my $x2; # Distance to right side of object
  3779. my $row_end; # Row containing bottom right corner of object
  3780. my $y2; # Distance to bottom of object
  3781. my $width; # Width of image frame
  3782. my $height; # Height of image frame
  3783. ($col_start, $row_start, $x1, $y1, $width, $height) = @_;
  3784. # Adjust start column for offsets that are greater than the col width
  3785. while ($x1 >= $self->_size_col($col_start)) {
  3786. $x1 -= $self->_size_col($col_start);
  3787. $col_start++;
  3788. }
  3789. # Adjust start row for offsets that are greater than the row height
  3790. while ($y1 >= $self->_size_row($row_start)) {
  3791. $y1 -= $self->_size_row($row_start);
  3792. $row_start++;
  3793. }
  3794. # Initialise end cell to the same as the start cell
  3795. $col_end = $col_start;
  3796. $row_end = $row_start;
  3797. $width = $width + $x1;
  3798. $height = $height + $y1;
  3799. # Subtract the underlying cell widths to find the end cell of the image
  3800. while ($width >= $self->_size_col($col_end)) {
  3801. $width -= $self->_size_col($col_end);
  3802. $col_end++;
  3803. }
  3804. # Subtract the underlying cell heights to find the end cell of the image
  3805. while ($height >= $self->_size_row($row_end)) {
  3806. $height -= $self->_size_row($row_end);
  3807. $row_end++;
  3808. }
  3809. # Bitmap isn't allowed to start or finish in a hidden cell, i.e. a cell
  3810. # with zero eight or width.
  3811. #
  3812. return if $self->_size_col($col_start) == 0;
  3813. return if $self->_size_col($col_end) == 0;
  3814. return if $self->_size_row($row_start) == 0;
  3815. return if $self->_size_row($row_end) == 0;
  3816. # Convert the pixel values to the percentage value expected by Excel
  3817. $x1 = $x1 / $self->_size_col($col_start) * 1024;
  3818. $y1 = $y1 / $self->_size_row($row_start) * 256;
  3819. $x2 = $width / $self->_size_col($col_end) * 1024;
  3820. $y2 = $height / $self->_size_row($row_end) * 256;
  3821. # Simulate ceil() without calling POSIX::ceil().
  3822. $x1 = int($x1 +0.5);
  3823. $y1 = int($y1 +0.5);
  3824. $x2 = int($x2 +0.5);
  3825. $y2 = int($y2 +0.5);
  3826. return( $col_start, $x1,
  3827. $row_start, $y1,
  3828. $col_end, $x2,
  3829. $row_end, $y2
  3830. );
  3831. }
  3832. ###############################################################################
  3833. #
  3834. # _size_col($col)
  3835. #
  3836. # Convert the width of a cell from user's units to pixels. Excel rounds the
  3837. # column width to the nearest pixel. If the width hasn't been set by the user
  3838. # we use the default value. If the column is hidden we use a value of zero.
  3839. #
  3840. sub _size_col {
  3841. my $self = shift;
  3842. my $col = $_[0];
  3843. # Look up the cell value to see if it has been changed
  3844. if (exists $self->{_col_sizes}->{$col}) {
  3845. my $width = $self->{_col_sizes}->{$col};
  3846. # The relationship is different for user units less than 1.
  3847. if ($width < 1) {
  3848. return int($width *12);
  3849. }
  3850. else {
  3851. return int($width *7 ) +5;
  3852. }
  3853. }
  3854. else {
  3855. return 64;
  3856. }
  3857. }
  3858. ###############################################################################
  3859. #
  3860. # _size_row($row)
  3861. #
  3862. # Convert the height of a cell from user's units to pixels. By interpolation
  3863. # the relationship is: y = 4/3x. If the height hasn't been set by the user we
  3864. # use the default value. If the row is hidden we use a value of zero. (Not
  3865. # possible to hide row yet).
  3866. #
  3867. sub _size_row {
  3868. my $self = shift;
  3869. my $row = $_[0];
  3870. # Look up the cell value to see if it has been changed
  3871. if (exists $self->{_row_sizes}->{$row}) {
  3872. if ($self->{_row_sizes}->{$row} == 0) {
  3873. return 0;
  3874. }
  3875. else {
  3876. return int (4/3 * $self->{_row_sizes}->{$row});
  3877. }
  3878. }
  3879. else {
  3880. return 17;
  3881. }
  3882. }
  3883. ###############################################################################
  3884. #
  3885. # _store_zoom($zoom)
  3886. #
  3887. #
  3888. # Store the window zoom factor. This should be a reduced fraction but for
  3889. # simplicity we will store all fractions with a numerator of 100.
  3890. #
  3891. sub _store_zoom {
  3892. my $self = shift;
  3893. # If scale is 100 we don't need to write a record
  3894. return if $self->{_zoom} == 100;
  3895. my $record = 0x00A0; # Record identifier
  3896. my $length = 0x0004; # Bytes to follow
  3897. my $header = pack("vv", $record, $length );
  3898. my $data = pack("vv", $self->{_zoom}, 100);
  3899. $self->_append($header, $data);
  3900. }
  3901. ###############################################################################
  3902. #
  3903. # write_utf16be_string($row, $col, $string, $format)
  3904. #
  3905. # Write a Unicode string to the specified row and column (zero indexed).
  3906. # $format is optional.
  3907. # Returns 0 : normal termination
  3908. # -1 : insufficient number of arguments
  3909. # -2 : row or column out of range
  3910. # -3 : long string truncated to 255 chars
  3911. #
  3912. sub write_utf16be_string {
  3913. my $self = shift;
  3914. # Check for a cell reference in A1 notation and substitute row and column
  3915. if ($_[0] =~ /^\D/) {
  3916. @_ = $self->_substitute_cellref(@_);
  3917. }
  3918. if (@_ < 3) { return -1 } # Check the number of args
  3919. my $record = 0x00FD; # Record identifier
  3920. my $length = 0x000A; # Bytes to follow
  3921. my $row = $_[0]; # Zero indexed row
  3922. my $col = $_[1]; # Zero indexed column
  3923. my $strlen = length($_[2]);
  3924. my $str = $_[2];
  3925. my $xf = _XF($self, $row, $col, $_[3]); # The cell format
  3926. my $encoding = 0x1;
  3927. my $str_error = 0;
  3928. # Check that row and col are valid and store max and min values
  3929. return -2 if $self->_check_dimensions($row, $col);
  3930. # Limit the utf16 string to the max number of chars (not bytes).
  3931. if ($strlen > 32767* 2) {
  3932. $str = substr($str, 0, 32767*2);
  3933. $str_error = -3;
  3934. }
  3935. my $num_bytes = length $str;
  3936. my $num_chars = int($num_bytes / 2);
  3937. # Check for a valid 2-byte char string.
  3938. croak "Uneven number of bytes in Unicode string" if $num_bytes % 2;
  3939. # Change from UTF16 big-endian to little endian
  3940. $str = pack "v*", unpack "n*", $str;
  3941. # Add the encoding and length header to the string.
  3942. my $str_header = pack("vC", $num_chars, $encoding);
  3943. $str = $str_header . $str;
  3944. if (not exists ${$self->{_str_table}}->{$str}) {
  3945. ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
  3946. }
  3947. ${$self->{_str_total}}++;
  3948. my $header = pack("vv", $record, $length);
  3949. my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
  3950. # Store the data or write immediately depending on the compatibility mode.
  3951. if ($self->{_compatibility}) {
  3952. $self->{_table}->[$row]->[$col] = $header . $data;
  3953. }
  3954. else {
  3955. $self->_append($header, $data);
  3956. }
  3957. return $str_error;
  3958. }
  3959. ###############################################################################
  3960. #
  3961. # write_utf16le_string($row, $col, $string, $format)
  3962. #
  3963. # Write a UTF-16LE string to the specified row and column (zero indexed).
  3964. # $format is optional.
  3965. # Returns 0 : normal termination
  3966. # -1 : insufficient number of arguments
  3967. # -2 : row or column out of range
  3968. # -3 : long string truncated to 255 chars
  3969. #
  3970. sub write_utf16le_string {
  3971. my $self = shift;
  3972. # Check for a cell reference in A1 notation and substitute row and column
  3973. if ($_[0] =~ /^\D/) {
  3974. @_ = $self->_substitute_cellref(@_);
  3975. }
  3976. if (@_ < 3) { return -1 } # Check the number of args
  3977. my $record = 0x00FD; # Record identifier
  3978. my $length = 0x000A; # Bytes to follow
  3979. my $row = $_[0]; # Zero indexed row
  3980. my $col = $_[1]; # Zero indexed column
  3981. my $str = $_[2];
  3982. my $format = $_[3]; # The cell format
  3983. # Change from UTF16 big-endian to little endian
  3984. $str = pack "v*", unpack "n*", $str;
  3985. return $self->write_utf16be_string($row, $col, $str, $format);
  3986. }
  3987. # Older method name for backwards compatibility.
  3988. *write_unicode = *write_utf16be_string;
  3989. *write_unicode_le = *write_utf16le_string;
  3990. ###############################################################################
  3991. #
  3992. # _store_autofilters()
  3993. #
  3994. # Function to iterate through the columns that form part of an autofilter
  3995. # range and write Biff AUTOFILTER records if a filter expression has been set.
  3996. #
  3997. sub _store_autofilters {
  3998. my $self = shift;
  3999. # Skip all columns if no filter have been set.
  4000. return unless $self->{_filter_on};
  4001. my (undef, undef, $col1, $col2) = @{$self->{_filter_area}};
  4002. for my $i ($col1 .. $col2) {
  4003. # Reverse order since records are being pre-pended.
  4004. my $col = $col2 -$i;
  4005. # Skip if column doesn't have an active filter.
  4006. next unless $self->{_filter_cols}->{$col};
  4007. # Retrieve the filter tokens and write the autofilter records.
  4008. my @tokens = @{$self->{_filter_cols}->{$col}};
  4009. $self->_store_autofilter($col, @tokens);
  4010. }
  4011. }
  4012. ###############################################################################
  4013. #
  4014. # _store_autofilter()
  4015. #
  4016. # Function to write worksheet AUTOFILTER records. These contain 2 Biff Doper
  4017. # structures to represent the 2 possible filter conditions.
  4018. #
  4019. sub _store_autofilter {
  4020. my $self = shift;
  4021. my $record = 0x009E;
  4022. my $length = 0x0000;
  4023. my $index = $_[0];
  4024. my $operator_1 = $_[1];
  4025. my $token_1 = $_[2];
  4026. my $join = $_[3]; # And/Or
  4027. my $operator_2 = $_[4];
  4028. my $token_2 = $_[5];
  4029. my $top10_active = 0;
  4030. my $top10_direction = 0;
  4031. my $top10_percent = 0;
  4032. my $top10_value = 101;
  4033. my $grbit = $join;
  4034. my $optimised_1 = 0;
  4035. my $optimised_2 = 0;
  4036. my $doper_1 = '';
  4037. my $doper_2 = '';
  4038. my $string_1 = '';
  4039. my $string_2 = '';
  4040. # Excel used an optimisation in the case of a simple equality.
  4041. $optimised_1 = 1 if $operator_1 == 2;
  4042. $optimised_2 = 1 if defined $operator_2 and $operator_2 == 2;
  4043. # Convert non-simple equalities back to type 2. See _parse_filter_tokens().
  4044. $operator_1 = 2 if $operator_1 == 22;
  4045. $operator_2 = 2 if defined $operator_2 and $operator_2 == 22;
  4046. # Handle a "Top" style expression.
  4047. if ($operator_1 >= 30) {
  4048. # Remove the second expression if present.
  4049. $operator_2 = undef;
  4050. $token_2 = undef;
  4051. # Set the active flag.
  4052. $top10_active = 1;
  4053. if ($operator_1 == 30 or $operator_1 == 31) {
  4054. $top10_direction = 1;
  4055. }
  4056. if ($operator_1 == 31 or $operator_1 == 33) {
  4057. $top10_percent = 1;
  4058. }
  4059. if ($top10_direction == 1) {
  4060. $operator_1 = 6
  4061. }
  4062. else {
  4063. $operator_1 = 3
  4064. }
  4065. $top10_value = $token_1;
  4066. $token_1 = 0;
  4067. }
  4068. $grbit |= $optimised_1 << 2;
  4069. $grbit |= $optimised_2 << 3;
  4070. $grbit |= $top10_active << 4;
  4071. $grbit |= $top10_direction << 5;
  4072. $grbit |= $top10_percent << 6;
  4073. $grbit |= $top10_value << 7;
  4074. ($doper_1, $string_1) = $self->_pack_doper($operator_1, $token_1);
  4075. ($doper_2, $string_2) = $self->_pack_doper($operator_2, $token_2);
  4076. my $data = pack 'v', $index;
  4077. $data .= pack 'v', $grbit;
  4078. $data .= $doper_1;
  4079. $data .= $doper_2;
  4080. $data .= $string_1;
  4081. $data .= $string_2;
  4082. $length = length $data;
  4083. my $header = pack('vv', $record, $length);
  4084. $self->_prepend($header, $data);
  4085. }
  4086. ###############################################################################
  4087. #
  4088. # _pack_doper()
  4089. #
  4090. # Create a Biff Doper structure that represents a filter expression. Depending
  4091. # on the type of the token we pack an Empty, String or Number doper.
  4092. #
  4093. sub _pack_doper {
  4094. my $self = shift;
  4095. my $operator = $_[0];
  4096. my $token = $_[1];
  4097. my $doper = '';
  4098. my $string = '';
  4099. # Return default doper for non-defined filters.
  4100. if (not defined $operator) {
  4101. return ($self->_pack_unused_doper, $string);
  4102. }
  4103. if ($token =~ /^blanks|nonblanks$/i) {
  4104. $doper = $self->_pack_blanks_doper($operator, $token);
  4105. }
  4106. elsif ($operator == 2 or
  4107. $token !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
  4108. {
  4109. # Excel treats all tokens as strings if the operator is equality, =.
  4110. $string = $token;
  4111. my $encoding = 0;
  4112. my $length = length $string;
  4113. # Handle utf8 strings in perl 5.8.
  4114. if ($] >= 5.008) {
  4115. require Encode;
  4116. if (Encode::is_utf8($string)) {
  4117. $string = Encode::encode("UTF-16BE", $string);
  4118. $encoding = 1;
  4119. }
  4120. }
  4121. $string = pack('C', $encoding) . $string;
  4122. $doper = $self->_pack_string_doper($operator, $length);
  4123. }
  4124. else {
  4125. $string = '';
  4126. $doper = $self->_pack_number_doper($operator, $token);
  4127. }
  4128. return ($doper, $string);
  4129. }
  4130. ###############################################################################
  4131. #
  4132. # _pack_unused_doper()
  4133. #
  4134. # Pack an empty Doper structure.
  4135. #
  4136. sub _pack_unused_doper {
  4137. my $self = shift;
  4138. return pack 'C10', (0x0) x 10;
  4139. }
  4140. ###############################################################################
  4141. #
  4142. # _pack_blanks_doper()
  4143. #
  4144. # Pack an Blanks/NonBlanks Doper structure.
  4145. #
  4146. sub _pack_blanks_doper {
  4147. my $self = shift;
  4148. my $operator = $_[0];
  4149. my $token = $_[1];
  4150. my $type;
  4151. if ($token eq 'blanks') {
  4152. $type = 0x0C;
  4153. $operator = 2;
  4154. }
  4155. else {
  4156. $type = 0x0E;
  4157. $operator = 5;
  4158. }
  4159. my $doper = pack 'CCVV', $type, # Data type
  4160. $operator, #
  4161. 0x0000, # Reserved
  4162. 0x0000; # Reserved
  4163. return $doper;
  4164. }
  4165. ###############################################################################
  4166. #
  4167. # _pack_string_doper()
  4168. #
  4169. # Pack an string Doper structure.
  4170. #
  4171. sub _pack_string_doper {
  4172. my $self = shift;
  4173. my $operator = $_[0];
  4174. my $length = $_[1];
  4175. my $doper = pack 'CCVCCCC', 0x06, # Data type
  4176. $operator, #
  4177. 0x0000, # Reserved
  4178. $length, # String char length.
  4179. 0x0, 0x0, 0x0; # Reserved
  4180. return $doper;
  4181. }
  4182. ###############################################################################
  4183. #
  4184. # _pack_number_doper()
  4185. #
  4186. # Pack an IEEE double number Doper structure.
  4187. #
  4188. sub _pack_number_doper {
  4189. my $self = shift;
  4190. my $operator = $_[0];
  4191. my $number = $_[1];
  4192. $number = pack 'd', $number;
  4193. $number = reverse $number if $self->{_byte_order};
  4194. my $doper = pack 'CC', 0x04, $operator;
  4195. $doper .= $number;
  4196. return $doper;
  4197. }
  4198. #
  4199. # Methods related to comments and MSO objects.
  4200. #
  4201. ###############################################################################
  4202. #
  4203. # _prepare_images()
  4204. #
  4205. # Turn the HoH that stores the images into an array for easier handling.
  4206. #
  4207. sub _prepare_images {
  4208. my $self = shift;
  4209. my $count = 0;
  4210. my @images;
  4211. # We sort the images by row and column but that isn't strictly required.
  4212. #
  4213. my @rows = sort {$a <=> $b} keys %{$self->{_images}};
  4214. for my $row (@rows) {
  4215. my @cols = sort {$a <=> $b} keys %{$self->{_images}->{$row}};
  4216. for my $col (@cols) {
  4217. push @images, $self->{_images}->{$row}->{$col};
  4218. $count++;
  4219. }
  4220. }
  4221. $self->{_images} = {};
  4222. $self->{_images_array} = \@images;
  4223. return $count;
  4224. }
  4225. ###############################################################################
  4226. #
  4227. # _prepare_comments()
  4228. #
  4229. # Turn the HoH that stores the comments into an array for easier handling.
  4230. #
  4231. sub _prepare_comments {
  4232. my $self = shift;
  4233. my $count = 0;
  4234. my @comments;
  4235. # We sort the comments by row and column but that isn't strictly required.
  4236. #
  4237. my @rows = sort {$a <=> $b} keys %{$self->{_comments}};
  4238. for my $row (@rows) {
  4239. my @cols = sort {$a <=> $b} keys %{$self->{_comments}->{$row}};
  4240. for my $col (@cols) {
  4241. push @comments, $self->{_comments}->{$row}->{$col};
  4242. $count++;
  4243. }
  4244. }
  4245. $self->{_comments} = {};
  4246. $self->{_comments_array} = \@comments;
  4247. return $count;
  4248. }
  4249. ###############################################################################
  4250. #
  4251. # _prepare_charts()
  4252. #
  4253. # Turn the HoH that stores the charts into an array for easier handling.
  4254. #
  4255. sub _prepare_charts {
  4256. my $self = shift;
  4257. my $count = 0;
  4258. my @charts;
  4259. # We sort the charts by row and column but that isn't strictly required.
  4260. #
  4261. my @rows = sort {$a <=> $b} keys %{$self->{_charts}};
  4262. for my $row (@rows) {
  4263. my @cols = sort {$a <=> $b} keys %{$self->{_charts}->{$row}};
  4264. for my $col (@cols) {
  4265. push @charts, $self->{_charts}->{$row}->{$col};
  4266. $count++;
  4267. }
  4268. }
  4269. $self->{_charts} = {};
  4270. $self->{_charts_array} = \@charts;
  4271. return $count;
  4272. }
  4273. ###############################################################################
  4274. #
  4275. # _store_images()
  4276. #
  4277. # Store the collections of records that make up images.
  4278. #
  4279. sub _store_images {
  4280. my $self = shift;
  4281. my $record = 0x00EC; # Record identifier
  4282. my $length = 0x0000; # Bytes to follow
  4283. my @ids = @{$self->{_object_ids }};
  4284. my $spid = shift @ids;
  4285. my @images = @{$self->{_images_array}};
  4286. my $num_images = scalar @images;
  4287. my $num_filters = $self->{_filter_count};
  4288. my $num_comments = @{$self->{_comments_array}};
  4289. my $num_charts = @{$self->{_charts_array }};
  4290. # Skip this if there aren't any images.
  4291. return unless $num_images;
  4292. for my $i (0 .. $num_images-1) {
  4293. my $row = $images[$i]->[0];
  4294. my $col = $images[$i]->[1];
  4295. my $name = $images[$i]->[2];
  4296. my $x_offset = $images[$i]->[3];
  4297. my $y_offset = $images[$i]->[4];
  4298. my $scale_x = $images[$i]->[5];
  4299. my $scale_y = $images[$i]->[6];
  4300. my $image_id = $images[$i]->[7];
  4301. my $type = $images[$i]->[8];
  4302. my $width = $images[$i]->[9];
  4303. my $height = $images[$i]->[10];
  4304. $width *= $scale_x if $scale_x;
  4305. $height *= $scale_y if $scale_y;
  4306. # Calculate the positions of image object.
  4307. my @vertices = $self->_position_object( $col,
  4308. $row,
  4309. $x_offset,
  4310. $y_offset,
  4311. $width,
  4312. $height
  4313. );
  4314. if ($i == 0) {
  4315. # Write the parent MSODRAWIING record.
  4316. my $dg_length = 156 + 84*($num_images -1);
  4317. my $spgr_length = 132 + 84*($num_images -1);
  4318. $dg_length += 120 *$num_charts;
  4319. $spgr_length += 120 *$num_charts;
  4320. $dg_length += 96 *$num_filters;
  4321. $spgr_length += 96 *$num_filters;
  4322. $dg_length += 128 *$num_comments;
  4323. $spgr_length += 128 *$num_comments;
  4324. my $data = $self->_store_mso_dg_container($dg_length);
  4325. $data .= $self->_store_mso_dg(@ids);
  4326. $data .= $self->_store_mso_spgr_container($spgr_length);
  4327. $data .= $self->_store_mso_sp_container(40);
  4328. $data .= $self->_store_mso_spgr();
  4329. $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
  4330. $data .= $self->_store_mso_sp_container(76);
  4331. $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
  4332. $data .= $self->_store_mso_opt_image($image_id);
  4333. $data .= $self->_store_mso_client_anchor(2, @vertices);
  4334. $data .= $self->_store_mso_client_data();
  4335. $length = length $data;
  4336. my $header = pack("vv", $record, $length);
  4337. $self->_append($header, $data);
  4338. }
  4339. else {
  4340. # Write the child MSODRAWIING record.
  4341. my $data = $self->_store_mso_sp_container(76);
  4342. $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
  4343. $data .= $self->_store_mso_opt_image($image_id);
  4344. $data .= $self->_store_mso_client_anchor(2, @vertices);
  4345. $data .= $self->_store_mso_client_data();
  4346. $length = length $data;
  4347. my $header = pack("vv", $record, $length);
  4348. $self->_append($header, $data);
  4349. }
  4350. $self->_store_obj_image($i+1);
  4351. }
  4352. $self->{_object_ids}->[0] = $spid;
  4353. }
  4354. ###############################################################################
  4355. #
  4356. # _store_charts()
  4357. #
  4358. # Store the collections of records that make up charts.
  4359. #
  4360. sub _store_charts {
  4361. my $self = shift;
  4362. my $record = 0x00EC; # Record identifier
  4363. my $length = 0x0000; # Bytes to follow
  4364. my @ids = @{$self->{_object_ids}};
  4365. my $spid = shift @ids;
  4366. my @charts = @{$self->{_charts_array}};
  4367. my $num_charts = scalar @charts;
  4368. my $num_filters = $self->{_filter_count};
  4369. my $num_comments = @{$self->{_comments_array}};
  4370. # Number of objects written so far.
  4371. my $num_objects = @{$self->{_images_array}};
  4372. # Skip this if there aren't any charts.
  4373. return unless $num_charts;
  4374. for my $i (0 .. $num_charts-1 ) {
  4375. my $row = $charts[$i]->[0];
  4376. my $col = $charts[$i]->[1];
  4377. my $chart = $charts[$i]->[2];
  4378. my $x_offset = $charts[$i]->[3];
  4379. my $y_offset = $charts[$i]->[4];
  4380. my $scale_x = $charts[$i]->[5];
  4381. my $scale_y = $charts[$i]->[6];
  4382. my $width = 526;
  4383. my $height = 319;
  4384. $width *= $scale_x if $scale_x;
  4385. $height *= $scale_y if $scale_y;
  4386. # Calculate the positions of chart object.
  4387. my @vertices = $self->_position_object( $col,
  4388. $row,
  4389. $x_offset,
  4390. $y_offset,
  4391. $width,
  4392. $height
  4393. );
  4394. if ($i == 0 and not $num_objects) {
  4395. # Write the parent MSODRAWIING record.
  4396. my $dg_length = 192 + 120*($num_charts -1);
  4397. my $spgr_length = 168 + 120*($num_charts -1);
  4398. $dg_length += 96 *$num_filters;
  4399. $spgr_length += 96 *$num_filters;
  4400. $dg_length += 128 *$num_comments;
  4401. $spgr_length += 128 *$num_comments;
  4402. my $data = $self->_store_mso_dg_container($dg_length);
  4403. $data .= $self->_store_mso_dg(@ids);
  4404. $data .= $self->_store_mso_spgr_container($spgr_length);
  4405. $data .= $self->_store_mso_sp_container(40);
  4406. $data .= $self->_store_mso_spgr();
  4407. $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
  4408. $data .= $self->_store_mso_sp_container(112);
  4409. $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
  4410. $data .= $self->_store_mso_opt_chart();
  4411. $data .= $self->_store_mso_client_anchor(0, @vertices);
  4412. $data .= $self->_store_mso_client_data();
  4413. $length = length $data;
  4414. my $header = pack("vv", $record, $length);
  4415. $self->_append($header, $data);
  4416. }
  4417. else {
  4418. # Write the child MSODRAWIING record.
  4419. my $data = $self->_store_mso_sp_container(112);
  4420. $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
  4421. $data .= $self->_store_mso_opt_chart();
  4422. $data .= $self->_store_mso_client_anchor(0, @vertices);
  4423. $data .= $self->_store_mso_client_data();
  4424. $length = length $data;
  4425. my $header = pack("vv", $record, $length);
  4426. $self->_append($header, $data);
  4427. }
  4428. $self->_store_obj_chart($num_objects+$i+1);
  4429. $self->_store_chart_binary($chart);
  4430. }
  4431. # Simulate the EXTERNSHEET link between the chart and data using a formula
  4432. # such as '=Sheet1!A1'.
  4433. # TODO. Won't work for external data refs. Also should use a more direct
  4434. # method.
  4435. #
  4436. my $formula = "='$self->{_name}'!A1";
  4437. $self->store_formula($formula);
  4438. $self->{_object_ids}->[0] = $spid;
  4439. }
  4440. ###############################################################################
  4441. #
  4442. # _store_chart_binary
  4443. #
  4444. # Add the binary data for a chart. This could either be from a Chart object
  4445. # or from an external binary file (for backwards compatibility).
  4446. #
  4447. sub _store_chart_binary {
  4448. my $self = shift;
  4449. my $chart = $_[0];
  4450. my $tmp;
  4451. if ( ref $chart ) {
  4452. $chart->_close();
  4453. my $tmp = $chart->get_data();
  4454. $self->_append( $tmp );
  4455. }
  4456. else {
  4457. my $filehandle = FileHandle->new( $chart )
  4458. or die "Couldn't open $chart in insert_chart(): $!.\n";
  4459. binmode( $filehandle );
  4460. while ( read( $filehandle, $tmp, 4096 ) ) {
  4461. $self->_append( $tmp );
  4462. }
  4463. }
  4464. }
  4465. ###############################################################################
  4466. #
  4467. # _store_filters()
  4468. #
  4469. # Store the collections of records that make up filters.
  4470. #
  4471. sub _store_filters {
  4472. my $self = shift;
  4473. my $record = 0x00EC; # Record identifier
  4474. my $length = 0x0000; # Bytes to follow
  4475. my @ids = @{$self->{_object_ids}};
  4476. my $spid = shift @ids;
  4477. my $filter_area = $self->{_filter_area};
  4478. my $num_filters = $self->{_filter_count};
  4479. my $num_comments = @{$self->{_comments_array}};
  4480. # Number of objects written so far.
  4481. my $num_objects = @{$self->{_images_array}}
  4482. + @{$self->{_charts_array}};
  4483. # Skip this if there aren't any filters.
  4484. return unless $num_filters;
  4485. my ($row1, $row2, $col1, $col2) = @$filter_area;
  4486. for my $i (0 .. $num_filters-1 ) {
  4487. my @vertices = ( $col1 +$i,
  4488. 0,
  4489. $row1,
  4490. 0,
  4491. $col1 +$i +1,
  4492. 0,
  4493. $row1 +1,
  4494. 0);
  4495. if ($i == 0 and not $num_objects) {
  4496. # Write the parent MSODRAWIING record.
  4497. my $dg_length = 168 + 96*($num_filters -1);
  4498. my $spgr_length = 144 + 96*($num_filters -1);
  4499. $dg_length += 128 *$num_comments;
  4500. $spgr_length += 128 *$num_comments;
  4501. my $data = $self->_store_mso_dg_container($dg_length);
  4502. $data .= $self->_store_mso_dg(@ids);
  4503. $data .= $self->_store_mso_spgr_container($spgr_length);
  4504. $data .= $self->_store_mso_sp_container(40);
  4505. $data .= $self->_store_mso_spgr();
  4506. $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
  4507. $data .= $self->_store_mso_sp_container(88);
  4508. $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
  4509. $data .= $self->_store_mso_opt_filter();
  4510. $data .= $self->_store_mso_client_anchor(1, @vertices);
  4511. $data .= $self->_store_mso_client_data();
  4512. $length = length $data;
  4513. my $header = pack("vv", $record, $length);
  4514. $self->_append($header, $data);
  4515. }
  4516. else {
  4517. # Write the child MSODRAWIING record.
  4518. my $data = $self->_store_mso_sp_container(88);
  4519. $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
  4520. $data .= $self->_store_mso_opt_filter();
  4521. $data .= $self->_store_mso_client_anchor(1, @vertices);
  4522. $data .= $self->_store_mso_client_data();
  4523. $length = length $data;
  4524. my $header = pack("vv", $record, $length);
  4525. $self->_append($header, $data);
  4526. }
  4527. $self->_store_obj_filter($num_objects+$i+1, $col1 +$i);
  4528. }
  4529. # Simulate the EXTERNSHEET link between the filter and data using a formula
  4530. # such as '=Sheet1!A1'.
  4531. # TODO. Won't work for external data refs. Also should use a more direct
  4532. # method.
  4533. #
  4534. my $formula = "='$self->{_name}'!A1";
  4535. $self->store_formula($formula);
  4536. $self->{_object_ids}->[0] = $spid;
  4537. }
  4538. ###############################################################################
  4539. #
  4540. # _store_comments()
  4541. #
  4542. # Store the collections of records that make up cell comments.
  4543. #
  4544. # NOTE: We write the comment objects last since that makes it a little easier
  4545. # to write the NOTE records directly after the MSODRAWIING records.
  4546. #
  4547. sub _store_comments {
  4548. my $self = shift;
  4549. my $record = 0x00EC; # Record identifier
  4550. my $length = 0x0000; # Bytes to follow
  4551. my @ids = @{$self->{_object_ids}};
  4552. my $spid = shift @ids;
  4553. my @comments = @{$self->{_comments_array}};
  4554. my $num_comments = scalar @comments;
  4555. # Number of objects written so far.
  4556. my $num_objects = @{$self->{_images_array}}
  4557. + $self->{_filter_count}
  4558. + @{$self->{_charts_array}};
  4559. # Skip this if there aren't any comments.
  4560. return unless $num_comments;
  4561. for my $i (0 .. $num_comments-1) {
  4562. my $row = $comments[$i]->[0];
  4563. my $col = $comments[$i]->[1];
  4564. my $str = $comments[$i]->[2];
  4565. my $encoding = $comments[$i]->[3];
  4566. my $visible = $comments[$i]->[6];
  4567. my $color = $comments[$i]->[7];
  4568. my @vertices = @{$comments[$i]->[8]};
  4569. my $str_len = length $str;
  4570. $str_len /= 2 if $encoding; # Num of chars not bytes.
  4571. my $formats = [[0, 9], [$str_len, 0]];
  4572. if ($i == 0 and not $num_objects) {
  4573. # Write the parent MSODRAWIING record.
  4574. my $dg_length = 200 + 128*($num_comments -1);
  4575. my $spgr_length = 176 + 128*($num_comments -1);
  4576. my $data = $self->_store_mso_dg_container($dg_length);
  4577. $data .= $self->_store_mso_dg(@ids);
  4578. $data .= $self->_store_mso_spgr_container($spgr_length);
  4579. $data .= $self->_store_mso_sp_container(40);
  4580. $data .= $self->_store_mso_spgr();
  4581. $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
  4582. $data .= $self->_store_mso_sp_container(120);
  4583. $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
  4584. $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
  4585. $data .= $self->_store_mso_client_anchor(3, @vertices);
  4586. $data .= $self->_store_mso_client_data();
  4587. $length = length $data;
  4588. my $header = pack("vv", $record, $length);
  4589. $self->_append($header, $data);
  4590. }
  4591. else {
  4592. # Write the child MSODRAWIING record.
  4593. my $data = $self->_store_mso_sp_container(120);
  4594. $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
  4595. $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
  4596. $data .= $self->_store_mso_client_anchor(3, @vertices);
  4597. $data .= $self->_store_mso_client_data();
  4598. $length = length $data;
  4599. my $header = pack("vv", $record, $length);
  4600. $self->_append($header, $data);
  4601. }
  4602. $self->_store_obj_comment($num_objects+$i+1);
  4603. $self->_store_mso_drawing_text_box();
  4604. $self->_store_txo($str_len);
  4605. $self->_store_txo_continue_1($str, $encoding);
  4606. $self->_store_txo_continue_2($formats);
  4607. }
  4608. # Write the NOTE records after MSODRAWIING records.
  4609. for my $i (0 .. $num_comments-1) {
  4610. my $row = $comments[$i]->[0];
  4611. my $col = $comments[$i]->[1];
  4612. my $author = $comments[$i]->[4];
  4613. my $author_enc = $comments[$i]->[5];
  4614. my $visible = $comments[$i]->[6];
  4615. $self->_store_note($row, $col, $num_objects+$i+1,
  4616. $author, $author_enc, $visible);
  4617. }
  4618. }
  4619. ###############################################################################
  4620. #
  4621. # _store_mso_dg_container()
  4622. #
  4623. # Write the Escher DgContainer record that is part of MSODRAWING.
  4624. #
  4625. sub _store_mso_dg_container {
  4626. my $self = shift;
  4627. my $type = 0xF002;
  4628. my $version = 15;
  4629. my $instance = 0;
  4630. my $data = '';
  4631. my $length = $_[0];
  4632. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4633. }
  4634. ###############################################################################
  4635. #
  4636. # _store_mso_dg()
  4637. #
  4638. # Write the Escher Dg record that is part of MSODRAWING.
  4639. #
  4640. sub _store_mso_dg {
  4641. my $self = shift;
  4642. my $type = 0xF008;
  4643. my $version = 0;
  4644. my $instance = $_[0];
  4645. my $data = '';
  4646. my $length = 8;
  4647. my $num_shapes = $_[1];
  4648. my $max_spid = $_[2];
  4649. $data = pack "VV", $num_shapes, $max_spid;
  4650. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4651. }
  4652. ###############################################################################
  4653. #
  4654. # _store_mso_spgr_container()
  4655. #
  4656. # Write the Escher SpgrContainer record that is part of MSODRAWING.
  4657. #
  4658. sub _store_mso_spgr_container {
  4659. my $self = shift;
  4660. my $type = 0xF003;
  4661. my $version = 15;
  4662. my $instance = 0;
  4663. my $data = '';
  4664. my $length = $_[0];
  4665. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4666. }
  4667. ###############################################################################
  4668. #
  4669. # _store_mso_sp_container()
  4670. #
  4671. # Write the Escher SpContainer record that is part of MSODRAWING.
  4672. #
  4673. sub _store_mso_sp_container {
  4674. my $self = shift;
  4675. my $type = 0xF004;
  4676. my $version = 15;
  4677. my $instance = 0;
  4678. my $data = '';
  4679. my $length = $_[0];
  4680. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4681. }
  4682. ###############################################################################
  4683. #
  4684. # _store_mso_spgr()
  4685. #
  4686. # Write the Escher Spgr record that is part of MSODRAWING.
  4687. #
  4688. sub _store_mso_spgr {
  4689. my $self = shift;
  4690. my $type = 0xF009;
  4691. my $version = 1;
  4692. my $instance = 0;
  4693. my $data = pack "VVVV", 0, 0, 0, 0;
  4694. my $length = 16;
  4695. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4696. }
  4697. ###############################################################################
  4698. #
  4699. # _store_mso_sp()
  4700. #
  4701. # Write the Escher Sp record that is part of MSODRAWING.
  4702. #
  4703. sub _store_mso_sp {
  4704. my $self = shift;
  4705. my $type = 0xF00A;
  4706. my $version = 2;
  4707. my $instance = $_[0];
  4708. my $data = '';
  4709. my $length = 8;
  4710. my $spid = $_[1];
  4711. my $options = $_[2];
  4712. $data = pack "VV", $spid, $options;
  4713. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4714. }
  4715. ###############################################################################
  4716. #
  4717. # _store_mso_opt_comment()
  4718. #
  4719. # Write the Escher Opt record that is part of MSODRAWING.
  4720. #
  4721. sub _store_mso_opt_comment {
  4722. my $self = shift;
  4723. my $type = 0xF00B;
  4724. my $version = 3;
  4725. my $instance = 9;
  4726. my $data = '';
  4727. my $length = 54;
  4728. my $spid = $_[0];
  4729. my $visible = $_[1];
  4730. my $colour = $_[2] || 0x50;
  4731. # Use the visible flag if set by the user or else use the worksheet value.
  4732. # Note that the value used is the opposite of _store_note().
  4733. #
  4734. if (defined $visible) {
  4735. $visible = $visible ? 0x0000 : 0x0002;
  4736. }
  4737. else {
  4738. $visible = $self->{_comments_visible} ? 0x0000 : 0x0002;
  4739. }
  4740. $data = pack "V", $spid;
  4741. $data .= pack "H*", '0000BF00080008005801000000008101' ;
  4742. $data .= pack "C", $colour;
  4743. $data .= pack "H*", '000008830150000008BF011000110001' .
  4744. '02000000003F0203000300BF03';
  4745. $data .= pack "v", $visible;
  4746. $data .= pack "H*", '0A00';
  4747. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4748. }
  4749. ###############################################################################
  4750. #
  4751. # _store_mso_opt_image()
  4752. #
  4753. # Write the Escher Opt record that is part of MSODRAWING.
  4754. #
  4755. sub _store_mso_opt_image {
  4756. my $self = shift;
  4757. my $type = 0xF00B;
  4758. my $version = 3;
  4759. my $instance = 3;
  4760. my $data = '';
  4761. my $length = undef;
  4762. my $spid = $_[0];
  4763. $data = pack 'v', 0x4104; # Blip -> pib
  4764. $data .= pack 'V', $spid;
  4765. $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
  4766. $data .= pack 'V', 0x00010000;
  4767. $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
  4768. $data .= pack 'V', 0x00080000;
  4769. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4770. }
  4771. ###############################################################################
  4772. #
  4773. # _store_mso_opt_chart()
  4774. #
  4775. # Write the Escher Opt record that is part of MSODRAWING.
  4776. #
  4777. sub _store_mso_opt_chart {
  4778. my $self = shift;
  4779. my $type = 0xF00B;
  4780. my $version = 3;
  4781. my $instance = 9;
  4782. my $data = '';
  4783. my $length = undef;
  4784. $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
  4785. $data .= pack 'V', 0x01040104;
  4786. $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
  4787. $data .= pack 'V', 0x00080008;
  4788. $data .= pack 'v', 0x0181; # Fill Style -> fillColor
  4789. $data .= pack 'V', 0x0800004E ;
  4790. $data .= pack 'v', 0x0183; # Fill Style -> fillBackColor
  4791. $data .= pack 'V', 0x0800004D;
  4792. $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
  4793. $data .= pack 'V', 0x00110010;
  4794. $data .= pack 'v', 0x01C0; # Line Style -> lineColor
  4795. $data .= pack 'V', 0x0800004D;
  4796. $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
  4797. $data .= pack 'V', 0x00080008;
  4798. $data .= pack 'v', 0x023F; # Shadow Style -> fshadowObscured
  4799. $data .= pack 'V', 0x00020000;
  4800. $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
  4801. $data .= pack 'V', 0x00080000;
  4802. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4803. }
  4804. ###############################################################################
  4805. #
  4806. # _store_mso_opt_filter()
  4807. #
  4808. # Write the Escher Opt record that is part of MSODRAWING.
  4809. #
  4810. sub _store_mso_opt_filter {
  4811. my $self = shift;
  4812. my $type = 0xF00B;
  4813. my $version = 3;
  4814. my $instance = 5;
  4815. my $data = '';
  4816. my $length = undef;
  4817. $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
  4818. $data .= pack 'V', 0x01040104;
  4819. $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
  4820. $data .= pack 'V', 0x00080008;
  4821. $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
  4822. $data .= pack 'V', 0x00010000;
  4823. $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
  4824. $data .= pack 'V', 0x00080000;
  4825. $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
  4826. $data .= pack 'V', 0x000A0000;
  4827. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4828. }
  4829. ###############################################################################
  4830. #
  4831. # _store_mso_client_anchor()
  4832. #
  4833. # Write the Escher ClientAnchor record that is part of MSODRAWING.
  4834. #
  4835. sub _store_mso_client_anchor {
  4836. my $self = shift;
  4837. my $type = 0xF010;
  4838. my $version = 0;
  4839. my $instance = 0;
  4840. my $data = '';
  4841. my $length = 18;
  4842. my $flag = shift;
  4843. my $col_start = $_[0]; # Col containing upper left corner of object
  4844. my $x1 = $_[1]; # Distance to left side of object
  4845. my $row_start = $_[2]; # Row containing top left corner of object
  4846. my $y1 = $_[3]; # Distance to top of object
  4847. my $col_end = $_[4]; # Col containing lower right corner of object
  4848. my $x2 = $_[5]; # Distance to right side of object
  4849. my $row_end = $_[6]; # Row containing bottom right corner of object
  4850. my $y2 = $_[7]; # Distance to bottom of object
  4851. $data = pack "v9", $flag,
  4852. $col_start, $x1,
  4853. $row_start, $y1,
  4854. $col_end, $x2,
  4855. $row_end, $y2;
  4856. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4857. }
  4858. ###############################################################################
  4859. #
  4860. # _store_mso_client_data()
  4861. #
  4862. # Write the Escher ClientData record that is part of MSODRAWING.
  4863. #
  4864. sub _store_mso_client_data {
  4865. my $self = shift;
  4866. my $type = 0xF011;
  4867. my $version = 0;
  4868. my $instance = 0;
  4869. my $data = '';
  4870. my $length = 0;
  4871. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  4872. }
  4873. ###############################################################################
  4874. #
  4875. # _store_obj_comment()
  4876. #
  4877. # Write the OBJ record that is part of cell comments.
  4878. #
  4879. sub _store_obj_comment {
  4880. my $self = shift;
  4881. my $record = 0x005D; # Record identifier
  4882. my $length = 0x0034; # Bytes to follow
  4883. my $obj_id = $_[0]; # Object ID number.
  4884. my $obj_type = 0x0019; # Object type (comment).
  4885. my $data = ''; # Record data.
  4886. my $sub_record = 0x0000; # Sub-record identifier.
  4887. my $sub_length = 0x0000; # Length of sub-record.
  4888. my $sub_data = ''; # Data of sub-record.
  4889. my $options = 0x4011;
  4890. my $reserved = 0x0000;
  4891. # Add ftCmo (common object data) subobject
  4892. $sub_record = 0x0015; # ftCmo
  4893. $sub_length = 0x0012;
  4894. $sub_data = pack "vvvVVV", $obj_type, $obj_id, $options,
  4895. $reserved, $reserved, $reserved;
  4896. $data = pack("vv", $sub_record, $sub_length);
  4897. $data .= $sub_data;
  4898. # Add ftNts (note structure) subobject
  4899. $sub_record = 0x000D; # ftNts
  4900. $sub_length = 0x0016;
  4901. $sub_data = pack "VVVVVv", ($reserved) x 6;
  4902. $data .= pack("vv", $sub_record, $sub_length);
  4903. $data .= $sub_data;
  4904. # Add ftEnd (end of object) subobject
  4905. $sub_record = 0x0000; # ftNts
  4906. $sub_length = 0x0000;
  4907. $data .= pack("vv", $sub_record, $sub_length);
  4908. # Pack the record.
  4909. my $header = pack("vv", $record, $length);
  4910. $self->_append($header, $data);
  4911. }
  4912. ###############################################################################
  4913. #
  4914. # _store_obj_image()
  4915. #
  4916. # Write the OBJ record that is part of image records.
  4917. #
  4918. sub _store_obj_image {
  4919. my $self = shift;
  4920. my $record = 0x005D; # Record identifier
  4921. my $length = 0x0026; # Bytes to follow
  4922. my $obj_id = $_[0]; # Object ID number.
  4923. my $obj_type = 0x0008; # Object type (Picture).
  4924. my $data = ''; # Record data.
  4925. my $sub_record = 0x0000; # Sub-record identifier.
  4926. my $sub_length = 0x0000; # Length of sub-record.
  4927. my $sub_data = ''; # Data of sub-record.
  4928. my $options = 0x6011;
  4929. my $reserved = 0x0000;
  4930. # Add ftCmo (common object data) subobject
  4931. $sub_record = 0x0015; # ftCmo
  4932. $sub_length = 0x0012;
  4933. $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
  4934. $reserved, $reserved, $reserved;
  4935. $data = pack 'vv', $sub_record, $sub_length;
  4936. $data .= $sub_data;
  4937. # Add ftCf (Clipboard format) subobject
  4938. $sub_record = 0x0007; # ftCf
  4939. $sub_length = 0x0002;
  4940. $sub_data = pack 'v', 0xFFFF;
  4941. $data .= pack 'vv', $sub_record, $sub_length;
  4942. $data .= $sub_data;
  4943. # Add ftPioGrbit (Picture option flags) subobject
  4944. $sub_record = 0x0008; # ftPioGrbit
  4945. $sub_length = 0x0002;
  4946. $sub_data = pack 'v', 0x0001;
  4947. $data .= pack 'vv', $sub_record, $sub_length;
  4948. $data .= $sub_data;
  4949. # Add ftEnd (end of object) subobject
  4950. $sub_record = 0x0000; # ftNts
  4951. $sub_length = 0x0000;
  4952. $data .= pack 'vv', $sub_record, $sub_length;
  4953. # Pack the record.
  4954. my $header = pack('vv', $record, $length);
  4955. $self->_append($header, $data);
  4956. }
  4957. ###############################################################################
  4958. #
  4959. # _store_obj_chart()
  4960. #
  4961. # Write the OBJ record that is part of chart records.
  4962. #
  4963. sub _store_obj_chart {
  4964. my $self = shift;
  4965. my $record = 0x005D; # Record identifier
  4966. my $length = 0x001A; # Bytes to follow
  4967. my $obj_id = $_[0]; # Object ID number.
  4968. my $obj_type = 0x0005; # Object type (chart).
  4969. my $data = ''; # Record data.
  4970. my $sub_record = 0x0000; # Sub-record identifier.
  4971. my $sub_length = 0x0000; # Length of sub-record.
  4972. my $sub_data = ''; # Data of sub-record.
  4973. my $options = 0x6011;
  4974. my $reserved = 0x0000;
  4975. # Add ftCmo (common object data) subobject
  4976. $sub_record = 0x0015; # ftCmo
  4977. $sub_length = 0x0012;
  4978. $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
  4979. $reserved, $reserved, $reserved;
  4980. $data = pack 'vv', $sub_record, $sub_length;
  4981. $data .= $sub_data;
  4982. # Add ftEnd (end of object) subobject
  4983. $sub_record = 0x0000; # ftNts
  4984. $sub_length = 0x0000;
  4985. $data .= pack 'vv', $sub_record, $sub_length;
  4986. # Pack the record.
  4987. my $header = pack('vv', $record, $length);
  4988. $self->_append($header, $data);
  4989. }
  4990. ###############################################################################
  4991. #
  4992. # _store_obj_filter()
  4993. #
  4994. # Write the OBJ record that is part of filter records.
  4995. #
  4996. sub _store_obj_filter {
  4997. my $self = shift;
  4998. my $record = 0x005D; # Record identifier
  4999. my $length = 0x0046; # Bytes to follow
  5000. my $obj_id = $_[0]; # Object ID number.
  5001. my $obj_type = 0x0014; # Object type (combo box).
  5002. my $data = ''; # Record data.
  5003. my $sub_record = 0x0000; # Sub-record identifier.
  5004. my $sub_length = 0x0000; # Length of sub-record.
  5005. my $sub_data = ''; # Data of sub-record.
  5006. my $options = 0x2101;
  5007. my $reserved = 0x0000;
  5008. # Add ftCmo (common object data) subobject
  5009. $sub_record = 0x0015; # ftCmo
  5010. $sub_length = 0x0012;
  5011. $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
  5012. $reserved, $reserved, $reserved;
  5013. $data = pack 'vv', $sub_record, $sub_length;
  5014. $data .= $sub_data;
  5015. # Add ftSbs Scroll bar subobject
  5016. $sub_record = 0x000C; # ftSbs
  5017. $sub_length = 0x0014;
  5018. $sub_data = pack 'H*', '0000000000000000640001000A00000010000100';
  5019. $data .= pack 'vv', $sub_record, $sub_length;
  5020. $data .= $sub_data;
  5021. # Add ftLbsData (List box data) subobject
  5022. $sub_record = 0x0013; # ftLbsData
  5023. $sub_length = 0x1FEE; # Special case (undocumented).
  5024. # If the filter is active we set one of the undocumented flags.
  5025. my $col = $_[1];
  5026. if ($self->{_filter_cols}->{$col}) {
  5027. $sub_data = pack 'H*', '000000000100010300000A0008005700';
  5028. }
  5029. else {
  5030. $sub_data = pack 'H*', '00000000010001030000020008005700';
  5031. }
  5032. $data .= pack 'vv', $sub_record, $sub_length;
  5033. $data .= $sub_data;
  5034. # Add ftEnd (end of object) subobject
  5035. $sub_record = 0x0000; # ftNts
  5036. $sub_length = 0x0000;
  5037. $data .= pack 'vv', $sub_record, $sub_length;
  5038. # Pack the record.
  5039. my $header = pack('vv', $record, $length);
  5040. $self->_append($header, $data);
  5041. }
  5042. ###############################################################################
  5043. #
  5044. # _store_mso_drawing_text_box()
  5045. #
  5046. # Write the MSODRAWING ClientTextbox record that is part of comments.
  5047. #
  5048. sub _store_mso_drawing_text_box {
  5049. my $self = shift;
  5050. my $record = 0x00EC; # Record identifier
  5051. my $length = 0x0008; # Bytes to follow
  5052. my $data = $self->_store_mso_client_text_box();
  5053. my $header = pack("vv", $record, $length);
  5054. $self->_append($header, $data);
  5055. }
  5056. ###############################################################################
  5057. #
  5058. # _store_mso_client_text_box()
  5059. #
  5060. # Write the Escher ClientTextbox record that is part of MSODRAWING.
  5061. #
  5062. sub _store_mso_client_text_box {
  5063. my $self = shift;
  5064. my $type = 0xF00D;
  5065. my $version = 0;
  5066. my $instance = 0;
  5067. my $data = '';
  5068. my $length = 0;
  5069. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  5070. }
  5071. ###############################################################################
  5072. #
  5073. # _store_txo()
  5074. #
  5075. # Write the worksheet TXO record that is part of cell comments.
  5076. #
  5077. sub _store_txo {
  5078. my $self = shift;
  5079. my $record = 0x01B6; # Record identifier
  5080. my $length = 0x0012; # Bytes to follow
  5081. my $string_len = $_[0]; # Length of the note text.
  5082. my $format_len = $_[1] || 16; # Length of the format runs.
  5083. my $rotation = $_[2] || 0; # Options
  5084. my $grbit = 0x0212; # Options
  5085. my $reserved = 0x0000; # Options
  5086. # Pack the record.
  5087. my $header = pack("vv", $record, $length);
  5088. my $data = pack("vvVvvvV", $grbit, $rotation, $reserved, $reserved,
  5089. $string_len, $format_len, $reserved);
  5090. $self->_append($header, $data);
  5091. }
  5092. ###############################################################################
  5093. #
  5094. # _store_txo_continue_1()
  5095. #
  5096. # Write the first CONTINUE record to follow the TXO record. It contains the
  5097. # text data.
  5098. #
  5099. sub _store_txo_continue_1 {
  5100. my $self = shift;
  5101. my $record = 0x003C; # Record identifier
  5102. my $string = $_[0]; # Comment string.
  5103. my $encoding = $_[1] || 0; # Encoding of the string.
  5104. # Split long comment strings into smaller continue blocks if necessary.
  5105. # We can't let BIFFwriter::_add_continue() handled this since an extra
  5106. # encoding byte has to be added similar to the SST block.
  5107. #
  5108. # We make the limit size smaller than the _add_continue() size and even
  5109. # so that UTF16 chars occur in the same block.
  5110. #
  5111. my $limit = 8218;
  5112. while (length($string) > $limit) {
  5113. my $tmp_str = substr($string, 0, $limit, "");
  5114. my $data = pack("C", $encoding) . $tmp_str;
  5115. my $length = length $data;
  5116. my $header = pack("vv", $record, $length);
  5117. $self->_append($header, $data);
  5118. }
  5119. # Pack the record.
  5120. my $data = pack("C", $encoding) . $string;
  5121. my $length = length $data;
  5122. my $header = pack("vv", $record, $length);
  5123. $self->_append($header, $data);
  5124. }
  5125. ###############################################################################
  5126. #
  5127. # _store_txo_continue_2()
  5128. #
  5129. # Write the second CONTINUE record to follow the TXO record. It contains the
  5130. # formatting information for the string.
  5131. #
  5132. sub _store_txo_continue_2 {
  5133. my $self = shift;
  5134. my $record = 0x003C; # Record identifier
  5135. my $length = 0x0000; # Bytes to follow
  5136. my $formats = $_[0]; # Formatting information
  5137. # Pack the record.
  5138. my $data = '';
  5139. for my $a_ref (@$formats) {
  5140. $data .= pack "vvV", $a_ref->[0], $a_ref->[1], 0x0;
  5141. }
  5142. $length = length $data;
  5143. my $header = pack("vv", $record, $length);
  5144. $self->_append($header, $data);
  5145. }
  5146. ###############################################################################
  5147. #
  5148. # _store_note()
  5149. #
  5150. # Write the worksheet NOTE record that is part of cell comments.
  5151. #
  5152. sub _store_note {
  5153. my $self = shift;
  5154. my $record = 0x001C; # Record identifier
  5155. my $length = 0x000C; # Bytes to follow
  5156. my $row = $_[0];
  5157. my $col = $_[1];
  5158. my $obj_id = $_[2];
  5159. my $author = $_[3] || $self->{_comments_author};
  5160. my $author_enc = $_[4] || $self->{_comments_author_enc};
  5161. my $visible = $_[5];
  5162. # Use the visible flag if set by the user or else use the worksheet value.
  5163. # The flag is also set in _store_mso_opt_comment() but with the opposite
  5164. # value.
  5165. if (defined $visible) {
  5166. $visible = $visible ? 0x0002 : 0x0000;
  5167. }
  5168. else {
  5169. $visible = $self->{_comments_visible} ? 0x0002 : 0x0000;
  5170. }
  5171. # Get the number of chars in the author string (not bytes).
  5172. my $num_chars = length $author;
  5173. $num_chars /= 2 if $author_enc;
  5174. # Null terminate the author string.
  5175. $author .= "\0";
  5176. # Pack the record.
  5177. my $data = pack("vvvvvC", $row, $col, $visible, $obj_id,
  5178. $num_chars, $author_enc);
  5179. $length = length($data) + length($author);
  5180. my $header = pack("vv", $record, $length);
  5181. $self->_append($header, $data, $author);
  5182. }
  5183. ###############################################################################
  5184. #
  5185. # _comment_params()
  5186. #
  5187. # This method handles the additional optional parameters to write_comment() as
  5188. # well as calculating the comment object position and vertices.
  5189. #
  5190. sub _comment_params {
  5191. my $self = shift;
  5192. my $row = shift;
  5193. my $col = shift;
  5194. my $string = shift;
  5195. my $default_width = 128;
  5196. my $default_height = 74;
  5197. my %params = (
  5198. author => '',
  5199. author_encoding => 0,
  5200. encoding => 0,
  5201. color => undef,
  5202. start_cell => undef,
  5203. start_col => undef,
  5204. start_row => undef,
  5205. visible => undef,
  5206. width => $default_width,
  5207. height => $default_height,
  5208. x_offset => undef,
  5209. x_scale => 1,
  5210. y_offset => undef,
  5211. y_scale => 1,
  5212. );
  5213. # Overwrite the defaults with any user supplied values. Incorrect or
  5214. # misspelled parameters are silently ignored.
  5215. %params = (%params, @_);
  5216. # Ensure that a width and height have been set.
  5217. $params{width} = $default_width if not $params{width};
  5218. $params{height} = $default_height if not $params{height};
  5219. # Check that utf16 strings have an even number of bytes.
  5220. if ($params{encoding}) {
  5221. croak "Uneven number of bytes in comment string"
  5222. if length($string) % 2;
  5223. # Change from UTF-16BE to UTF-16LE
  5224. $string = pack 'v*', unpack 'n*', $string;
  5225. }
  5226. if ($params{author_encoding}) {
  5227. croak "Uneven number of bytes in author string"
  5228. if length($params{author}) % 2;
  5229. # Change from UTF-16BE to UTF-16LE
  5230. $params{author} = pack 'v*', unpack 'n*', $params{author};
  5231. }
  5232. # Handle utf8 strings in perl 5.8.
  5233. if ($] >= 5.008) {
  5234. require Encode;
  5235. if (Encode::is_utf8($string)) {
  5236. $string = Encode::encode("UTF-16LE", $string);
  5237. $params{encoding} = 1;
  5238. }
  5239. if (Encode::is_utf8($params{author})) {
  5240. $params{author} = Encode::encode("UTF-16LE", $params{author});
  5241. $params{author_encoding} = 1;
  5242. }
  5243. }
  5244. # Limit the string to the max number of chars (not bytes).
  5245. my $max_len = 32767;
  5246. $max_len *= 2 if $params{encoding};
  5247. if (length($string) > $max_len) {
  5248. $string = substr($string, 0, $max_len);
  5249. }
  5250. # Set the comment background colour.
  5251. my $color = $params{color};
  5252. $color = &Spreadsheet::WriteExcel::Format::_get_color($color);
  5253. $color = 0x50 if $color == 0x7FFF; # Default color.
  5254. $params{color} = $color;
  5255. # Convert a cell reference to a row and column.
  5256. if (defined $params{start_cell}) {
  5257. my ($row, $col) = $self->_substitute_cellref($params{start_cell});
  5258. $params{start_row} = $row;
  5259. $params{start_col} = $col;
  5260. }
  5261. # Set the default start cell and offsets for the comment. These are
  5262. # generally fixed in relation to the parent cell. However there are
  5263. # some edge cases for cells at the, er, edges.
  5264. #
  5265. if (not defined $params{start_row}) {
  5266. if ($row == 0 ) {$params{start_row} = 0 }
  5267. elsif ($row == 65533) {$params{start_row} = 65529 }
  5268. elsif ($row == 65534) {$params{start_row} = 65530 }
  5269. elsif ($row == 65535) {$params{start_row} = 65531 }
  5270. else {$params{start_row} = $row -1}
  5271. }
  5272. if (not defined $params{y_offset}) {
  5273. if ($row == 0 ) {$params{y_offset} = 2 }
  5274. elsif ($row == 65533) {$params{y_offset} = 4 }
  5275. elsif ($row == 65534) {$params{y_offset} = 4 }
  5276. elsif ($row == 65535) {$params{y_offset} = 2 }
  5277. else {$params{y_offset} = 7 }
  5278. }
  5279. if (not defined $params{start_col}) {
  5280. if ($col == 253 ) {$params{start_col} = 250 }
  5281. elsif ($col == 254 ) {$params{start_col} = 251 }
  5282. elsif ($col == 255 ) {$params{start_col} = 252 }
  5283. else {$params{start_col} = $col +1}
  5284. }
  5285. if (not defined $params{x_offset}) {
  5286. if ($col == 253 ) {$params{x_offset} = 49 }
  5287. elsif ($col == 254 ) {$params{x_offset} = 49 }
  5288. elsif ($col == 255 ) {$params{x_offset} = 49 }
  5289. else {$params{x_offset} = 15 }
  5290. }
  5291. # Scale the size of the comment box if required.
  5292. if ($params{x_scale}) {
  5293. $params{width} = $params{width} * $params{x_scale};
  5294. }
  5295. if ($params{y_scale}) {
  5296. $params{height} = $params{height} * $params{y_scale};
  5297. }
  5298. # Calculate the positions of comment object.
  5299. my @vertices = $self->_position_object( $params{start_col},
  5300. $params{start_row},
  5301. $params{x_offset},
  5302. $params{y_offset},
  5303. $params{width},
  5304. $params{height}
  5305. );
  5306. return(
  5307. $row,
  5308. $col,
  5309. $string,
  5310. $params{encoding},
  5311. $params{author},
  5312. $params{author_encoding},
  5313. $params{visible},
  5314. $params{color},
  5315. [@vertices]
  5316. );
  5317. }
  5318. #
  5319. # DATA VALIDATION
  5320. #
  5321. ###############################################################################
  5322. #
  5323. # data_validation($row, $col, {...})
  5324. #
  5325. # This method handles the interface to Excel data validation.
  5326. # Somewhat ironically the this requires a lot of validation code since the
  5327. # interface is flexible and covers a several types of data validation.
  5328. #
  5329. # We allow data validation to be called on one cell or a range of cells. The
  5330. # hashref contains the validation parameters and must be the last param:
  5331. # data_validation($row, $col, {...})
  5332. # data_validation($first_row, $first_col, $last_row, $last_col, {...})
  5333. #
  5334. # Returns 0 : normal termination
  5335. # -1 : insufficient number of arguments
  5336. # -2 : row or column out of range
  5337. # -3 : incorrect parameter.
  5338. #
  5339. sub data_validation {
  5340. my $self = shift;
  5341. # Check for a cell reference in A1 notation and substitute row and column
  5342. if ($_[0] =~ /^\D/) {
  5343. @_ = $self->_substitute_cellref(@_);
  5344. }
  5345. # Check for a valid number of args.
  5346. if (@_ != 5 && @_ != 3) { return -1 }
  5347. # The final hashref contains the validation parameters.
  5348. my $param = pop;
  5349. # Make the last row/col the same as the first if not defined.
  5350. my ($row1, $col1, $row2, $col2) = @_;
  5351. if (!defined $row2) {
  5352. $row2 = $row1;
  5353. $col2 = $col1;
  5354. }
  5355. # Check that row and col are valid without storing the values.
  5356. return -2 if $self->_check_dimensions($row1, $col1, 1, 1);
  5357. return -2 if $self->_check_dimensions($row2, $col2, 1, 1);
  5358. # Check that the last parameter is a hash list.
  5359. if (ref $param ne 'HASH') {
  5360. carp "Last parameter '$param' in data_validation() must be a hash ref";
  5361. return -3;
  5362. }
  5363. # List of valid input parameters.
  5364. my %valid_parameter = (
  5365. validate => 1,
  5366. criteria => 1,
  5367. value => 1,
  5368. source => 1,
  5369. minimum => 1,
  5370. maximum => 1,
  5371. ignore_blank => 1,
  5372. dropdown => 1,
  5373. show_input => 1,
  5374. input_title => 1,
  5375. input_message => 1,
  5376. show_error => 1,
  5377. error_title => 1,
  5378. error_message => 1,
  5379. error_type => 1,
  5380. other_cells => 1,
  5381. );
  5382. # Check for valid input parameters.
  5383. for my $param_key (keys %$param) {
  5384. if (not exists $valid_parameter{$param_key}) {
  5385. carp "Unknown parameter '$param_key' in data_validation()";
  5386. return -3;
  5387. }
  5388. }
  5389. # Map alternative parameter names 'source' or 'minimum' to 'value'.
  5390. $param->{value} = $param->{source} if defined $param->{source};
  5391. $param->{value} = $param->{minimum} if defined $param->{minimum};
  5392. # 'validate' is a required parameter.
  5393. if (not exists $param->{validate}) {
  5394. carp "Parameter 'validate' is required in data_validation()";
  5395. return -3;
  5396. }
  5397. # List of valid validation types.
  5398. my %valid_type = (
  5399. 'any' => 0,
  5400. 'any value' => 0,
  5401. 'whole number' => 1,
  5402. 'whole' => 1,
  5403. 'integer' => 1,
  5404. 'decimal' => 2,
  5405. 'list' => 3,
  5406. 'date' => 4,
  5407. 'time' => 5,
  5408. 'text length' => 6,
  5409. 'length' => 6,
  5410. 'custom' => 7,
  5411. );
  5412. # Check for valid validation types.
  5413. if (not exists $valid_type{lc($param->{validate})}) {
  5414. carp "Unknown validation type '$param->{validate}' for parameter " .
  5415. "'validate' in data_validation()";
  5416. return -3;
  5417. }
  5418. else {
  5419. $param->{validate} = $valid_type{lc($param->{validate})};
  5420. }
  5421. # No action is required for validation type 'any'.
  5422. # TODO: we should perhaps store 'any' for message only validations.
  5423. return 0 if $param->{validate} == 0;
  5424. # The list and custom validations don't have a criteria so we use a default
  5425. # of 'between'.
  5426. if ($param->{validate} == 3 || $param->{validate} == 7) {
  5427. $param->{criteria} = 'between';
  5428. $param->{maximum} = undef;
  5429. }
  5430. # 'criteria' is a required parameter.
  5431. if (not exists $param->{criteria}) {
  5432. carp "Parameter 'criteria' is required in data_validation()";
  5433. return -3;
  5434. }
  5435. # List of valid criteria types.
  5436. my %criteria_type = (
  5437. 'between' => 0,
  5438. 'not between' => 1,
  5439. 'equal to' => 2,
  5440. '=' => 2,
  5441. '==' => 2,
  5442. 'not equal to' => 3,
  5443. '!=' => 3,
  5444. '<>' => 3,
  5445. 'greater than' => 4,
  5446. '>' => 4,
  5447. 'less than' => 5,
  5448. '<' => 5,
  5449. 'greater than or equal to' => 6,
  5450. '>=' => 6,
  5451. 'less than or equal to' => 7,
  5452. '<=' => 7,
  5453. );
  5454. # Check for valid criteria types.
  5455. if (not exists $criteria_type{lc($param->{criteria})}) {
  5456. carp "Unknown criteria type '$param->{criteria}' for parameter " .
  5457. "'criteria' in data_validation()";
  5458. return -3;
  5459. }
  5460. else {
  5461. $param->{criteria} = $criteria_type{lc($param->{criteria})};
  5462. }
  5463. # 'Between' and 'Not between' criteria require 2 values.
  5464. if ($param->{criteria} == 0 || $param->{criteria} == 1) {
  5465. if (not exists $param->{maximum}) {
  5466. carp "Parameter 'maximum' is required in data_validation() " .
  5467. "when using 'between' or 'not between' criteria";
  5468. return -3;
  5469. }
  5470. }
  5471. else {
  5472. $param->{maximum} = undef;
  5473. }
  5474. # List of valid error dialog types.
  5475. my %error_type = (
  5476. 'stop' => 0,
  5477. 'warning' => 1,
  5478. 'information' => 2,
  5479. );
  5480. # Check for valid error dialog types.
  5481. if (not exists $param->{error_type}) {
  5482. $param->{error_type} = 0;
  5483. }
  5484. elsif (not exists $error_type{lc($param->{error_type})}) {
  5485. carp "Unknown criteria type '$param->{error_type}' for parameter " .
  5486. "'error_type' in data_validation()";
  5487. return -3;
  5488. }
  5489. else {
  5490. $param->{error_type} = $error_type{lc($param->{error_type})};
  5491. }
  5492. # Convert date/times value if required.
  5493. if ($param->{validate} == 4 || $param->{validate} == 5) {
  5494. if ($param->{value} =~ /T/) {
  5495. my $date_time = $self->convert_date_time($param->{value});
  5496. if (!defined $date_time) {
  5497. carp "Invalid date/time value '$param->{value}' " .
  5498. "in data_validation()";
  5499. return -3;
  5500. }
  5501. else {
  5502. $param->{value} = $date_time;
  5503. }
  5504. }
  5505. if (defined $param->{maximum} && $param->{maximum} =~ /T/) {
  5506. my $date_time = $self->convert_date_time($param->{maximum});
  5507. if (!defined $date_time) {
  5508. carp "Invalid date/time value '$param->{maximum}' " .
  5509. "in data_validation()";
  5510. return -3;
  5511. }
  5512. else {
  5513. $param->{maximum} = $date_time;
  5514. }
  5515. }
  5516. }
  5517. # Set some defaults if they haven't been defined by the user.
  5518. $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
  5519. $param->{dropdown} = 1 if !defined $param->{dropdown};
  5520. $param->{show_input} = 1 if !defined $param->{show_input};
  5521. $param->{show_error} = 1 if !defined $param->{show_error};
  5522. # These are the cells to which the validation is applied.
  5523. $param->{cells} = [[$row1, $col1, $row2, $col2]];
  5524. # A (for now) undocumented parameter to pass additional cell ranges.
  5525. if (exists $param->{other_cells}) {
  5526. push @{$param->{cells}}, @{$param->{other_cells}};
  5527. }
  5528. # Store the validation information until we close the worksheet.
  5529. push @{$self->{_validations}}, $param;
  5530. }
  5531. ###############################################################################
  5532. #
  5533. # _store_validation_count()
  5534. #
  5535. # Store the count of the DV records to follow.
  5536. #
  5537. # Note, this could be wrapped into _store_dv() but we may require separate
  5538. # handling of the object id at a later stage.
  5539. #
  5540. sub _store_validation_count {
  5541. my $self = shift;
  5542. my $dv_count = @{$self->{_validations}};
  5543. my $obj_id = -1;
  5544. return unless $dv_count;
  5545. $self->_store_dval($obj_id , $dv_count);
  5546. }
  5547. ###############################################################################
  5548. #
  5549. # _store_validations()
  5550. #
  5551. # Store the data_validation records.
  5552. #
  5553. sub _store_validations {
  5554. my $self = shift;
  5555. return unless scalar @{$self->{_validations}};
  5556. for my $param (@{$self->{_validations}}) {
  5557. $self->_store_dv( $param->{cells},
  5558. $param->{validate},
  5559. $param->{criteria},
  5560. $param->{value},
  5561. $param->{maximum},
  5562. $param->{input_title},
  5563. $param->{input_message},
  5564. $param->{error_title},
  5565. $param->{error_message},
  5566. $param->{error_type},
  5567. $param->{ignore_blank},
  5568. $param->{dropdown},
  5569. $param->{show_input},
  5570. $param->{show_error},
  5571. );
  5572. }
  5573. }
  5574. ###############################################################################
  5575. #
  5576. # _store_dval()
  5577. #
  5578. # Store the DV record which contains the number of and information common to
  5579. # all DV structures.
  5580. #
  5581. sub _store_dval {
  5582. my $self = shift;
  5583. my $record = 0x01B2; # Record identifier
  5584. my $length = 0x0012; # Bytes to follow
  5585. my $obj_id = $_[0]; # Object ID number.
  5586. my $dv_count = $_[1]; # Count of DV structs to follow.
  5587. my $flags = 0x0004; # Option flags.
  5588. my $x_coord = 0x00000000; # X coord of input box.
  5589. my $y_coord = 0x00000000; # Y coord of input box.
  5590. # Pack the record.
  5591. my $header = pack('vv', $record, $length);
  5592. my $data = pack('vVVVV', $flags, $x_coord, $y_coord, $obj_id, $dv_count);
  5593. $self->_append($header, $data);
  5594. }
  5595. ###############################################################################
  5596. #
  5597. # _store_dv()
  5598. #
  5599. # Store the DV record that specifies the data validation criteria and options
  5600. # for a range of cells..
  5601. #
  5602. sub _store_dv {
  5603. my $self = shift;
  5604. my $record = 0x01BE; # Record identifier
  5605. my $length = 0x0000; # Bytes to follow
  5606. my $flags = 0x00000000; # DV option flags.
  5607. my $cells = $_[0]; # Aref of cells to which DV applies.
  5608. my $validation_type = $_[1]; # Type of data validation.
  5609. my $criteria_type = $_[2]; # Validation criteria.
  5610. my $formula_1 = $_[3]; # Value/Source/Minimum formula.
  5611. my $formula_2 = $_[4]; # Maximum formula.
  5612. my $input_title = $_[5]; # Title of input message.
  5613. my $input_message = $_[6]; # Text of input message.
  5614. my $error_title = $_[7]; # Title of error message.
  5615. my $error_message = $_[8]; # Text of input message.
  5616. my $error_type = $_[9]; # Error dialog type.
  5617. my $ignore_blank = $_[10]; # Ignore blank cells.
  5618. my $dropdown = $_[11]; # Display dropdown with list.
  5619. my $input_box = $_[12]; # Display input box.
  5620. my $error_box = $_[13]; # Display error box.
  5621. my $ime_mode = 0; # IME input mode for far east fonts.
  5622. my $str_lookup = 0; # See below.
  5623. # Set the string lookup flag for 'list' validations with a string array.
  5624. if ($validation_type == 3 && ref $formula_1 eq 'ARRAY') {
  5625. $str_lookup = 1;
  5626. }
  5627. # The dropdown flag is stored as a negated value.
  5628. my $no_dropdown = not $dropdown;
  5629. # Set the required flags.
  5630. $flags |= $validation_type;
  5631. $flags |= $error_type << 4;
  5632. $flags |= $str_lookup << 7;
  5633. $flags |= $ignore_blank << 8;
  5634. $flags |= $no_dropdown << 9;
  5635. $flags |= $ime_mode << 10;
  5636. $flags |= $input_box << 18;
  5637. $flags |= $error_box << 19;
  5638. $flags |= $criteria_type << 20;
  5639. # Pack the validation formulas.
  5640. $formula_1 = $self->_pack_dv_formula($formula_1);
  5641. $formula_2 = $self->_pack_dv_formula($formula_2);
  5642. # Pack the input and error dialog strings.
  5643. $input_title = $self->_pack_dv_string($input_title, 32 );
  5644. $error_title = $self->_pack_dv_string($error_title, 32 );
  5645. $input_message = $self->_pack_dv_string($input_message, 255);
  5646. $error_message = $self->_pack_dv_string($error_message, 255);
  5647. # Pack the DV cell data.
  5648. my $dv_count = scalar @$cells;
  5649. my $dv_data = pack 'v', $dv_count;
  5650. for my $range (@$cells) {
  5651. $dv_data .= pack 'vvvv', $range->[0],
  5652. $range->[2],
  5653. $range->[1],
  5654. $range->[3];
  5655. }
  5656. # Pack the record.
  5657. my $data = pack 'V', $flags;
  5658. $data .= $input_title;
  5659. $data .= $error_title;
  5660. $data .= $input_message;
  5661. $data .= $error_message;
  5662. $data .= $formula_1;
  5663. $data .= $formula_2;
  5664. $data .= $dv_data;
  5665. my $header = pack('vv', $record, length $data);
  5666. $self->_append($header, $data);
  5667. }
  5668. ###############################################################################
  5669. #
  5670. # _pack_dv_string()
  5671. #
  5672. # Pack the strings used in the input and error dialog captions and messages.
  5673. # Captions are limited to 32 characters. Messages are limited to 255 chars.
  5674. #
  5675. sub _pack_dv_string {
  5676. my $self = shift;
  5677. my $string = $_[0];
  5678. my $max_length = $_[1];
  5679. my $str_length = 0;
  5680. my $encoding = 0;
  5681. # The default empty string is "\0".
  5682. if (!defined $string || $string eq '') {
  5683. $string = "\0";
  5684. }
  5685. # Excel limits DV captions to 32 chars and messages to 255.
  5686. if (length $string > $max_length) {
  5687. $string = substr($string, 0, $max_length);
  5688. }
  5689. $str_length = length $string;
  5690. # Handle utf8 strings in perl 5.8.
  5691. if ($] >= 5.008) {
  5692. require Encode;
  5693. if (Encode::is_utf8($string)) {
  5694. $string = Encode::encode("UTF-16LE", $string);
  5695. $encoding = 1;
  5696. }
  5697. }
  5698. return pack('vC', $str_length, $encoding) . $string;
  5699. }
  5700. ###############################################################################
  5701. #
  5702. # _pack_dv_formula()
  5703. #
  5704. # Pack the formula used in the DV record. This is the same as an cell formula
  5705. # with some additional header information. Note, DV formulas in Excel use
  5706. # relative addressing (R1C1 and ptgXxxN) however we use the Formula.pm's
  5707. # default absolute addressing (A1 and ptgXxx).
  5708. #
  5709. sub _pack_dv_formula {
  5710. my $self = shift;
  5711. my $formula = $_[0];
  5712. my $encoding = 0;
  5713. my $length = 0;
  5714. my $unused = 0x0000;
  5715. my @tokens;
  5716. # Return a default structure for unused formulas.
  5717. if (!defined $formula || $formula eq '') {
  5718. return pack('vv', 0, $unused);
  5719. }
  5720. # Pack a list array ref as a null separated string.
  5721. if (ref $formula eq 'ARRAY') {
  5722. $formula = join "\0", @$formula;
  5723. $formula = qq("$formula");
  5724. }
  5725. # Strip the = sign at the beginning of the formula string
  5726. $formula =~ s(^=)();
  5727. # Parse the formula using the parser in Formula.pm
  5728. my $parser = $self->{_parser};
  5729. # In order to raise formula errors from the point of view of the calling
  5730. # program we use an eval block and re-raise the error from here.
  5731. #
  5732. eval { @tokens = $parser->parse_formula($formula) };
  5733. if ($@) {
  5734. $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
  5735. croak $@; # Re-raise the error
  5736. }
  5737. else {
  5738. # TODO test for non valid ptgs such as Sheet2!A1
  5739. }
  5740. # Force 2d ranges to be a reference class.
  5741. s/_range2d/_range2dR/ for @tokens;
  5742. s/_name/_nameR/ for @tokens;
  5743. # Parse the tokens into a formula string.
  5744. $formula = $parser->parse_tokens(@tokens);
  5745. return pack('vv', length $formula, $unused) . $formula;
  5746. }
  5747. 1;
  5748. __END__
  5749. =head1 NAME
  5750. Worksheet - A writer class for Excel Worksheets.
  5751. =head1 SYNOPSIS
  5752. See the documentation for Spreadsheet::WriteExcel
  5753. =head1 DESCRIPTION
  5754. This module is used in conjunction with Spreadsheet::WriteExcel.
  5755. =head1 AUTHOR
  5756. John McNamara jmcnamara@cpan.org
  5757. =head1 COPYRIGHT
  5758. © MM-MMX, John McNamara.
  5759. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.