| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662 |
- # DISCLAIMER OF WARRANTY
- # Because this software is licensed free of charge, there is no warranty for the software,
- # to the extent permitted by applicable law. Except when otherwise stated in writing
- # the copyright holders and/or other parties provide the software "as is" without
- # warranty of any kind, either expressed or implied, including, but not limited to,
- # the implied warranties of merchantability and fitness for a particular purpose.
- # The entire risk as to the quality and performance of the software is with you.
- # Should the software prove defective, you assume the cost of all necessary
- # servicing, repair, or correction.
- # In no event unless required by applicable law or agreed to in writing will any
- # copyright holder, or any other party who may modify and/or redistribute the software
- # as permitted by the above licence, be liable to you for damages, including any general,
- # special, incidental, or consequential damages arising out of the use or inability
- # to use the software (including but not limited to loss of data or data being rendered
- # inaccurate or losses sustained by you or third parties or a failure of the software
- # to operate with any other software), even if such holder or other party
- # has been advised of the possibility of such damages.
- # AUTHOR
- # John McNamara jmcnamara@cpan.org
- # COPYRIGHT
- # Copyright MM-MMX, John McNamara.
- # All Rights Reserved. This module is free software. It may be used,
- # redistributed and/or modified under the terms of
- # the Artistic License(full text of the Artistic License http://dev.perl.org/licenses/artistic.html).
- package Spreadsheet::WriteExcel::Worksheet;
- ###############################################################################
- #
- # Worksheet - A writer class for Excel Worksheets.
- #
- #
- # Used in conjunction with Spreadsheet::WriteExcel
- #
- # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
- #
- # Documentation after __END__
- #
- use Exporter;
- use strict;
- use Carp;
- use Spreadsheet::WriteExcel::BIFFwriter;
- use Spreadsheet::WriteExcel::Format;
- use Spreadsheet::WriteExcel::Formula;
- use vars qw($VERSION @ISA);
- @ISA = qw(Spreadsheet::WriteExcel::BIFFwriter);
- $VERSION = '2.37';
- ###############################################################################
- #
- # new()
- #
- # Constructor. Creates a new Worksheet object from a BIFFwriter object
- #
- sub new {
- my $class = shift;
- my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
- my $rowmax = 65536;
- my $colmax = 256;
- my $strmax = 0;
- $self->{_name} = $_[0];
- $self->{_index} = $_[1];
- $self->{_encoding} = $_[2];
- $self->{_activesheet} = $_[3];
- $self->{_firstsheet} = $_[4];
- $self->{_url_format} = $_[5];
- $self->{_parser} = $_[6];
- $self->{_tempdir} = $_[7];
- $self->{_str_total} = $_[8];
- $self->{_str_unique} = $_[9];
- $self->{_str_table} = $_[10];
- $self->{_1904} = $_[11];
- $self->{_compatibility} = $_[12];
- $self->{_palette} = $_[13];
- $self->{_sheet_type} = 0x0000;
- $self->{_ext_sheets} = [];
- $self->{_using_tmpfile} = 1;
- $self->{_filehandle} = "";
- $self->{_fileclosed} = 0;
- $self->{_offset} = 0;
- $self->{_xls_rowmax} = $rowmax;
- $self->{_xls_colmax} = $colmax;
- $self->{_xls_strmax} = $strmax;
- $self->{_dim_rowmin} = undef;
- $self->{_dim_rowmax} = undef;
- $self->{_dim_colmin} = undef;
- $self->{_dim_colmax} = undef;
- $self->{_colinfo} = [];
- $self->{_selection} = [0, 0];
- $self->{_panes} = [];
- $self->{_active_pane} = 3;
- $self->{_frozen} = 0;
- $self->{_frozen_no_split} = 1;
- $self->{_selected} = 0;
- $self->{_hidden} = 0;
- $self->{_active} = 0;
- $self->{_tab_color} = 0;
- $self->{_first_row} = 0;
- $self->{_first_col} = 0;
- $self->{_display_formulas} = 0;
- $self->{_display_headers} = 1;
- $self->{_display_zeros} = 1;
- $self->{_display_arabic} = 0;
- $self->{_paper_size} = 0x0;
- $self->{_orientation} = 0x1;
- $self->{_header} = '';
- $self->{_footer} = '';
- $self->{_header_encoding} = 0;
- $self->{_footer_encoding} = 0;
- $self->{_hcenter} = 0;
- $self->{_vcenter} = 0;
- $self->{_margin_header} = 0.50;
- $self->{_margin_footer} = 0.50;
- $self->{_margin_left} = 0.75;
- $self->{_margin_right} = 0.75;
- $self->{_margin_top} = 1.00;
- $self->{_margin_bottom} = 1.00;
- $self->{_title_rowmin} = undef;
- $self->{_title_rowmax} = undef;
- $self->{_title_colmin} = undef;
- $self->{_title_colmax} = undef;
- $self->{_print_rowmin} = undef;
- $self->{_print_rowmax} = undef;
- $self->{_print_colmin} = undef;
- $self->{_print_colmax} = undef;
- $self->{_print_gridlines} = 1;
- $self->{_screen_gridlines} = 1;
- $self->{_print_headers} = 0;
- $self->{_page_order} = 0;
- $self->{_black_white} = 0;
- $self->{_draft_quality} = 0;
- $self->{_print_comments} = 0;
- $self->{_page_start} = 1;
- $self->{_custom_start} = 0;
- $self->{_fit_page} = 0;
- $self->{_fit_width} = 0;
- $self->{_fit_height} = 0;
- $self->{_hbreaks} = [];
- $self->{_vbreaks} = [];
- $self->{_protect} = 0;
- $self->{_password} = undef;
- $self->{_col_sizes} = {};
- $self->{_row_sizes} = {};
- $self->{_col_formats} = {};
- $self->{_row_formats} = {};
- $self->{_zoom} = 100;
- $self->{_print_scale} = 100;
- $self->{_page_view} = 0;
- $self->{_leading_zeros} = 0;
- $self->{_outline_row_level} = 0;
- $self->{_outline_style} = 0;
- $self->{_outline_below} = 1;
- $self->{_outline_right} = 1;
- $self->{_outline_on} = 1;
- $self->{_write_match} = [];
- $self->{_object_ids} = [];
- $self->{_images} = {};
- $self->{_images_array} = [];
- $self->{_charts} = {};
- $self->{_charts_array} = [];
- $self->{_comments} = {};
- $self->{_comments_array} = [];
- $self->{_comments_author} = '';
- $self->{_comments_author_enc} = 0;
- $self->{_comments_visible} = 0;
- $self->{_filter_area} = [];
- $self->{_filter_count} = 0;
- $self->{_filter_on} = 0;
- $self->{_writing_url} = 0;
- $self->{_db_indices} = [];
- $self->{_validations} = [];
- bless $self, $class;
- $self->_initialize();
- return $self;
- }
- ###############################################################################
- #
- # _initialize()
- #
- # Open a tmp file to store the majority of the Worksheet data. If this fails,
- # for example due to write permissions, store the data in memory. This can be
- # slow for large files.
- #
- sub _initialize {
- my $self = shift;
- my $fh;
- my $tmp_dir;
- # The following code is complicated by Windows limitations. Porters can
- # choose a more direct method.
- # In the default case we use IO::File->new_tmpfile(). This may fail, in
- # particular with IIS on Windows, so we allow the user to specify a temp
- # directory via File::Temp.
- #
- if (defined $self->{_tempdir}) {
- # Delay loading File:Temp to reduce the module dependencies.
- eval { require File::Temp };
- die "The File::Temp module must be installed in order ".
- "to call set_tempdir().\n" if $@;
- # Trap but ignore File::Temp errors.
- eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
- # Store the failed tmp dir in case of errors.
- $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
- }
- else {
- $fh = IO::File->new_tmpfile();
- # Store the failed tmp dir in case of errors.
- $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
- }
- # Check if the temp file creation was successful. Else store data in memory.
- if ($fh) {
- # binmode file whether platform requires it or not.
- binmode($fh);
- # Store filehandle
- $self->{_filehandle} = $fh;
- }
- else {
- # Set flag to store data in memory if XX::tempfile() failed.
- $self->{_using_tmpfile} = 0;
- if ($self->{_index} == 0 && $^W) {
- my $dir = $self->{_tempdir} || File::Spec->tmpdir();
- warn "Unable to create temp files in $tmp_dir. Data will be ".
- "stored in memory. Refer to set_tempdir() in the ".
- "Spreadsheet::WriteExcel documentation.\n" ;
- }
- }
- }
- ###############################################################################
- #
- # _close()
- #
- # Add data to the beginning of the workbook (note the reverse order)
- # and to the end of the workbook.
- #
- sub _close {
- my $self = shift;
- ################################################
- # Prepend in reverse order!!
- #
- # Prepend the sheet dimensions
- $self->_store_dimensions();
- # Prepend the autofilter filters.
- $self->_store_autofilters;
- # Prepend the sheet autofilter info.
- $self->_store_autofilterinfo();
- # Prepend the sheet filtermode record.
- $self->_store_filtermode();
- # Prepend the COLINFO records if they exist
- if (@{$self->{_colinfo}}){
- my @colinfo = @{$self->{_colinfo}};
- while (@colinfo) {
- my $arrayref = pop @colinfo;
- $self->_store_colinfo(@$arrayref);
- }
- }
- # Prepend the DEFCOLWIDTH record
- $self->_store_defcol();
- # Prepend the sheet password
- $self->_store_password();
- # Prepend the sheet protection
- $self->_store_protect();
- $self->_store_obj_protect();
- # Prepend the page setup
- $self->_store_setup();
- # Prepend the bottom margin
- $self->_store_margin_bottom();
- # Prepend the top margin
- $self->_store_margin_top();
- # Prepend the right margin
- $self->_store_margin_right();
- # Prepend the left margin
- $self->_store_margin_left();
- # Prepend the page vertical centering
- $self->_store_vcenter();
- # Prepend the page horizontal centering
- $self->_store_hcenter();
- # Prepend the page footer
- $self->_store_footer();
- # Prepend the page header
- $self->_store_header();
- # Prepend the vertical page breaks
- $self->_store_vbreak();
- # Prepend the horizontal page breaks
- $self->_store_hbreak();
- # Prepend WSBOOL
- $self->_store_wsbool();
- # Prepend the default row height.
- $self->_store_defrow();
- # Prepend GUTS
- $self->_store_guts();
- # Prepend GRIDSET
- $self->_store_gridset();
- # Prepend PRINTGRIDLINES
- $self->_store_print_gridlines();
- # Prepend PRINTHEADERS
- $self->_store_print_headers();
- #
- # End of prepend. Read upwards from here.
- ################################################
- # Append
- $self->_store_table();
- $self->_store_images();
- $self->_store_charts();
- $self->_store_filters();
- $self->_store_comments();
- $self->_store_window2();
- $self->_store_page_view();
- $self->_store_zoom();
- $self->_store_panes(@{$self->{_panes}}) if @{$self->{_panes}};
- $self->_store_selection(@{$self->{_selection}});
- $self->_store_validation_count();
- $self->_store_validations();
- $self->_store_tab_color();
- $self->_store_eof();
- # Prepend the BOF and INDEX records
- $self->_store_index();
- $self->_store_bof(0x0010);
- }
- ###############################################################################
- #
- # _compatibility_mode()
- #
- # Set the compatibility mode.
- #
- # See the explanation in Workbook::compatibility_mode(). This private method
- # is mainly used for test purposes.
- #
- sub _compatibility_mode {
- my $self = shift;
- if (defined($_[0])) {
- $self->{_compatibility} = $_[0];
- }
- else {
- $self->{_compatibility} = 1;
- }
- }
- ###############################################################################
- #
- # get_name().
- #
- # Retrieve the worksheet name.
- #
- # Note, there is no set_name() method because names are used in formulas and
- # converted to internal indices. Allowing the user to change sheet names
- # after they have been set in add_worksheet() is asking for trouble.
- #
- sub get_name {
- my $self = shift;
- return $self->{_name};
- }
- ###############################################################################
- #
- # get_data().
- #
- # Retrieves data from memory in one chunk, or from disk in $buffer
- # sized chunks.
- #
- sub get_data {
- my $self = shift;
- my $buffer = 4096;
- my $tmp;
- # Return data stored in memory
- if (defined $self->{_data}) {
- $tmp = $self->{_data};
- $self->{_data} = undef;
- my $fh = $self->{_filehandle};
- seek($fh, 0, 0) if $self->{_using_tmpfile};
- return $tmp;
- }
- # Return data stored on disk
- if ($self->{_using_tmpfile}) {
- return $tmp if read($self->{_filehandle}, $tmp, $buffer);
- }
- # No data to return
- return undef;
- }
- ###############################################################################
- #
- # select()
- #
- # Set this worksheet as a selected worksheet, i.e. the worksheet has its tab
- # highlighted.
- #
- sub select {
- my $self = shift;
- $self->{_hidden} = 0; # Selected worksheet can't be hidden.
- $self->{_selected} = 1;
- }
- ###############################################################################
- #
- # activate()
- #
- # Set this worksheet as the active worksheet, i.e. the worksheet that is
- # displayed when the workbook is opened. Also set it as selected.
- #
- sub activate {
- my $self = shift;
- $self->{_hidden} = 0; # Active worksheet can't be hidden.
- $self->{_selected} = 1;
- ${$self->{_activesheet}} = $self->{_index};
- }
- ###############################################################################
- #
- # hide()
- #
- # Hide this worksheet.
- #
- sub hide {
- my $self = shift;
- $self->{_hidden} = 1;
- # A hidden worksheet shouldn't be active or selected.
- $self->{_selected} = 0;
- ${$self->{_activesheet}} = 0;
- ${$self->{_firstsheet}} = 0;
- }
- ###############################################################################
- #
- # set_first_sheet()
- #
- # Set this worksheet as the first visible sheet. This is necessary
- # when there are a large number of worksheets and the activated
- # worksheet is not visible on the screen.
- #
- sub set_first_sheet {
- my $self = shift;
- $self->{_hidden} = 0; # Active worksheet can't be hidden.
- ${$self->{_firstsheet}} = $self->{_index};
- }
- ###############################################################################
- #
- # protect($password)
- #
- # Set the worksheet protection flag to prevent accidental modification and to
- # hide formulas if the locked and hidden format properties have been set.
- #
- sub protect {
- my $self = shift;
- $self->{_protect} = 1;
- $self->{_password} = $self->_encode_password($_[0]) if defined $_[0];
- }
- ###############################################################################
- #
- # set_column($firstcol, $lastcol, $width, $format, $hidden, $level)
- #
- # Set the width of a single column or a range of columns.
- # See also: _store_colinfo
- #
- sub set_column {
- my $self = shift;
- my @data = @_;
- my $cell = $data[0];
- # Check for a cell reference in A1 notation and substitute row and column
- if ($cell =~ /^\D/) {
- @data = $self->_substitute_cellref(@_);
- # Returned values $row1 and $row2 aren't required here. Remove them.
- shift @data; # $row1
- splice @data, 1, 1; # $row2
- }
- return if @data < 3; # Ensure at least $firstcol, $lastcol and $width
- return if not defined $data[0]; # Columns must be defined.
- return if not defined $data[1];
- # Assume second column is the same as first if 0. Avoids KB918419 bug.
- $data[1] = $data[0] if $data[1] == 0;
- # Ensure 2nd col is larger than first. Also for KB918419 bug.
- ($data[0], $data[1]) = ($data[1], $data[0]) if $data[0] > $data[1];
- # Limit columns to Excel max of 255.
- $data[0] = 255 if $data[0] > 255;
- $data[1] = 255 if $data[1] > 255;
- push @{$self->{_colinfo}}, [ @data ];
- # Store the col sizes for use when calculating image vertices taking
- # hidden columns into account. Also store the column formats.
- #
- my $width = $data[4] ? 0 : $data[2]; # Set width to zero if col is hidden
- $width ||= 0; # Ensure width isn't undef.
- my $format = $data[3];
- my ($firstcol, $lastcol) = @data;
- foreach my $col ($firstcol .. $lastcol) {
- $self->{_col_sizes}->{$col} = $width;
- $self->{_col_formats}->{$col} = $format if defined $format;
- }
- }
- ###############################################################################
- #
- # set_selection()
- #
- # Set which cell or cells are selected in a worksheet: see also the
- # sub _store_selection
- #
- sub set_selection {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- $self->{_selection} = [ @_ ];
- }
- ###############################################################################
- #
- # freeze_panes()
- #
- # Set panes and mark them as frozen. See also _store_panes().
- #
- sub freeze_panes {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Extra flag indicated a split and freeze.
- $self->{_frozen_no_split} = 0 if $_[4];
- $self->{_frozen} = 1;
- $self->{_panes} = [ @_ ];
- }
- ###############################################################################
- #
- # split_panes()
- #
- # Set panes and mark them as split. See also _store_panes().
- #
- sub split_panes {
- my $self = shift;
- $self->{_frozen} = 0;
- $self->{_frozen_no_split} = 0;
- $self->{_panes} = [ @_ ];
- }
- # Older method name for backwards compatibility.
- *thaw_panes = *split_panes;
- ###############################################################################
- #
- # set_portrait()
- #
- # Set the page orientation as portrait.
- #
- sub set_portrait {
- my $self = shift;
- $self->{_orientation} = 1;
- }
- ###############################################################################
- #
- # set_landscape()
- #
- # Set the page orientation as landscape.
- #
- sub set_landscape {
- my $self = shift;
- $self->{_orientation} = 0;
- }
- ###############################################################################
- #
- # set_page_view()
- #
- # Set the page view mode for Mac Excel.
- #
- sub set_page_view {
- my $self = shift;
- $self->{_page_view} = defined $_[0] ? $_[0] : 1;
- }
- ###############################################################################
- #
- # set_tab_color()
- #
- # Set the colour of the worksheet colour.
- #
- sub set_tab_color {
- my $self = shift;
- my $color = &Spreadsheet::WriteExcel::Format::_get_color($_[0]);
- $color = 0 if $color == 0x7FFF; # Default color.
- $self->{_tab_color} = $color;
- }
- ###############################################################################
- #
- # set_paper()
- #
- # Set the paper type. Ex. 1 = US Letter, 9 = A4
- #
- sub set_paper {
- my $self = shift;
- $self->{_paper_size} = $_[0] || 0;
- }
- ###############################################################################
- #
- # set_header()
- #
- # Set the page header caption and optional margin.
- #
- sub set_header {
- my $self = shift;
- my $string = $_[0] || '';
- my $margin = $_[1] || 0.50;
- my $encoding = $_[2] || 0;
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16BE", $string);
- $encoding = 1;
- }
- }
- my $limit = $encoding ? 255 *2 : 255;
- if (length $string >= $limit) {
- carp 'Header string must be less than 255 characters';
- return;
- }
- $self->{_header} = $string;
- $self->{_margin_header} = $margin;
- $self->{_header_encoding} = $encoding;
- }
- ###############################################################################
- #
- # set_footer()
- #
- # Set the page footer caption and optional margin.
- #
- sub set_footer {
- my $self = shift;
- my $string = $_[0] || '';
- my $margin = $_[1] || 0.50;
- my $encoding = $_[2] || 0;
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16BE", $string);
- $encoding = 1;
- }
- }
- my $limit = $encoding ? 255 *2 : 255;
- if (length $string >= $limit) {
- carp 'Footer string must be less than 255 characters';
- return;
- }
- $self->{_footer} = $string;
- $self->{_margin_footer} = $margin;
- $self->{_footer_encoding} = $encoding;
- }
- ###############################################################################
- #
- # center_horizontally()
- #
- # Center the page horizontally.
- #
- sub center_horizontally {
- my $self = shift;
- if (defined $_[0]) {
- $self->{_hcenter} = $_[0];
- }
- else {
- $self->{_hcenter} = 1;
- }
- }
- ###############################################################################
- #
- # center_vertically()
- #
- # Center the page horizontally.
- #
- sub center_vertically {
- my $self = shift;
- if (defined $_[0]) {
- $self->{_vcenter} = $_[0];
- }
- else {
- $self->{_vcenter} = 1;
- }
- }
- ###############################################################################
- #
- # set_margins()
- #
- # Set all the page margins to the same value in inches.
- #
- sub set_margins {
- my $self = shift;
- $self->set_margin_left($_[0]);
- $self->set_margin_right($_[0]);
- $self->set_margin_top($_[0]);
- $self->set_margin_bottom($_[0]);
- }
- ###############################################################################
- #
- # set_margins_LR()
- #
- # Set the left and right margins to the same value in inches.
- #
- sub set_margins_LR {
- my $self = shift;
- $self->set_margin_left($_[0]);
- $self->set_margin_right($_[0]);
- }
- ###############################################################################
- #
- # set_margins_TB()
- #
- # Set the top and bottom margins to the same value in inches.
- #
- sub set_margins_TB {
- my $self = shift;
- $self->set_margin_top($_[0]);
- $self->set_margin_bottom($_[0]);
- }
- ###############################################################################
- #
- # set_margin_left()
- #
- # Set the left margin in inches.
- #
- sub set_margin_left {
- my $self = shift;
- $self->{_margin_left} = defined $_[0] ? $_[0] : 0.75;
- }
- ###############################################################################
- #
- # set_margin_right()
- #
- # Set the right margin in inches.
- #
- sub set_margin_right {
- my $self = shift;
- $self->{_margin_right} = defined $_[0] ? $_[0] : 0.75;
- }
- ###############################################################################
- #
- # set_margin_top()
- #
- # Set the top margin in inches.
- #
- sub set_margin_top {
- my $self = shift;
- $self->{_margin_top} = defined $_[0] ? $_[0] : 1.00;
- }
- ###############################################################################
- #
- # set_margin_bottom()
- #
- # Set the bottom margin in inches.
- #
- sub set_margin_bottom {
- my $self = shift;
- $self->{_margin_bottom} = defined $_[0] ? $_[0] : 1.00;
- }
- ###############################################################################
- #
- # repeat_rows($first_row, $last_row)
- #
- # Set the rows to repeat at the top of each printed page. See also the
- # _store_name_xxxx() methods in Workbook.pm.
- #
- sub repeat_rows {
- my $self = shift;
- $self->{_title_rowmin} = $_[0];
- $self->{_title_rowmax} = $_[1] || $_[0]; # Second row is optional
- }
- ###############################################################################
- #
- # repeat_columns($first_col, $last_col)
- #
- # Set the columns to repeat at the left hand side of each printed page.
- # See also the _store_names() methods in Workbook.pm.
- #
- sub repeat_columns {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- # Returned values $row1 and $row2 aren't required here. Remove them.
- shift @_; # $row1
- splice @_, 1, 1; # $row2
- }
- $self->{_title_colmin} = $_[0];
- $self->{_title_colmax} = $_[1] || $_[0]; # Second col is optional
- }
- ###############################################################################
- #
- # print_area($first_row, $first_col, $last_row, $last_col)
- #
- # Set the area of each worksheet that will be printed. See also the
- # _store_names() methods in Workbook.pm.
- #
- sub print_area {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- return if @_ != 4; # Require 4 parameters
- $self->{_print_rowmin} = $_[0];
- $self->{_print_colmin} = $_[1];
- $self->{_print_rowmax} = $_[2];
- $self->{_print_colmax} = $_[3];
- }
- ###############################################################################
- #
- # autofilter($first_row, $first_col, $last_row, $last_col)
- #
- # Set the autofilter area in the worksheet.
- #
- sub autofilter {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- return if @_ != 4; # Require 4 parameters
- my ($row1, $col1, $row2, $col2) = @_;
- # Reverse max and min values if necessary.
- ($row1, $row2) = ($row2, $row1) if $row2 < $row1;
- ($col1, $col2) = ($col2, $col1) if $col2 < $col1;
- # Store the Autofilter information
- $self->{_filter_area} = [$row1, $row2, $col1, $col2];
- $self->{_filter_count} = 1+ $col2 -$col1;
- }
- ###############################################################################
- #
- # filter_column($column, $criteria, ...)
- #
- # Set the column filter criteria.
- #
- sub filter_column {
- my $self = shift;
- my $col = $_[0];
- my $expression = $_[1];
- croak "Must call autofilter() before filter_column()"
- unless $self->{_filter_count};
- croak "Incorrect number of arguments to filter_column()" unless @_ == 2;
- # Check for a column reference in A1 notation and substitute.
- if ($col =~ /^\D/) {
- # Convert col ref to a cell ref and then to a col number.
- (undef, $col) = $self->_substitute_cellref($col . '1');
- }
- my (undef, undef, $col_first, $col_last) = @{$self->{_filter_area}};
- # Reject column if it is outside filter range.
- if ($col < $col_first or $col > $col_last) {
- croak "Column '$col' outside autofilter() column range " .
- "($col_first .. $col_last)";
- }
- my @tokens = $self->_extract_filter_tokens($expression);
- croak "Incorrect number of tokens in expression '$expression'"
- unless (@tokens == 3 or @tokens == 7);
- @tokens = $self->_parse_filter_expression($expression, @tokens);
- $self->{_filter_cols}->{$col} = [@tokens];
- $self->{_filter_on} = 1;
- }
- ###############################################################################
- #
- # _extract_filter_tokens($expression)
- #
- # Extract the tokens from the filter expression. The tokens are mainly non-
- # whitespace groups. The only tricky part is to extract string tokens that
- # contain whitespace and/or quoted double quotes (Excel's escaped quotes).
- #
- # Examples: 'x < 2000'
- # 'x > 2000 and x < 5000'
- # 'x = "foo"'
- # 'x = "foo bar"'
- # 'x = "foo "" bar"'
- #
- sub _extract_filter_tokens {
- my $self = shift;
- my $expression = $_[0];
- return unless $expression;
- my @tokens = ($expression =~ /"(?:[^"]|"")*"|\S+/g); #"
- # Remove leading and trailing quotes and unescape other quotes
- for (@tokens) {
- s/^"//; #"
- s/"$//; #"
- s/""/"/g; #"
- }
- return @tokens;
- }
- ###############################################################################
- #
- # _parse_filter_expression(@token)
- #
- # Converts the tokens of a possibly conditional expression into 1 or 2
- # sub expressions for further parsing.
- #
- # Examples:
- # ('x', '==', 2000) -> exp1
- # ('x', '>', 2000, 'and', 'x', '<', 5000) -> exp1 and exp2
- #
- sub _parse_filter_expression {
- my $self = shift;
- my $expression = shift;
- my @tokens = @_;
- # The number of tokens will be either 3 (for 1 expression)
- # or 7 (for 2 expressions).
- #
- if (@tokens == 7) {
- my $conditional = $tokens[3];
- if ($conditional =~ /^(and|&&)$/) {
- $conditional = 0;
- }
- elsif ($conditional =~ /^(or|\|\|)$/) {
- $conditional = 1;
- }
- else {
- croak "Token '$conditional' is not a valid conditional " .
- "in filter expression '$expression'";
- }
- my @expression_1 = $self->_parse_filter_tokens($expression,
- @tokens[0, 1, 2]);
- my @expression_2 = $self->_parse_filter_tokens($expression,
- @tokens[4, 5, 6]);
- return (@expression_1, $conditional, @expression_2);
- }
- else {
- return $self->_parse_filter_tokens($expression, @tokens);
- }
- }
- ###############################################################################
- #
- # _parse_filter_tokens(@token)
- #
- # Parse the 3 tokens of a filter expression and return the operator and token.
- #
- sub _parse_filter_tokens {
- my $self = shift;
- my $expression = shift;
- my @tokens = @_;
- my %operators = (
- '==' => 2,
- '=' => 2,
- '=~' => 2,
- 'eq' => 2,
- '!=' => 5,
- '!~' => 5,
- 'ne' => 5,
- '<>' => 5,
- '<' => 1,
- '<=' => 3,
- '>' => 4,
- '>=' => 6,
- );
- my $operator = $operators{$tokens[1]};
- my $token = $tokens[2];
- # Special handling of "Top" filter expressions.
- if ($tokens[0] =~ /^top|bottom$/i) {
- my $value = $tokens[1];
- if ($value =~ /\D/ or
- $value < 1 or
- $value > 500)
- {
- croak "The value '$value' in expression '$expression' " .
- "must be in the range 1 to 500";
- }
- $token = lc $token;
- if ($token ne 'items' and $token ne '%') {
- croak "The type '$token' in expression '$expression' " .
- "must be either 'items' or '%'";
- }
- if ($tokens[0] =~ /^top$/i) {
- $operator = 30;
- }
- else {
- $operator = 32;
- }
- if ($tokens[2] eq '%') {
- $operator++;
- }
- $token = $value;
- }
- if (not $operator and $tokens[0]) {
- croak "Token '$tokens[1]' is not a valid operator " .
- "in filter expression '$expression'";
- }
- # Special handling for Blanks/NonBlanks.
- if ($token =~ /^blanks|nonblanks$/i) {
- # Only allow Equals or NotEqual in this context.
- if ($operator != 2 and $operator != 5) {
- croak "The operator '$tokens[1]' in expression '$expression' " .
- "is not valid in relation to Blanks/NonBlanks'";
- }
- $token = lc $token;
- # The operator should always be 2 (=) to flag a "simple" equality in
- # the binary record. Therefore we convert <> to =.
- if ($token eq 'blanks') {
- if ($operator == 5) {
- $operator = 2;
- $token = 'nonblanks';
- }
- }
- else {
- if ($operator == 5) {
- $operator = 2;
- $token = 'blanks';
- }
- }
- }
- # if the string token contains an Excel match character then change the
- # operator type to indicate a non "simple" equality.
- if ($operator == 2 and $token =~ /[*?]/) {
- $operator = 22;
- }
- return ($operator, $token);
- }
- ###############################################################################
- #
- # hide_gridlines()
- #
- # Set the option to hide gridlines on the screen and the printed page.
- # There are two ways of doing this in the Excel BIFF format: The first is by
- # setting the DspGrid field of the WINDOW2 record, this turns off the screen
- # and subsequently the print gridline. The second method is to via the
- # PRINTGRIDLINES and GRIDSET records, this turns off the printed gridlines
- # only. The first method is probably sufficient for most cases. The second
- # method is supported for backwards compatibility. Porters take note.
- #
- sub hide_gridlines {
- my $self = shift;
- my $option = $_[0];
- $option = 1 unless defined $option; # Default to hiding printed gridlines
- if ($option == 0) {
- $self->{_print_gridlines} = 1; # 1 = display, 0 = hide
- $self->{_screen_gridlines} = 1;
- }
- elsif ($option == 1) {
- $self->{_print_gridlines} = 0;
- $self->{_screen_gridlines} = 1;
- }
- else {
- $self->{_print_gridlines} = 0;
- $self->{_screen_gridlines} = 0;
- }
- }
- ###############################################################################
- #
- # print_row_col_headers()
- #
- # Set the option to print the row and column headers on the printed page.
- # See also the _store_print_headers() method below.
- #
- sub print_row_col_headers {
- my $self = shift;
- if (defined $_[0]) {
- $self->{_print_headers} = $_[0];
- }
- else {
- $self->{_print_headers} = 1;
- }
- }
- ###############################################################################
- #
- # fit_to_pages($width, $height)
- #
- # Store the vertical and horizontal number of pages that will define the
- # maximum area printed. See also _store_setup() and _store_wsbool() below.
- #
- sub fit_to_pages {
- my $self = shift;
- $self->{_fit_page} = 1;
- $self->{_fit_width} = $_[0] || 0;
- $self->{_fit_height} = $_[1] || 0;
- }
- ###############################################################################
- #
- # set_h_pagebreaks(@breaks)
- #
- # Store the horizontal page breaks on a worksheet.
- #
- sub set_h_pagebreaks {
- my $self = shift;
- push @{$self->{_hbreaks}}, @_;
- }
- ###############################################################################
- #
- # set_v_pagebreaks(@breaks)
- #
- # Store the vertical page breaks on a worksheet.
- #
- sub set_v_pagebreaks {
- my $self = shift;
- push @{$self->{_vbreaks}}, @_;
- }
- ###############################################################################
- #
- # set_zoom($scale)
- #
- # Set the worksheet zoom factor.
- #
- sub set_zoom {
- my $self = shift;
- my $scale = $_[0] || 100;
- # Confine the scale to Excel's range
- if ($scale < 10 or $scale > 400) {
- carp "Zoom factor $scale outside range: 10 <= zoom <= 400";
- $scale = 100;
- }
- $self->{_zoom} = int $scale;
- }
- ###############################################################################
- #
- # set_print_scale($scale)
- #
- # Set the scale factor for the printed page.
- #
- sub set_print_scale {
- my $self = shift;
- my $scale = $_[0] || 100;
- # Confine the scale to Excel's range
- if ($scale < 10 or $scale > 400) {
- carp "Print scale $scale outside range: 10 <= zoom <= 400";
- $scale = 100;
- }
- # Turn off "fit to page" option
- $self->{_fit_page} = 0;
- $self->{_print_scale} = int $scale;
- }
- ###############################################################################
- #
- # keep_leading_zeros()
- #
- # Causes the write() method to treat integers with a leading zero as a string.
- # This ensures that any leading zeros such, as in zip codes, are maintained.
- #
- sub keep_leading_zeros {
- my $self = shift;
- if (defined $_[0]) {
- $self->{_leading_zeros} = $_[0];
- }
- else {
- $self->{_leading_zeros} = 1;
- }
- }
- ###############################################################################
- #
- # show_comments()
- #
- # Make any comments in the worksheet visible.
- #
- sub show_comments {
- my $self = shift;
- $self->{_comments_visible} = defined $_[0] ? $_[0] : 1;
- }
- ###############################################################################
- #
- # set_comments_author()
- #
- # Set the default author of the cell comments.
- #
- sub set_comments_author {
- my $self = shift;
- $self->{_comments_author} = defined $_[0] ? $_[0] : '';
- $self->{_comments_author_enc} = $_[1] ? 1 : 0;
- }
- ###############################################################################
- #
- # right_to_left()
- #
- # Display the worksheet right to left for some eastern versions of Excel.
- #
- sub right_to_left {
- my $self = shift;
- $self->{_display_arabic} = defined $_[0] ? $_[0] : 1;
- }
- ###############################################################################
- #
- # hide_zero()
- #
- # Hide cell zero values.
- #
- sub hide_zero {
- my $self = shift;
- $self->{_display_zeros} = defined $_[0] ? not $_[0] : 0;
- }
- ###############################################################################
- #
- # print_across()
- #
- # Set the order in which pages are printed.
- #
- sub print_across {
- my $self = shift;
- $self->{_page_order} = defined $_[0] ? $_[0] : 1;
- }
- ###############################################################################
- #
- # set_start_page()
- #
- # Set the start page number.
- #
- sub set_start_page {
- my $self = shift;
- return unless defined $_[0];
- $self->{_page_start} = $_[0];
- $self->{_custom_start} = 1;
- }
- ###############################################################################
- #
- # set_first_row_column()
- #
- # Set the topmost and leftmost visible row and column.
- # TODO: Document this when tested fully for interaction with panes.
- #
- sub set_first_row_column {
- my $self = shift;
- my $row = $_[0] || 0;
- my $col = $_[1] || 0;
- $row = 65535 if $row > 65535;
- $col = 255 if $col > 255;
- $self->{_first_row} = $row;
- $self->{_first_col} = $col;
- }
- ###############################################################################
- #
- # add_write_handler($re, $code_ref)
- #
- # Allow the user to add their own matches and handlers to the write() method.
- #
- sub add_write_handler {
- my $self = shift;
- return unless @_ == 2;
- return unless ref $_[1] eq 'CODE';
- push @{$self->{_write_match}}, [ @_ ];
- }
- ###############################################################################
- #
- # write($row, $col, $token, $format)
- #
- # Parse $token and call appropriate write method. $row and $column are zero
- # indexed. $format is optional.
- #
- # The write_url() methods have a flag to prevent recursion when writing a
- # string that looks like a url.
- #
- # Returns: return value of called subroutine
- #
- sub write {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- my $token = $_[2];
- # Handle undefs as blanks
- $token = '' unless defined $token;
- # First try user defined matches.
- for my $aref (@{$self->{_write_match}}) {
- my $re = $aref->[0];
- my $sub = $aref->[1];
- if ($token =~ /$re/) {
- my $match = &$sub($self, @_);
- return $match if defined $match;
- }
- }
- # Match an array ref.
- if (ref $token eq "ARRAY") {
- return $self->write_row(@_);
- }
- # Match integer with leading zero(s)
- elsif ($self->{_leading_zeros} and $token =~ /^0\d+$/) {
- return $self->write_string(@_);
- }
- # Match number
- elsif ($token =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
- return $self->write_number(@_);
- }
- # Match http, https or ftp URL
- elsif ($token =~ m|^[fh]tt?ps?://| and not $self->{_writing_url}) {
- return $self->write_url(@_);
- }
- # Match mailto:
- elsif ($token =~ m/^mailto:/ and not $self->{_writing_url}) {
- return $self->write_url(@_);
- }
- # Match internal or external sheet link
- elsif ($token =~ m[^(?:in|ex)ternal:] and not $self->{_writing_url}) {
- return $self->write_url(@_);
- }
- # Match formula
- elsif ($token =~ /^=/) {
- return $self->write_formula(@_);
- }
- # Match blank
- elsif ($token eq '') {
- splice @_, 2, 1; # remove the empty string from the parameter list
- return $self->write_blank(@_);
- }
- else {
- return $self->write_string(@_);
- }
- }
- ###############################################################################
- #
- # write_row($row, $col, $array_ref, $format)
- #
- # Write a row of data starting from ($row, $col). Call write_col() if any of
- # the elements of the array ref are in turn array refs. This allows the writing
- # of 1D or 2D arrays of data in one go.
- #
- # Returns: the first encountered error value or zero for no errors
- #
- sub write_row {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Catch non array refs passed by user.
- if (ref $_[2] ne 'ARRAY') {
- croak "Not an array ref in call to write_row()$!";
- }
- my $row = shift;
- my $col = shift;
- my $tokens = shift;
- my @options = @_;
- my $error = 0;
- my $ret;
- foreach my $token (@$tokens) {
- # Check for nested arrays
- if (ref $token eq "ARRAY") {
- $ret = $self->write_col($row, $col, $token, @options);
- } else {
- $ret = $self->write ($row, $col, $token, @options);
- }
- # Return only the first error encountered, if any.
- $error ||= $ret;
- $col++;
- }
- return $error;
- }
- ###############################################################################
- #
- # write_col($row, $col, $array_ref, $format)
- #
- # Write a column of data starting from ($row, $col). Call write_row() if any of
- # the elements of the array ref are in turn array refs. This allows the writing
- # of 1D or 2D arrays of data in one go.
- #
- # Returns: the first encountered error value or zero for no errors
- #
- sub write_col {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Catch non array refs passed by user.
- if (ref $_[2] ne 'ARRAY') {
- croak "Not an array ref in call to write_row()$!";
- }
- my $row = shift;
- my $col = shift;
- my $tokens = shift;
- my @options = @_;
- my $error = 0;
- my $ret;
- foreach my $token (@$tokens) {
- # write() will deal with any nested arrays
- $ret = $self->write($row, $col, $token, @options);
- # Return only the first error encountered, if any.
- $error ||= $ret;
- $row++;
- }
- return $error;
- }
- ###############################################################################
- #
- # write_comment($row, $col, $comment)
- #
- # Write a comment to the specified row and column (zero indexed).
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- #
- sub write_comment {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $row = $_[0];
- my $col = $_[1];
- # Check for pairs of optional arguments, i.e. an odd number of args.
- croak "Uneven number of additional arguments" unless @_ % 2;
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- # We have to avoid duplicate comments in cells or else Excel will complain.
- $self->{_comments}->{$row}->{$col} = [ $self->_comment_params(@_) ];
- }
- ###############################################################################
- #
- # _XF()
- #
- # Returns an index to the XF record in the workbook.
- #
- # Note: this is a function, not a method.
- #
- sub _XF {
- my $self = $_[0];
- my $row = $_[1];
- my $col = $_[2];
- my $format = $_[3];
- my $error = "Error: refer to merge_range() in the documentation. " .
- "Can't use previously merged format in non-merged cell";
- if (ref($format)) {
- # Temp code to prevent merged formats in non-merged cells.
- croak $error if $format->{_used_merge} == 1;
- $format->{_used_merge} = -1;
- return $format->get_xf_index();
- }
- elsif (exists $self->{_row_formats}->{$row}) {
- # Temp code to prevent merged formats in non-merged cells.
- croak $error if $self->{_row_formats}->{$row}->{_used_merge} == 1;
- $self->{_row_formats}->{$row}->{_used_merge} = -1;
- return $self->{_row_formats}->{$row}->get_xf_index();
- }
- elsif (exists $self->{_col_formats}->{$col}) {
- # Temp code to prevent merged formats in non-merged cells.
- croak $error if $self->{_col_formats}->{$col}->{_used_merge} == 1;
- $self->{_col_formats}->{$col}->{_used_merge} = -1;
- return $self->{_col_formats}->{$col}->get_xf_index();
- }
- else {
- return 0x0F;
- }
- }
- ###############################################################################
- ###############################################################################
- #
- # Internal methods
- #
- ###############################################################################
- #
- # _append(), overridden.
- #
- # Store Worksheet data in memory using the base class _append() or to a
- # temporary file, the default.
- #
- sub _append {
- my $self = shift;
- my $data = '';
- if ($self->{_using_tmpfile}) {
- $data = join('', @_);
- # Add CONTINUE records if necessary
- $data = $self->_add_continue($data) if length($data) > $self->{_limit};
- # Protect print() from -l on the command line.
- local $\ = undef;
- print {$self->{_filehandle}} $data;
- $self->{_datasize} += length($data);
- }
- else {
- $data = $self->SUPER::_append(@_);
- }
- return $data;
- }
- ###############################################################################
- #
- # _substitute_cellref()
- #
- # Substitute an Excel cell reference in A1 notation for zero based row and
- # column values in an argument list.
- #
- # Ex: ("A4", "Hello") is converted to (3, 0, "Hello").
- #
- sub _substitute_cellref {
- my $self = shift;
- my $cell = uc(shift);
- # Convert a column range: 'A:A' or 'B:G'.
- # A range such as A:A is equivalent to A1:65536, so add rows as required
- if ($cell =~ /\$?([A-I]?[A-Z]):\$?([A-I]?[A-Z])/) {
- my ($row1, $col1) = $self->_cell_to_rowcol($1 .'1');
- my ($row2, $col2) = $self->_cell_to_rowcol($2 .'65536');
- return $row1, $col1, $row2, $col2, @_;
- }
- # Convert a cell range: 'A1:B7'
- if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+):\$?([A-I]?[A-Z]\$?\d+)/) {
- my ($row1, $col1) = $self->_cell_to_rowcol($1);
- my ($row2, $col2) = $self->_cell_to_rowcol($2);
- return $row1, $col1, $row2, $col2, @_;
- }
- # Convert a cell reference: 'A1' or 'AD2000'
- if ($cell =~ /\$?([A-I]?[A-Z]\$?\d+)/) {
- my ($row1, $col1) = $self->_cell_to_rowcol($1);
- return $row1, $col1, @_;
- }
- croak("Unknown cell reference $cell");
- }
- ###############################################################################
- #
- # _cell_to_rowcol($cell_ref)
- #
- # Convert an Excel cell reference in A1 notation to a zero based row and column
- # reference; converts C1 to (0, 2).
- #
- # Returns: row, column
- #
- sub _cell_to_rowcol {
- my $self = shift;
- my $cell = shift;
- $cell =~ /\$?([A-I]?[A-Z])\$?(\d+)/;
- my $col = $1;
- my $row = $2;
- # Convert base26 column string to number
- # All your Base are belong to us.
- my @chars = split //, $col;
- my $expn = 0;
- $col = 0;
- while (@chars) {
- my $char = pop(@chars); # LS char first
- $col += (ord($char) -ord('A') +1) * (26**$expn);
- $expn++;
- }
- # Convert 1-index to zero-index
- $row--;
- $col--;
- return $row, $col;
- }
- ###############################################################################
- #
- # _sort_pagebreaks()
- #
- #
- # This is an internal method that is used to filter elements of the array of
- # pagebreaks used in the _store_hbreak() and _store_vbreak() methods. It:
- # 1. Removes duplicate entries from the list.
- # 2. Sorts the list.
- # 3. Removes 0 from the list if present.
- #
- sub _sort_pagebreaks {
- my $self= shift;
- my %hash;
- my @array;
- @hash{@_} = undef; # Hash slice to remove duplicates
- @array = sort {$a <=> $b} keys %hash; # Numerical sort
- shift @array if $array[0] == 0; # Remove zero
- # 1000 vertical pagebreaks appears to be an internal Excel 5 limit.
- # It is slightly higher in Excel 97/200, approx. 1026
- splice(@array, 1000) if (@array > 1000);
- return @array
- }
- ###############################################################################
- #
- # _encode_password($password)
- #
- # Based on the algorithm provided by Daniel Rentz of OpenOffice.
- #
- #
- sub _encode_password {
- use integer;
- my $self = shift;
- my $plaintext = $_[0];
- my $password;
- my $count;
- my @chars;
- my $i = 0;
- $count = @chars = split //, $plaintext;
- foreach my $char (@chars) {
- my $low_15;
- my $high_15;
- $char = ord($char) << ++$i;
- $low_15 = $char & 0x7fff;
- $high_15 = $char & 0x7fff << 15;
- $high_15 = $high_15 >> 15;
- $char = $low_15 | $high_15;
- }
- $password = 0x0000;
- $password ^= $_ for @chars;
- $password ^= $count;
- $password ^= 0xCE4B;
- return $password;
- }
- ###############################################################################
- #
- # outline_settings($visible, $symbols_below, $symbols_right, $auto_style)
- #
- # This method sets the properties for outlining and grouping. The defaults
- # correspond to Excel's defaults.
- #
- sub outline_settings {
- my $self = shift;
- $self->{_outline_on} = defined $_[0] ? $_[0] : 1;
- $self->{_outline_below} = defined $_[1] ? $_[1] : 1;
- $self->{_outline_right} = defined $_[2] ? $_[2] : 1;
- $self->{_outline_style} = $_[3] || 0;
- # Ensure this is a boolean vale for Window2
- $self->{_outline_on} = 1 if $self->{_outline_on};
- }
- ###############################################################################
- ###############################################################################
- #
- # BIFF RECORDS
- #
- ###############################################################################
- #
- # write_number($row, $col, $num, $format)
- #
- # Write a double to the specified row and column (zero indexed).
- # An integer can be written as a double. Excel will display an
- # integer. $format is optional.
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- #
- sub write_number {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $record = 0x0203; # Record identifier
- my $length = 0x000E; # Number of bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $num = $_[2];
- my $xf = _XF($self, $row, $col, $_[3]); # The cell format
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- my $header = pack("vv", $record, $length);
- my $data = pack("vvv", $row, $col, $xf);
- my $xl_double = pack("d", $num);
- if ($self->{_byte_order}) { $xl_double = reverse $xl_double }
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data . $xl_double;
- }
- else {
- $self->_append($header, $data, $xl_double);
- }
- return 0;
- }
- ###############################################################################
- #
- # write_string ($row, $col, $string, $format)
- #
- # Write a string to the specified row and column (zero indexed).
- # NOTE: there is an Excel 5 defined limit of 255 characters.
- # $format is optional.
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : long string truncated to 255 chars
- #
- sub write_string {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $record = 0x00FD; # Record identifier
- my $length = 0x000A; # Bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $strlen = length($_[2]);
- my $str = $_[2];
- my $xf = _XF($self, $row, $col, $_[3]); # The cell format
- my $encoding = 0x0;
- my $str_error = 0;
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($str)) {
- my $tmp = Encode::encode("UTF-16LE", $str);
- return $self->write_utf16le_string($row, $col, $tmp, $_[3]);
- }
- }
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- # Limit the string to the max number of chars.
- if ($strlen > 32767) {
- $str = substr($str, 0, 32767);
- $str_error = -3;
- }
- # Prepend the string with the type.
- my $str_header = pack("vC", length($str), $encoding);
- $str = $str_header . $str;
- if (not exists ${$self->{_str_table}}->{$str}) {
- ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
- }
- ${$self->{_str_total}}++;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data;
- }
- else {
- $self->_append($header, $data);
- }
- return $str_error;
- }
- ###############################################################################
- #
- # write_blank($row, $col, $format)
- #
- # Write a blank cell to the specified row and column (zero indexed).
- # A blank cell is used to specify formatting without adding a string
- # or a number.
- #
- # A blank cell without a format serves no purpose. Therefore, we don't write
- # a BLANK record unless a format is specified. This is mainly an optimisation
- # for the write_row() and write_col() methods.
- #
- # Returns 0 : normal termination (including no format)
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- #
- sub write_blank {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Check the number of args
- return -1 if @_ < 2;
- # Don't write a blank cell unless it has a format
- return 0 if not defined $_[2];
- my $record = 0x0201; # Record identifier
- my $length = 0x0006; # Number of bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $xf = _XF($self, $row, $col, $_[2]); # The cell format
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- my $header = pack("vv", $record, $length);
- my $data = pack("vvv", $row, $col, $xf);
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data;
- }
- else {
- $self->_append($header, $data);
- }
- return 0;
- }
- ###############################################################################
- #
- # write_formula($row, $col, $formula, $format, $value)
- #
- # Write a formula to the specified row and column (zero indexed).
- # The textual representation of the formula is passed to the parser in
- # Formula.pm which returns a packed binary string.
- #
- # $format is optional.
- #
- # $value is an optional result of the formula that can be supplied by the user.
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- #
- sub write_formula {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $record = 0x0006; # Record identifier
- my $length; # Bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $formula = $_[2]; # The formula text string
- my $value = $_[4]; # The formula text string
- my $xf = _XF($self, $row, $col, $_[3]); # The cell format
- my $chn = 0x0000; # Must be zero
- my $is_string = 0; # Formula evaluates to str
- my $num; # Current value of formula
- my $grbit; # Option flags
- # Excel normally stores the last calculated value of the formula in $num.
- # Clearly we are not in a position to calculate this "a priori". Instead
- # we set $num to zero and set the option flags in $grbit to ensure
- # automatic calculation of the formula when the file is opened.
- # As a workaround for some non-Excel apps we also allow the user to
- # specify the result of the formula.
- #
- ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- # Strip the = sign at the beginning of the formula string
- $formula =~ s(^=)();
- my $tmp = $formula;
- # Parse the formula using the parser in Formula.pm
- my $parser = $self->{_parser};
- # In order to raise formula errors from the point of view of the calling
- # program we use an eval block and re-raise the error from here.
- #
- eval { $formula = $parser->parse_formula($formula) };
- if ($@) {
- $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
- croak $@; # Re-raise the error
- }
- my $formlen = length($formula); # Length of the binary string
- $length = 0x16 + $formlen; # Length of the record data
- my $header = pack("vv", $record, $length);
- my $data = pack("vvv", $row, $col, $xf);
- $data .= $num;
- $data .= pack("vVv", $grbit, $chn, $formlen);
- # The STRING record if the formula evaluates to a string.
- my $string = '';
- $string = $self->_get_formula_string($value) if $is_string;
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
- }
- else {
- $self->_append($header, $data, $formula, $string);
- }
- return 0;
- }
- ###############################################################################
- #
- # _encode_formula_result()
- #
- # Encode the user supplied result for a formula.
- #
- sub _encode_formula_result {
- my $self = shift;
- my $value = $_[0]; # Result to be encoded.
- my $is_string = 0; # Formula evaluates to str.
- my $num; # Current value of formula.
- my $grbit; # Option flags.
- if (not defined $value) {
- $grbit = 0x03;
- $num = pack "d", 0;
- }
- else {
- # The user specified the result of the formula. We turn off the recalc
- # flag and check the result type.
- $grbit = 0x00;
- if ($value =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
- # Value is a number.
- $num = pack "d", $value;
- }
- else {
- my %bools = (
- 'TRUE' => [1, 1],
- 'FALSE' => [1, 0],
- '#NULL!' => [2, 0],
- '#DIV/0!' => [2, 7],
- '#VALUE!' => [2, 15],
- '#REF!' => [2, 23],
- '#NAME?' => [2, 29],
- '#NUM!' => [2, 36],
- '#N/A' => [2, 42],
- );
- if (exists $bools{$value}) {
- # Value is a boolean.
- $num = pack "vvvv", $bools{$value}->[0],
- $bools{$value}->[1],
- 0,
- 0xFFFF;
- }
- else {
- # Value is a string.
- $num = pack "vvvv", 0,
- 0,
- 0,
- 0xFFFF;
- $is_string = 1;
- }
- }
- }
- return ($num, $grbit, $is_string);
- }
- ###############################################################################
- #
- # _get_formula_string()
- #
- # Pack the string value when a formula evaluates to a string. The value cannot
- # be calculated by the module and thus must be supplied by the user.
- #
- sub _get_formula_string {
- my $self = shift;
- my $record = 0x0207; # Record identifier
- my $length = 0x00; # Bytes to follow
- my $string = $_[0]; # Formula string.
- my $strlen = length $_[0]; # Length of the formula string (chars).
- my $encoding = 0; # String encoding.
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16BE", $string);
- $encoding = 1;
- }
- }
- $length = 0x03 + length $string; # Length of the record data
- my $header = pack("vv", $record, $length);
- my $data = pack("vC", $strlen, $encoding);
- return $header . $data . $string;
- }
- ###############################################################################
- #
- # store_formula($formula)
- #
- # Pre-parse a formula. This is used in conjunction with repeat_formula()
- # to repetitively rewrite a formula without re-parsing it.
- #
- sub store_formula {
- my $self = shift;
- my $formula = $_[0]; # The formula text string
- # Strip the = sign at the beginning of the formula string
- $formula =~ s(^=)();
- # Parse the formula using the parser in Formula.pm
- my $parser = $self->{_parser};
- # In order to raise formula errors from the point of view of the calling
- # program we use an eval block and re-raise the error from here.
- #
- my @tokens;
- eval { @tokens = $parser->parse_formula($formula) };
- if ($@) {
- $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
- croak $@; # Re-raise the error
- }
- # Return the parsed tokens in an anonymous array
- return [@tokens];
- }
- ###############################################################################
- #
- # repeat_formula($row, $col, $formula, $format, ($pattern => $replacement,...))
- #
- # Write a formula to the specified row and column (zero indexed) by
- # substituting $pattern $replacement pairs in the $formula created via
- # store_formula(). This allows the user to repetitively rewrite a formula
- # without the significant overhead of parsing.
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- #
- sub repeat_formula {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 2) { return -1 } # Check the number of args
- my $record = 0x0006; # Record identifier
- my $length; # Bytes to follow
- my $row = shift; # Zero indexed row
- my $col = shift; # Zero indexed column
- my $formula_ref = shift; # Array ref with formula tokens
- my $format = shift; # XF format
- my @pairs = @_; # Pattern/replacement pairs
- # Enforce an even number of arguments in the pattern/replacement list
- croak "Odd number of elements in pattern/replacement list" if @pairs %2;
- # Check that $formula is an array ref
- croak "Not a valid formula" if ref $formula_ref ne 'ARRAY';
- my @tokens = @$formula_ref;
- # Ensure that there are tokens to substitute
- croak "No tokens in formula" unless @tokens;
- # As a temporary and undocumented measure we allow the user to specify the
- # result of the formula by appending a result => $value pair to the end
- # of the arguments.
- my $value = undef;
- if ($pairs[-2] eq 'result') {
- $value = pop @pairs;
- pop @pairs;
- }
- while (@pairs) {
- my $pattern = shift @pairs;
- my $replace = shift @pairs;
- foreach my $token (@tokens) {
- last if $token =~ s/$pattern/$replace/;
- }
- }
- # Change the parameters in the formula cached by the Formula.pm object
- my $parser = $self->{_parser};
- my $formula = $parser->parse_tokens(@tokens);
- croak "Unrecognised token in formula" unless defined $formula;
- my $xf = _XF($self, $row, $col, $format); # The cell format
- my $chn = 0x0000; # Must be zero
- my $is_string = 0; # Formula evaluates to str
- my $num; # Current value of formula
- my $grbit; # Option flags
- # Excel normally stores the last calculated value of the formula in $num.
- # Clearly we are not in a position to calculate this "a priori". Instead
- # we set $num to zero and set the option flags in $grbit to ensure
- # automatic calculation of the formula when the file is opened.
- # As a workaround for some non-Excel apps we also allow the user to
- # specify the result of the formula.
- #
- ($num, $grbit, $is_string) = $self->_encode_formula_result($value);
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- my $formlen = length($formula); # Length of the binary string
- $length = 0x16 + $formlen; # Length of the record data
- my $header = pack("vv", $record, $length);
- my $data = pack("vvv", $row, $col, $xf);
- $data .= $num;
- $data .= pack("vVv", $grbit, $chn, $formlen);
- # The STRING record if the formula evaluates to a string.
- my $string = '';
- $string = $self->_get_formula_string($value) if $is_string;
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data . $formula . $string;
- }
- else {
- $self->_append($header, $data, $formula, $string);
- }
- return 0;
- }
- ###############################################################################
- #
- # write_url($row, $col, $url, $string, $format)
- #
- # Write a hyperlink. This is comprised of two elements: the visible label and
- # the invisible link. The visible label is the same as the link unless an
- # alternative string is specified.
- #
- # The parameters $string and $format are optional and their order is
- # interchangeable for backward compatibility reasons.
- #
- # The hyperlink can be to a http, ftp, mail, internal sheet, or external
- # directory url.
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : long string truncated to 255 chars
- #
- sub write_url {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Check the number of args
- return -1 if @_ < 3;
- # Add start row and col to arg list
- return $self->write_url_range($_[0], $_[1], @_);
- }
- ###############################################################################
- #
- # write_url_range($row1, $col1, $row2, $col2, $url, $string, $format)
- #
- # This is the more general form of write_url(). It allows a hyperlink to be
- # written to a range of cells. This function also decides the type of hyperlink
- # to be written. These are either, Web (http, ftp, mailto), Internal
- # (Sheet1!A1) or external ('c:\temp\foo.xls#Sheet1!A1').
- #
- # See also write_url() above for a general description and return values.
- #
- sub write_url_range {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Check the number of args
- return -1 if @_ < 5;
- # Reverse the order of $string and $format if necessary. We work on a copy
- # in order to protect the callers args. We don't use "local @_" in case of
- # perl50005 threads.
- #
- my @args = @_;
- ($args[5], $args[6]) = ($args[6], $args[5]) if ref $args[5];
- my $url = $args[4];
- # Check for internal/external sheet links or default to web link
- return $self->_write_url_internal(@args) if $url =~ m[^internal:];
- return $self->_write_url_external(@args) if $url =~ m[^external:];
- return $self->_write_url_web(@args);
- }
- ###############################################################################
- #
- # _write_url_web($row1, $col1, $row2, $col2, $url, $string, $format)
- #
- # Used to write http, ftp and mailto hyperlinks.
- # The link type ($options) is 0x03 is the same as absolute dir ref without
- # sheet. However it is differentiated by the $unknown2 data stream.
- #
- # See also write_url() above for a general description and return values.
- #
- sub _write_url_web {
- my $self = shift;
- my $record = 0x01B8; # Record identifier
- my $length = 0x00000; # Bytes to follow
- my $row1 = $_[0]; # Start row
- my $col1 = $_[1]; # Start column
- my $row2 = $_[2]; # End row
- my $col2 = $_[3]; # End column
- my $url = $_[4]; # URL string
- my $str = $_[5]; # Alternative label
- my $xf = $_[6] || $self->{_url_format};# The cell format
- # Write the visible label but protect against url recursion in write().
- $str = $url unless defined $str;
- $self->{_writing_url} = 1;
- my $error = $self->write($row1, $col1, $str, $xf);
- $self->{_writing_url} = 0;
- return $error if $error == -2;
- # Pack the undocumented parts of the hyperlink stream
- my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
- my $unknown2 = pack("H*", "E0C9EA79F9BACE118C8200AA004BA90B");
- # Pack the option flags
- my $options = pack("V", 0x03);
- # URL encoding.
- my $encoding = 0;
- # Convert an Utf8 URL type and to a null terminated wchar string.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($url)) {
- $url = Encode::encode("UTF-16LE", $url);
- $url .= "\0\0"; # URL is null terminated.
- $encoding = 1;
- }
- }
- # Convert an Ascii URL type and to a null terminated wchar string.
- if ($encoding == 0) {
- $url .= "\0";
- $url = pack 'v*', unpack 'c*', $url;
- }
- # Pack the length of the URL
- my $url_len = pack("V", length($url));
- # Calculate the data length
- $length = 0x34 + length($url);
- # Pack the header data
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvv", $row1, $row2, $col1, $col2);
- # Write the packed data
- $self->_append( $header,
- $data,
- $unknown1,
- $options,
- $unknown2,
- $url_len,
- $url);
- return $error;
- }
- ###############################################################################
- #
- # _write_url_internal($row1, $col1, $row2, $col2, $url, $string, $format)
- #
- # Used to write internal reference hyperlinks such as "Sheet1!A1".
- #
- # See also write_url() above for a general description and return values.
- #
- sub _write_url_internal {
- my $self = shift;
- my $record = 0x01B8; # Record identifier
- my $length = 0x00000; # Bytes to follow
- my $row1 = $_[0]; # Start row
- my $col1 = $_[1]; # Start column
- my $row2 = $_[2]; # End row
- my $col2 = $_[3]; # End column
- my $url = $_[4]; # URL string
- my $str = $_[5]; # Alternative label
- my $xf = $_[6] || $self->{_url_format};# The cell format
- # Strip URL type
- $url =~ s[^internal:][];
- # Write the visible label but protect against url recursion in write().
- $str = $url unless defined $str;
- $self->{_writing_url} = 1;
- my $error = $self->write($row1, $col1, $str, $xf);
- $self->{_writing_url} = 0;
- return $error if $error == -2;
- # Pack the undocumented parts of the hyperlink stream
- my $unknown1 = pack("H*", "D0C9EA79F9BACE118C8200AA004BA90B02000000");
- # Pack the option flags
- my $options = pack("V", 0x08);
- # URL encoding.
- my $encoding = 0;
- # Convert an Utf8 URL type and to a null terminated wchar string.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($url)) {
- # Quote sheet name if not already, i.e., Sheet!A1 to 'Sheet!A1'.
- $url =~ s/^(.+)!/'$1'!/ if not $url =~ /^'/;
- $url = Encode::encode("UTF-16LE", $url);
- $url .= "\0\0"; # URL is null terminated.
- $encoding = 1;
- }
- }
- # Convert an Ascii URL type and to a null terminated wchar string.
- if ($encoding == 0) {
- $url .= "\0";
- $url = pack 'v*', unpack 'c*', $url;
- }
- # Pack the length of the URL as chars (not wchars)
- my $url_len = pack("V", int(length($url)/2));
- # Calculate the data length
- $length = 0x24 + length($url);
- # Pack the header data
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvv", $row1, $row2, $col1, $col2);
- # Write the packed data
- $self->_append( $header,
- $data,
- $unknown1,
- $options,
- $url_len,
- $url);
- return $error;
- }
- ###############################################################################
- #
- # _write_url_external($row1, $col1, $row2, $col2, $url, $string, $format)
- #
- # Write links to external directory names such as 'c:\foo.xls',
- # c:\foo.xls#Sheet1!A1', '../../foo.xls'. and '../../foo.xls#Sheet1!A1'.
- #
- # Note: Excel writes some relative links with the $dir_long string. We ignore
- # these cases for the sake of simpler code.
- #
- # See also write_url() above for a general description and return values.
- #
- sub _write_url_external {
- my $self = shift;
- # Network drives are different. We will handle them separately
- # MS/Novell network drives and shares start with \\
- return $self->_write_url_external_net(@_) if $_[4] =~ m[^external:\\\\];
- my $record = 0x01B8; # Record identifier
- my $length = 0x00000; # Bytes to follow
- my $row1 = $_[0]; # Start row
- my $col1 = $_[1]; # Start column
- my $row2 = $_[2]; # End row
- my $col2 = $_[3]; # End column
- my $url = $_[4]; # URL string
- my $str = $_[5]; # Alternative label
- my $xf = $_[6] || $self->{_url_format};# The cell format
- # Strip URL type and change Unix dir separator to Dos style (if needed)
- #
- $url =~ s[^external:][];
- $url =~ s[/][\\]g;
- # Write the visible label but protect against url recursion in write().
- ($str = $url) =~ s[\#][ - ] unless defined $str;
- $self->{_writing_url} = 1;
- my $error = $self->write($row1, $col1, $str, $xf);
- $self->{_writing_url} = 0;
- return $error if $error == -2;
- # Determine if the link is relative or absolute:
- # Absolute if link starts with DOS drive specifier like C:
- # Otherwise default to 0x00 for relative link.
- #
- my $absolute = 0x00;
- $absolute = 0x02 if $url =~ m/^[A-Za-z]:/;
- # Determine if the link contains a sheet reference and change some of the
- # parameters accordingly.
- # Split the dir name and sheet name (if it exists)
- #
- my ($dir_long , $sheet) = split /\#/, $url;
- my $link_type = 0x01 | $absolute;
- my $sheet_len;
- if (defined $sheet) {
- $link_type |= 0x08;
- $sheet_len = pack("V", length($sheet) + 0x01);
- $sheet = join("\0", split('', $sheet));
- $sheet .= "\0\0\0";
- }
- else {
- $sheet_len = '';
- $sheet = '';
- }
- # Pack the link type
- $link_type = pack("V", $link_type);
- # Calculate the up-level dir count e.g. (..\..\..\ == 3)
- my $up_count = 0;
- $up_count++ while $dir_long =~ s[^\.\.\\][];
- $up_count = pack("v", $up_count);
- # Store the short dos dir name (null terminated)
- my $dir_short = $dir_long . "\0";
- # Store the long dir name as a wchar string (non-null terminated)
- $dir_long = join("\0", split('', $dir_long));
- $dir_long = $dir_long . "\0";
- # Pack the lengths of the dir strings
- my $dir_short_len = pack("V", length $dir_short );
- my $dir_long_len = pack("V", length $dir_long );
- my $stream_len = pack("V", length($dir_long) + 0x06);
- # Pack the undocumented parts of the hyperlink stream
- my $unknown1 =pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000' );
- my $unknown2 =pack("H*",'0303000000000000C000000000000046' );
- my $unknown3 =pack("H*",'FFFFADDE000000000000000000000000000000000000000');
- my $unknown4 =pack("v", 0x03 );
- # Pack the main data stream
- my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
- $unknown1 .
- $link_type .
- $unknown2 .
- $up_count .
- $dir_short_len.
- $dir_short .
- $unknown3 .
- $stream_len .
- $dir_long_len .
- $unknown4 .
- $dir_long .
- $sheet_len .
- $sheet ;
- # Pack the header data
- $length = length $data;
- my $header = pack("vv", $record, $length);
- # Write the packed data
- $self->_append($header, $data);
- return $error;
- }
- ###############################################################################
- #
- # _write_url_external_net($row1, $col1, $row2, $col2, $url, $string, $format)
- #
- # Write links to external MS/Novell network drives and shares such as
- # '//NETWORK/share/foo.xls' and '//NETWORK/share/foo.xls#Sheet1!A1'.
- #
- # See also write_url() above for a general description and return values.
- #
- sub _write_url_external_net {
- my $self = shift;
- my $record = 0x01B8; # Record identifier
- my $length = 0x00000; # Bytes to follow
- my $row1 = $_[0]; # Start row
- my $col1 = $_[1]; # Start column
- my $row2 = $_[2]; # End row
- my $col2 = $_[3]; # End column
- my $url = $_[4]; # URL string
- my $str = $_[5]; # Alternative label
- my $xf = $_[6] || $self->{_url_format};# The cell format
- # Strip URL type and change Unix dir separator to Dos style (if needed)
- #
- $url =~ s[^external:][];
- $url =~ s[/][\\]g;
- # Write the visible label but protect against url recursion in write().
- ($str = $url) =~ s[\#][ - ] unless defined $str;
- $self->{_writing_url} = 1;
- my $error = $self->write($row1, $col1, $str, $xf);
- $self->{_writing_url} = 0;
- return $error if $error == -2;
- # Determine if the link contains a sheet reference and change some of the
- # parameters accordingly.
- # Split the dir name and sheet name (if it exists)
- #
- my ($dir_long , $sheet) = split /\#/, $url;
- my $link_type = 0x0103; # Always absolute
- my $sheet_len;
- if (defined $sheet) {
- $link_type |= 0x08;
- $sheet_len = pack("V", length($sheet) + 0x01);
- $sheet = join("\0", split('', $sheet));
- $sheet .= "\0\0\0";
- }
- else {
- $sheet_len = '';
- $sheet = '';
- }
- # Pack the link type
- $link_type = pack("V", $link_type);
- # Make the string null terminated
- $dir_long = $dir_long . "\0";
- # Pack the lengths of the dir string
- my $dir_long_len = pack("V", length $dir_long);
- # Store the long dir name as a wchar string (non-null terminated)
- $dir_long = join("\0", split('', $dir_long));
- $dir_long = $dir_long . "\0";
- # Pack the undocumented part of the hyperlink stream
- my $unknown1 = pack("H*",'D0C9EA79F9BACE118C8200AA004BA90B02000000');
- # Pack the main data stream
- my $data = pack("vvvv", $row1, $row2, $col1, $col2) .
- $unknown1 .
- $link_type .
- $dir_long_len .
- $dir_long .
- $sheet_len .
- $sheet ;
- # Pack the header data
- $length = length $data;
- my $header = pack("vv", $record, $length);
- # Write the packed data
- $self->_append($header, $data);
- return $error;
- }
- ###############################################################################
- #
- # write_date_time ($row, $col, $string, $format)
- #
- # Write a datetime string in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format as a
- # number representing an Excel date. $format is optional.
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : Invalid date_time, written as string
- #
- sub write_date_time {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $str = $_[2];
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- my $error = 0;
- my $date_time = $self->convert_date_time($str);
- if (defined $date_time) {
- $error = $self->write_number($row, $col, $date_time, $_[3]);
- }
- else {
- # The date isn't valid so write it as a string.
- $self->write_string($row, $col, $str, $_[3]);
- $error = -3;
- }
- return $error;
- }
- ###############################################################################
- #
- # convert_date_time($date_time_string)
- #
- # The function takes a date and time in ISO8601 "yyyy-mm-ddThh:mm:ss.ss" format
- # and converts it to a decimal number representing a valid Excel date.
- #
- # Dates and times in Excel are represented by real numbers. The integer part of
- # the number stores the number of days since the epoch and the fractional part
- # stores the percentage of the day in seconds. The epoch can be either 1900 or
- # 1904.
- #
- # Parameter: Date and time string in one of the following formats:
- # yyyy-mm-ddThh:mm:ss.ss # Standard
- # yyyy-mm-ddT # Date only
- # Thh:mm:ss.ss # Time only
- #
- # Returns:
- # A decimal number representing a valid Excel date, or
- # undef if the date is invalid.
- #
- sub convert_date_time {
- my $self = shift;
- my $date_time = $_[0];
- my $days = 0; # Number of days since epoch
- my $seconds = 0; # Time expressed as fraction of 24h hours in seconds
- my ($year, $month, $day);
- my ($hour, $min, $sec);
- # Strip leading and trailing whitespace.
- $date_time =~ s/^\s+//;
- $date_time =~ s/\s+$//;
- # Check for invalid date char.
- return if $date_time =~ /[^0-9T:\-\.Z]/;
- # Check for "T" after date or before time.
- return unless $date_time =~ /\dT|T\d/;
- # Strip trailing Z in ISO8601 date.
- $date_time =~ s/Z$//;
- # Split into date and time.
- my ($date, $time) = split /T/, $date_time;
- # We allow the time portion of the input DateTime to be optional.
- if ($time ne '') {
- # Match hh:mm:ss.sss+ where the seconds are optional
- if ($time =~ /^(\d\d):(\d\d)(:(\d\d(\.\d+)?))?/) {
- $hour = $1;
- $min = $2;
- $sec = $4 || 0;
- }
- else {
- return undef; # Not a valid time format.
- }
- # Some boundary checks
- return if $hour >= 24;
- return if $min >= 60;
- return if $sec >= 60;
- # Excel expresses seconds as a fraction of the number in 24 hours.
- $seconds = ($hour *60*60 + $min *60 + $sec) / (24 *60 *60);
- }
- # We allow the date portion of the input DateTime to be optional.
- return $seconds if $date eq '';
- # Match date as yyyy-mm-dd.
- if ($date =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
- $year = $1;
- $month = $2;
- $day = $3;
- }
- else {
- return undef; # Not a valid date format.
- }
- # Set the epoch as 1900 or 1904. Defaults to 1900.
- my $date_1904 = $self->{_1904};
- # Special cases for Excel.
- if (not $date_1904) {
- return $seconds if $date eq '1899-12-31'; # Excel 1900 epoch
- return $seconds if $date eq '1900-01-00'; # Excel 1900 epoch
- return 60 + $seconds if $date eq '1900-02-29'; # Excel false leapday
- }
- # We calculate the date by calculating the number of days since the epoch
- # and adjust for the number of leap days. We calculate the number of leap
- # days by normalising the year in relation to the epoch. Thus the year 2000
- # becomes 100 for 4 and 100 year leapdays and 400 for 400 year leapdays.
- #
- my $epoch = $date_1904 ? 1904 : 1900;
- my $offset = $date_1904 ? 4 : 0;
- my $norm = 300;
- my $range = $year -$epoch;
- # Set month days and check for leap year.
- my @mdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
- my $leap = 0;
- $leap = 1 if $year % 4 == 0 and $year % 100 or $year % 400 == 0;
- $mdays[1] = 29 if $leap;
- # Some boundary checks
- return if $year < $epoch or $year > 9999;
- return if $month < 1 or $month > 12;
- return if $day < 1 or $day > $mdays[$month -1];
- # Accumulate the number of days since the epoch.
- $days = $day; # Add days for current month
- $days += $mdays[$_] for 0 .. $month -2; # Add days for past months
- $days += $range *365; # Add days for past years
- $days += int(($range) / 4); # Add leapdays
- $days -= int(($range +$offset) /100); # Subtract 100 year leapdays
- $days += int(($range +$offset +$norm)/400); # Add 400 year leapdays
- $days -= $leap; # Already counted above
- # Adjust for Excel erroneously treating 1900 as a leap year.
- $days++ if $date_1904 == 0 and $days > 59;
- return $days + $seconds;
- }
- ###############################################################################
- #
- # set_row($row, $height, $XF, $hidden, $level)
- #
- # This method is used to set the height and XF format for a row.
- # Writes the BIFF record ROW.
- #
- sub set_row {
- my $self = shift;
- my $record = 0x0208; # Record identifier
- my $length = 0x0010; # Number of bytes to follow
- my $row = $_[0]; # Row Number
- my $colMic = 0x0000; # First defined column
- my $colMac = 0x0000; # Last defined column
- my $miyRw; # Row height
- my $irwMac = 0x0000; # Used by Excel to optimise loading
- my $reserved = 0x0000; # Reserved
- my $grbit = 0x0000; # Option flags
- my $ixfe; # XF index
- my $height = $_[1]; # Format object
- my $format = $_[2]; # Format object
- my $hidden = $_[3] || 0; # Hidden flag
- my $level = $_[4] || 0; # Outline level
- my $collapsed = $_[5] || 0; # Collapsed row
- return unless defined $row; # Ensure at least $row is specified.
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, 0, 0, 1);
- # Check for a format object
- if (ref $format) {
- $ixfe = $format->get_xf_index();
- }
- else {
- $ixfe = 0x0F;
- }
- # Set the row height in units of 1/20 of a point. Note, some heights may
- # not be obtained exactly due to rounding in Excel.
- #
- if (defined $height) {
- $miyRw = $height *20;
- }
- else {
- $miyRw = 0xff; # The default row height
- $height = 0;
- }
- # Set the limits for the outline levels (0 <= x <= 7).
- $level = 0 if $level < 0;
- $level = 7 if $level > 7;
- $self->{_outline_row_level} = $level if $level >$self->{_outline_row_level};
- # Set the options flags.
- # 0x10: The fCollapsed flag indicates that the row contains the "+"
- # when an outline group is collapsed.
- # 0x20: The fDyZero height flag indicates a collapsed or hidden row.
- # 0x40: The fUnsynced flag is used to show that the font and row heights
- # are not compatible. This is usually the case for WriteExcel.
- # 0x80: The fGhostDirty flag indicates that the row has been formatted.
- #
- $grbit |= $level;
- $grbit |= 0x0010 if $collapsed;
- $grbit |= 0x0020 if $hidden;
- $grbit |= 0x0040;
- $grbit |= 0x0080 if $format;
- $grbit |= 0x0100;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
- $irwMac,$reserved, $grbit, $ixfe);
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_row_data}->{$_[0]} = $header . $data;
- }
- else {
- $self->_append($header, $data);
- }
- # Store the row sizes for use when calculating image vertices.
- # Also store the column formats.
- $self->{_row_sizes}->{$_[0]} = $height;
- $self->{_row_formats}->{$_[0]} = $format if defined $format;
- }
- ###############################################################################
- #
- # _write_row_default()
- #
- # Write a default row record, in compatibility mode, for rows that don't have
- # user specified values..
- #
- sub _write_row_default {
- my $self = shift;
- my $record = 0x0208; # Record identifier
- my $length = 0x0010; # Number of bytes to follow
- my $row = $_[0]; # Row Number
- my $colMic = $_[1]; # First defined column
- my $colMac = $_[2]; # Last defined column
- my $miyRw = 0xFF; # Row height
- my $irwMac = 0x0000; # Used by Excel to optimise loading
- my $reserved = 0x0000; # Reserved
- my $grbit = 0x0100; # Option flags
- my $ixfe = 0x0F; # XF index
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvvvvv", $row, $colMic, $colMac, $miyRw,
- $irwMac,$reserved, $grbit, $ixfe);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _check_dimensions($row, $col, $ignore_row, $ignore_col)
- #
- # Check that $row and $col are valid and store max and min values for use in
- # DIMENSIONS record. See, _store_dimensions().
- #
- # The $ignore_row/$ignore_col flags is used to indicate that we wish to
- # perform the dimension check without storing the value.
- #
- # The ignore flags are use by set_row() and data_validate.
- #
- sub _check_dimensions {
- my $self = shift;
- my $row = $_[0];
- my $col = $_[1];
- my $ignore_row = $_[2];
- my $ignore_col = $_[3];
- return -2 if not defined $row;
- return -2 if $row >= $self->{_xls_rowmax};
- return -2 if not defined $col;
- return -2 if $col >= $self->{_xls_colmax};
- if (not $ignore_row) {
- if (not defined $self->{_dim_rowmin} or $row < $self->{_dim_rowmin}) {
- $self->{_dim_rowmin} = $row;
- }
- if (not defined $self->{_dim_rowmax} or $row > $self->{_dim_rowmax}) {
- $self->{_dim_rowmax} = $row;
- }
- }
- if (not $ignore_col) {
- if (not defined $self->{_dim_colmin} or $col < $self->{_dim_colmin}) {
- $self->{_dim_colmin} = $col;
- }
- if (not defined $self->{_dim_colmax} or $col > $self->{_dim_colmax}) {
- $self->{_dim_colmax} = $col;
- }
- }
- return 0;
- }
- ###############################################################################
- #
- # _store_dimensions()
- #
- # Writes Excel DIMENSIONS to define the area in which there is cell data.
- #
- # Notes:
- # Excel stores the max row/col as row/col +1.
- # Max and min values of 0 are used to indicate that no cell data.
- # We set the undef member data to 0 since it is used by _store_table().
- # Inserting images or charts doesn't change the DIMENSION data.
- #
- sub _store_dimensions {
- my $self = shift;
- my $record = 0x0200; # Record identifier
- my $length = 0x000E; # Number of bytes to follow
- my $row_min; # First row
- my $row_max; # Last row plus 1
- my $col_min; # First column
- my $col_max; # Last column plus 1
- my $reserved = 0x0000; # Reserved by Excel
- if (defined $self->{_dim_rowmin}) {$row_min = $self->{_dim_rowmin} }
- else {$row_min = 0 }
- if (defined $self->{_dim_rowmax}) {$row_max = $self->{_dim_rowmax} + 1}
- else {$row_max = 0 }
- if (defined $self->{_dim_colmin}) {$col_min = $self->{_dim_colmin} }
- else {$col_min = 0 }
- if (defined $self->{_dim_colmax}) {$col_max = $self->{_dim_colmax} + 1}
- else {$col_max = 0 }
- # Set member data to the new max/min value for use by _store_table().
- $self->{_dim_rowmin} = $row_min;
- $self->{_dim_rowmax} = $row_max;
- $self->{_dim_colmin} = $col_min;
- $self->{_dim_colmax} = $col_max;
- my $header = pack("vv", $record, $length);
- my $data = pack("VVvvv", $row_min, $row_max,
- $col_min, $col_max, $reserved);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_window2()
- #
- # Write BIFF record Window2.
- #
- sub _store_window2 {
- use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
- my $self = shift;
- my $record = 0x023E; # Record identifier
- my $length = 0x0012; # Number of bytes to follow
- my $grbit = 0x00B6; # Option flags
- my $rwTop = $self->{_first_row}; # Top visible row
- my $colLeft = $self->{_first_col}; # Leftmost visible column
- my $rgbHdr = 0x00000040; # Row/col heading, grid color
- my $wScaleSLV = 0x0000; # Zoom in page break preview
- my $wScaleNormal = 0x0000; # Zoom in normal view
- my $reserved = 0x00000000;
- # The options flags that comprise $grbit
- my $fDspFmla = $self->{_display_formulas}; # 0 - bit
- my $fDspGrid = $self->{_screen_gridlines}; # 1
- my $fDspRwCol = $self->{_display_headers}; # 2
- my $fFrozen = $self->{_frozen}; # 3
- my $fDspZeros = $self->{_display_zeros}; # 4
- my $fDefaultHdr = 1; # 5
- my $fArabic = $self->{_display_arabic}; # 6
- my $fDspGuts = $self->{_outline_on}; # 7
- my $fFrozenNoSplit = $self->{_frozen_no_split}; # 0 - bit
- my $fSelected = $self->{_selected}; # 1
- my $fPaged = $self->{_active}; # 2
- my $fBreakPreview = 0; # 3
- $grbit = $fDspFmla;
- $grbit |= $fDspGrid << 1;
- $grbit |= $fDspRwCol << 2;
- $grbit |= $fFrozen << 3;
- $grbit |= $fDspZeros << 4;
- $grbit |= $fDefaultHdr << 5;
- $grbit |= $fArabic << 6;
- $grbit |= $fDspGuts << 7;
- $grbit |= $fFrozenNoSplit << 8;
- $grbit |= $fSelected << 9;
- $grbit |= $fPaged << 10;
- $grbit |= $fBreakPreview << 11;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvVvvV", $grbit, $rwTop, $colLeft, $rgbHdr,
- $wScaleSLV, $wScaleNormal, $reserved );
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_page_view()
- #
- # Set page view mode. Only applicable to Mac Excel.
- #
- sub _store_page_view {
- my $self = shift;
- return unless $self->{_page_view};
- my $data = pack "H*", 'C8081100C808000000000040000000000900000000';
- $self->_append($data);
- }
- ###############################################################################
- #
- # _store_tab_color()
- #
- # Write the Tab Color BIFF record.
- #
- sub _store_tab_color {
- my $self = shift;
- my $color = $self->{_tab_color};
- return unless $color;
- my $record = 0x0862; # Record identifier
- my $length = 0x0014; # Number of bytes to follow
- my $zero = 0x0000;
- my $unknown = 0x0014;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvvvvvvv", $record, $zero, $zero, $zero, $zero,
- $zero, $unknown, $zero, $color, $zero);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_defrow()
- #
- # Write BIFF record DEFROWHEIGHT.
- #
- sub _store_defrow {
- my $self = shift;
- my $record = 0x0225; # Record identifier
- my $length = 0x0004; # Number of bytes to follow
- my $grbit = 0x0000; # Options.
- my $height = 0x00FF; # Default row height
- my $header = pack("vv", $record, $length);
- my $data = pack("vv", $grbit, $height);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_defcol()
- #
- # Write BIFF record DEFCOLWIDTH.
- #
- sub _store_defcol {
- my $self = shift;
- my $record = 0x0055; # Record identifier
- my $length = 0x0002; # Number of bytes to follow
- my $colwidth = 0x0008; # Default column width
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $colwidth);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_colinfo($firstcol, $lastcol, $width, $format, $hidden)
- #
- # Write BIFF record COLINFO to define column widths
- #
- # Note: The SDK says the record length is 0x0B but Excel writes a 0x0C
- # length record.
- #
- sub _store_colinfo {
- my $self = shift;
- my $record = 0x007D; # Record identifier
- my $length = 0x000B; # Number of bytes to follow
- my $colFirst = $_[0] || 0; # First formatted column
- my $colLast = $_[1] || 0; # Last formatted column
- my $width = $_[2] || 8.43; # Col width in user units, 8.43 is default
- my $coldx; # Col width in internal units
- my $pixels; # Col width in pixels
- # Excel rounds the column width to the nearest pixel. Therefore we first
- # convert to pixels and then to the internal units. The pixel to users-units
- # relationship is different for values less than 1.
- #
- if ($width < 1) {
- $pixels = int($width *12);
- }
- else {
- $pixels = int($width *7 ) +5;
- }
- $coldx = int($pixels *256/7);
- my $ixfe; # XF index
- my $grbit = 0x0000; # Option flags
- my $reserved = 0x00; # Reserved
- my $format = $_[3]; # Format object
- my $hidden = $_[4] || 0; # Hidden flag
- my $level = $_[5] || 0; # Outline level
- my $collapsed = $_[6] || 0; # Outline level
- # Check for a format object
- if (ref $format) {
- $ixfe = $format->get_xf_index();
- }
- else {
- $ixfe = 0x0F;
- }
- # Set the limits for the outline levels (0 <= x <= 7).
- $level = 0 if $level < 0;
- $level = 7 if $level > 7;
- # Set the options flags. (See set_row() for more details).
- $grbit |= 0x0001 if $hidden;
- $grbit |= $level << 8;
- $grbit |= 0x1000 if $collapsed;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvvC", $colFirst, $colLast, $coldx,
- $ixfe, $grbit, $reserved);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_filtermode()
- #
- # Write BIFF record FILTERMODE to indicate that the worksheet contains
- # AUTOFILTER record, ie. autofilters with a filter set.
- #
- sub _store_filtermode {
- my $self = shift;
- my $record = 0x009B; # Record identifier
- my $length = 0x0000; # Number of bytes to follow
- # Only write the record if the worksheet contains a filtered autofilter.
- return unless $self->{_filter_on};
- my $header = pack("vv", $record, $length);
- $self->_prepend($header);
- }
- ###############################################################################
- #
- # _store_autofilterinfo()
- #
- # Write BIFF record AUTOFILTERINFO.
- #
- sub _store_autofilterinfo {
- my $self = shift;
- my $record = 0x009D; # Record identifier
- my $length = 0x0002; # Number of bytes to follow
- my $num_filters = $self->{_filter_count};
- # Only write the record if the worksheet contains an autofilter.
- return unless $self->{_filter_count};
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $num_filters);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_selection($first_row, $first_col, $last_row, $last_col)
- #
- # Write BIFF record SELECTION.
- #
- sub _store_selection {
- my $self = shift;
- my $record = 0x001D; # Record identifier
- my $length = 0x000F; # Number of bytes to follow
- my $pnn = $self->{_active_pane}; # Pane position
- my $rwAct = $_[0]; # Active row
- my $colAct = $_[1]; # Active column
- my $irefAct = 0; # Active cell ref
- my $cref = 1; # Number of refs
- my $rwFirst = $_[0]; # First row in reference
- my $colFirst = $_[1]; # First col in reference
- my $rwLast = $_[2] || $rwFirst; # Last row in reference
- my $colLast = $_[3] || $colFirst; # Last col in reference
- # Swap last row/col for first row/col as necessary
- if ($rwFirst > $rwLast) {
- ($rwFirst, $rwLast) = ($rwLast, $rwFirst);
- }
- if ($colFirst > $colLast) {
- ($colFirst, $colLast) = ($colLast, $colFirst);
- }
- my $header = pack("vv", $record, $length);
- my $data = pack("CvvvvvvCC", $pnn, $rwAct, $colAct,
- $irefAct, $cref,
- $rwFirst, $rwLast,
- $colFirst, $colLast);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_externcount($count)
- #
- # Write BIFF record EXTERNCOUNT to indicate the number of external sheet
- # references in a worksheet.
- #
- # Excel only stores references to external sheets that are used in formulas.
- # For simplicity we store references to all the sheets in the workbook
- # regardless of whether they are used or not. This reduces the overall
- # complexity and eliminates the need for a two way dialogue between the formula
- # parser the worksheet objects.
- #
- sub _store_externcount {
- my $self = shift;
- my $record = 0x0016; # Record identifier
- my $length = 0x0002; # Number of bytes to follow
- my $cxals = $_[0]; # Number of external references
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $cxals);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_externsheet($sheetname)
- #
- #
- # Writes the Excel BIFF EXTERNSHEET record. These references are used by
- # formulas. A formula references a sheet name via an index. Since we store a
- # reference to all of the external worksheets the EXTERNSHEET index is the same
- # as the worksheet index.
- #
- sub _store_externsheet {
- my $self = shift;
- my $record = 0x0017; # Record identifier
- my $length; # Number of bytes to follow
- my $sheetname = $_[0]; # Worksheet name
- my $cch; # Length of sheet name
- my $rgch; # Filename encoding
- # References to the current sheet are encoded differently to references to
- # external sheets.
- #
- if ($self->{_name} eq $sheetname) {
- $sheetname = '';
- $length = 0x02; # The following 2 bytes
- $cch = 1; # The following byte
- $rgch = 0x02; # Self reference
- }
- else {
- $length = 0x02 + length($_[0]);
- $cch = length($sheetname);
- $rgch = 0x03; # Reference to a sheet in the current workbook
- }
- my $header = pack("vv", $record, $length);
- my $data = pack("CC", $cch, $rgch);
- $self->_prepend($header, $data, $sheetname);
- }
- ###############################################################################
- #
- # _store_panes()
- #
- #
- # Writes the Excel BIFF PANE record.
- # The panes can either be frozen or thawed (unfrozen).
- # Frozen panes are specified in terms of a integer number of rows and columns.
- # Thawed panes are specified in terms of Excel's units for rows and columns.
- #
- sub _store_panes {
- my $self = shift;
- my $record = 0x0041; # Record identifier
- my $length = 0x000A; # Number of bytes to follow
- my $y = $_[0] || 0; # Vertical split position
- my $x = $_[1] || 0; # Horizontal split position
- my $rwTop = $_[2]; # Top row visible
- my $colLeft = $_[3]; # Leftmost column visible
- my $no_split = $_[4]; # No used here.
- my $pnnAct = $_[5]; # Active pane
- # Code specific to frozen or thawed panes.
- if ($self->{_frozen}) {
- # Set default values for $rwTop and $colLeft
- $rwTop = $y unless defined $rwTop;
- $colLeft = $x unless defined $colLeft;
- }
- else {
- # Set default values for $rwTop and $colLeft
- $rwTop = 0 unless defined $rwTop;
- $colLeft = 0 unless defined $colLeft;
- # Convert Excel's row and column units to the internal units.
- # The default row height is 12.75
- # The default column width is 8.43
- # The following slope and intersection values were interpolated.
- #
- $y = 20*$y + 255;
- $x = 113.879*$x + 390;
- }
- # Determine which pane should be active. There is also the undocumented
- # option to override this should it be necessary: may be removed later.
- #
- if (not defined $pnnAct) {
- $pnnAct = 0 if ($x != 0 && $y != 0); # Bottom right
- $pnnAct = 1 if ($x != 0 && $y == 0); # Top right
- $pnnAct = 2 if ($x == 0 && $y != 0); # Bottom left
- $pnnAct = 3 if ($x == 0 && $y == 0); # Top left
- }
- $self->{_active_pane} = $pnnAct; # Used in _store_selection
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvv", $x, $y, $rwTop, $colLeft, $pnnAct);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_setup()
- #
- # Store the page setup SETUP BIFF record.
- #
- sub _store_setup {
- use integer; # Avoid << shift bug in Perl 5.6.0 on HP-UX
- my $self = shift;
- my $record = 0x00A1; # Record identifier
- my $length = 0x0022; # Number of bytes to follow
- my $iPaperSize = $self->{_paper_size}; # Paper size
- my $iScale = $self->{_print_scale}; # Print scaling factor
- my $iPageStart = $self->{_page_start}; # Starting page number
- my $iFitWidth = $self->{_fit_width}; # Fit to number of pages wide
- my $iFitHeight = $self->{_fit_height}; # Fit to number of pages high
- my $grbit = 0x00; # Option flags
- my $iRes = 0x0258; # Print resolution
- my $iVRes = 0x0258; # Vertical print resolution
- my $numHdr = $self->{_margin_header}; # Header Margin
- my $numFtr = $self->{_margin_footer}; # Footer Margin
- my $iCopies = 0x01; # Number of copies
- my $fLeftToRight = $self->{_page_order}; # Print over then down
- my $fLandscape = $self->{_orientation}; # Page orientation
- my $fNoPls = 0x0; # Setup not read from printer
- my $fNoColor = $self->{_black_white}; # Print black and white
- my $fDraft = $self->{_draft_quality}; # Print draft quality
- my $fNotes = $self->{_print_comments};# Print notes
- my $fNoOrient = 0x0; # Orientation not set
- my $fUsePage = $self->{_custom_start}; # Use custom starting page
- $grbit = $fLeftToRight;
- $grbit |= $fLandscape << 1;
- $grbit |= $fNoPls << 2;
- $grbit |= $fNoColor << 3;
- $grbit |= $fDraft << 4;
- $grbit |= $fNotes << 5;
- $grbit |= $fNoOrient << 6;
- $grbit |= $fUsePage << 7;
- $numHdr = pack("d", $numHdr);
- $numFtr = pack("d", $numFtr);
- if ($self->{_byte_order}) {
- $numHdr = reverse $numHdr;
- $numFtr = reverse $numFtr;
- }
- my $header = pack("vv", $record, $length);
- my $data1 = pack("vvvvvvvv", $iPaperSize,
- $iScale,
- $iPageStart,
- $iFitWidth,
- $iFitHeight,
- $grbit,
- $iRes,
- $iVRes);
- my $data2 = $numHdr .$numFtr;
- my $data3 = pack("v", $iCopies);
- $self->_prepend($header, $data1, $data2, $data3);
- }
- ###############################################################################
- #
- # _store_header()
- #
- # Store the header caption BIFF record.
- #
- sub _store_header {
- my $self = shift;
- my $record = 0x0014; # Record identifier
- my $length; # Bytes to follow
- my $str = $self->{_header}; # header string
- my $cch = length($str); # Length of header string
- my $encoding = $self->{_header_encoding}; # Character encoding
- # Character length is num of chars not num of bytes
- $cch /= 2 if $encoding;
- # Change the UTF-16 name from BE to LE
- $str = pack 'n*', unpack 'v*', $str if $encoding;
- $length = 3 + length($str);
- my $header = pack("vv", $record, $length);
- my $data = pack("vC", $cch, $encoding);
- $self->_prepend($header, $data, $str);
- }
- ###############################################################################
- #
- # _store_footer()
- #
- # Store the footer caption BIFF record.
- #
- sub _store_footer {
- my $self = shift;
- my $record = 0x0015; # Record identifier
- my $length; # Bytes to follow
- my $str = $self->{_footer}; # footer string
- my $cch = length($str); # Length of footer string
- my $encoding = $self->{_footer_encoding}; # Character encoding
- # Character length is num of chars not num of bytes
- $cch /= 2 if $encoding;
- # Change the UTF-16 name from BE to LE
- $str = pack 'n*', unpack 'v*', $str if $encoding;
- $length = 3 + length($str);
- my $header = pack("vv", $record, $length);
- my $data = pack("vC", $cch, $encoding);
- $self->_prepend($header, $data, $str);
- }
- ###############################################################################
- #
- # _store_hcenter()
- #
- # Store the horizontal centering HCENTER BIFF record.
- #
- sub _store_hcenter {
- my $self = shift;
- my $record = 0x0083; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fHCenter = $self->{_hcenter}; # Horizontal centering
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fHCenter);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_vcenter()
- #
- # Store the vertical centering VCENTER BIFF record.
- #
- sub _store_vcenter {
- my $self = shift;
- my $record = 0x0084; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fVCenter = $self->{_vcenter}; # Horizontal centering
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fVCenter);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_margin_left()
- #
- # Store the LEFTMARGIN BIFF record.
- #
- sub _store_margin_left {
- my $self = shift;
- my $record = 0x0026; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $margin = $self->{_margin_left}; # Margin in inches
- my $header = pack("vv", $record, $length);
- my $data = pack("d", $margin);
- if ($self->{_byte_order}) { $data = reverse $data }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_margin_right()
- #
- # Store the RIGHTMARGIN BIFF record.
- #
- sub _store_margin_right {
- my $self = shift;
- my $record = 0x0027; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $margin = $self->{_margin_right}; # Margin in inches
- my $header = pack("vv", $record, $length);
- my $data = pack("d", $margin);
- if ($self->{_byte_order}) { $data = reverse $data }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_margin_top()
- #
- # Store the TOPMARGIN BIFF record.
- #
- sub _store_margin_top {
- my $self = shift;
- my $record = 0x0028; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $margin = $self->{_margin_top}; # Margin in inches
- my $header = pack("vv", $record, $length);
- my $data = pack("d", $margin);
- if ($self->{_byte_order}) { $data = reverse $data }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_margin_bottom()
- #
- # Store the BOTTOMMARGIN BIFF record.
- #
- sub _store_margin_bottom {
- my $self = shift;
- my $record = 0x0029; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $margin = $self->{_margin_bottom}; # Margin in inches
- my $header = pack("vv", $record, $length);
- my $data = pack("d", $margin);
- if ($self->{_byte_order}) { $data = reverse $data }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # merge_cells($first_row, $first_col, $last_row, $last_col)
- #
- # This is an Excel97/2000 method. It is required to perform more complicated
- # merging than the normal align merge in Format.pm
- #
- sub merge_cells {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- my $record = 0x00E5; # Record identifier
- my $length = 0x000A; # Bytes to follow
- my $cref = 1; # Number of refs
- my $rwFirst = $_[0]; # First row in reference
- my $colFirst = $_[1]; # First col in reference
- my $rwLast = $_[2] || $rwFirst; # Last row in reference
- my $colLast = $_[3] || $colFirst; # Last col in reference
- # Excel doesn't allow a single cell to be merged
- return if $rwFirst == $rwLast and $colFirst == $colLast;
- # Swap last row/col with first row/col as necessary
- ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
- ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvvv", $cref,
- $rwFirst, $rwLast,
- $colFirst, $colLast);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # merge_range($row1, $col1, $row2, $col2, $string, $format, $encoding)
- #
- # This is a wrapper to ensure correct use of the merge_cells method, i.e., write
- # the first cell of the range, write the formatted blank cells in the range and
- # then call the merge_cells record. Failing to do the steps in this order will
- # cause Excel 97 to crash.
- #
- sub merge_range {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- croak "Incorrect number of arguments" if @_ != 6 and @_ != 7;
- croak "Format argument is not a format object" unless ref $_[5];
- my $rwFirst = $_[0];
- my $colFirst = $_[1];
- my $rwLast = $_[2];
- my $colLast = $_[3];
- my $string = $_[4];
- my $format = $_[5];
- my $encoding = $_[6] ? 1 : 0;
- # Temp code to prevent merged formats in non-merged cells.
- my $error = "Error: refer to merge_range() in the documentation. " .
- "Can't use previously non-merged format in merged cells";
- croak $error if $format->{_used_merge} == -1;
- $format->{_used_merge} = 0; # Until the end of this function.
- # Set the merge_range property of the format object. For BIFF8+.
- $format->set_merge_range();
- # Excel doesn't allow a single cell to be merged
- croak "Can't merge single cell" if $rwFirst == $rwLast and
- $colFirst == $colLast;
- # Swap last row/col with first row/col as necessary
- ($rwFirst, $rwLast ) = ($rwLast, $rwFirst ) if $rwFirst > $rwLast;
- ($colFirst, $colLast) = ($colLast, $colFirst) if $colFirst > $colLast;
- # Write the first cell
- if ($encoding) {
- $self->write_utf16be_string($rwFirst, $colFirst, $string, $format);
- }
- else {
- $self->write ($rwFirst, $colFirst, $string, $format);
- }
- # Pad out the rest of the area with formatted blank cells.
- for my $row ($rwFirst .. $rwLast) {
- for my $col ($colFirst .. $colLast) {
- next if $row == $rwFirst and $col == $colFirst;
- $self->write_blank($row, $col, $format);
- }
- }
- $self->merge_cells($rwFirst, $colFirst, $rwLast, $colLast);
- # Temp code to prevent merged formats in non-merged cells.
- $format->{_used_merge} = 1;
- }
- ###############################################################################
- #
- # _store_print_headers()
- #
- # Write the PRINTHEADERS BIFF record.
- #
- sub _store_print_headers {
- my $self = shift;
- my $record = 0x002a; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fPrintRwCol = $self->{_print_headers}; # Boolean flag
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fPrintRwCol);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_print_gridlines()
- #
- # Write the PRINTGRIDLINES BIFF record. Must be used in conjunction with the
- # GRIDSET record.
- #
- sub _store_print_gridlines {
- my $self = shift;
- my $record = 0x002b; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fPrintGrid = $self->{_print_gridlines}; # Boolean flag
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fPrintGrid);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_gridset()
- #
- # Write the GRIDSET BIFF record. Must be used in conjunction with the
- # PRINTGRIDLINES record.
- #
- sub _store_gridset {
- my $self = shift;
- my $record = 0x0082; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fGridSet = not $self->{_print_gridlines}; # Boolean flag
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fGridSet);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_guts()
- #
- # Write the GUTS BIFF record. This is used to configure the gutter margins
- # where Excel outline symbols are displayed. The visibility of the gutters is
- # controlled by a flag in WSBOOL. See also _store_wsbool().
- #
- # We are all in the gutter but some of us are looking at the stars.
- #
- sub _store_guts {
- my $self = shift;
- my $record = 0x0080; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $dxRwGut = 0x0000; # Size of row gutter
- my $dxColGut = 0x0000; # Size of col gutter
- my $row_level = $self->{_outline_row_level};
- my $col_level = 0;
- # Calculate the maximum column outline level. The equivalent calculation
- # for the row outline level is carried out in set_row().
- #
- foreach my $colinfo (@{$self->{_colinfo}}) {
- # Skip cols without outline level info.
- next if @{$colinfo} < 6;
- $col_level = @{$colinfo}[5] if @{$colinfo}[5] > $col_level;
- }
- # Set the limits for the outline levels (0 <= x <= 7).
- $col_level = 0 if $col_level < 0;
- $col_level = 7 if $col_level > 7;
- # The displayed level is one greater than the max outline levels
- $row_level++ if $row_level > 0;
- $col_level++ if $col_level > 0;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvv", $dxRwGut, $dxColGut, $row_level, $col_level);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_wsbool()
- #
- # Write the WSBOOL BIFF record, mainly for fit-to-page. Used in conjunction
- # with the SETUP record.
- #
- sub _store_wsbool {
- my $self = shift;
- my $record = 0x0081; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $grbit = 0x0000; # Option flags
- # Set the option flags
- $grbit |= 0x0001; # Auto page breaks visible
- $grbit |= 0x0020 if $self->{_outline_style}; # Auto outline styles
- $grbit |= 0x0040 if $self->{_outline_below}; # Outline summary below
- $grbit |= 0x0080 if $self->{_outline_right}; # Outline summary right
- $grbit |= 0x0100 if $self->{_fit_page}; # Page setup fit to page
- $grbit |= 0x0400 if $self->{_outline_on}; # Outline symbols displayed
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $grbit);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_hbreak()
- #
- # Write the HORIZONTALPAGEBREAKS BIFF record.
- #
- sub _store_hbreak {
- my $self = shift;
- # Return if the user hasn't specified pagebreaks
- return unless @{$self->{_hbreaks}};
- # Sort and filter array of page breaks
- my @breaks = $self->_sort_pagebreaks(@{$self->{_hbreaks}});
- my $record = 0x001b; # Record identifier
- my $cbrk = scalar @breaks; # Number of page breaks
- my $length = 2 + 6*$cbrk; # Bytes to follow
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $cbrk);
- # Append each page break
- foreach my $break (@breaks) {
- $data .= pack("vvv", $break, 0x0000, 0x00ff);
- }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_vbreak()
- #
- # Write the VERTICALPAGEBREAKS BIFF record.
- #
- sub _store_vbreak {
- my $self = shift;
- # Return if the user hasn't specified pagebreaks
- return unless @{$self->{_vbreaks}};
- # Sort and filter array of page breaks
- my @breaks = $self->_sort_pagebreaks(@{$self->{_vbreaks}});
- my $record = 0x001a; # Record identifier
- my $cbrk = scalar @breaks; # Number of page breaks
- my $length = 2 + 6*$cbrk; # Bytes to follow
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $cbrk);
- # Append each page break
- foreach my $break (@breaks) {
- $data .= pack("vvv", $break, 0x0000, 0xffff);
- }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_protect()
- #
- # Set the Biff PROTECT record to indicate that the worksheet is protected.
- #
- sub _store_protect {
- my $self = shift;
- # Exit unless sheet protection has been specified
- return unless $self->{_protect};
- my $record = 0x0012; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fLock = $self->{_protect}; # Worksheet is protected
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fLock);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_obj_protect()
- #
- # Set the Biff OBJPROTECT record to indicate that objects are protected.
- #
- sub _store_obj_protect {
- my $self = shift;
- # Exit unless sheet protection has been specified
- return unless $self->{_protect};
- my $record = 0x0063; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $fLock = $self->{_protect}; # Worksheet is protected
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $fLock);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _store_password()
- #
- # Write the worksheet PASSWORD record.
- #
- sub _store_password {
- my $self = shift;
- # Exit unless sheet protection and password have been specified
- return unless $self->{_protect} and defined $self->{_password};
- my $record = 0x0013; # Record identifier
- my $length = 0x0002; # Bytes to follow
- my $wPassword = $self->{_password}; # Encoded password
- my $header = pack("vv", $record, $length);
- my $data = pack("v", $wPassword);
- $self->_prepend($header, $data);
- }
- #
- # Note about compatibility mode.
- #
- # Excel doesn't require every possible Biff record to be present in a file.
- # In particular if the indexing records INDEX, ROW and DBCELL aren't present
- # it just ignores the fact and reads the cells anyway. This is also true of
- # the EXTSST record. Gnumeric and OOo also take this approach. This allows
- # WriteExcel to ignore these records in order to minimise the amount of data
- # stored in memory. However, other third party applications that read Excel
- # files often expect these records to be present. In "compatibility mode"
- # WriteExcel writes these records and tries to be as close to an Excel
- # generated file as possible.
- #
- # This requires additional data to be stored in memory until the file is
- # about to be written. This incurs a memory and speed penalty and may not be
- # suitable for very large files.
- #
- ###############################################################################
- #
- # _store_table()
- #
- # Write cell data stored in the worksheet row/col table.
- #
- # This is only used when compatibity_mode() is in operation.
- #
- # This method writes ROW data, then cell data (NUMBER, LABELSST, etc) and then
- # DBCELL records in blocks of 32 rows. This is explained in detail (for a
- # change) in the Excel SDK and in the OOo Excel file format doc.
- #
- sub _store_table {
- my $self = shift;
- return unless $self->{_compatibility};
- # Offset from the DBCELL record back to the first ROW of the 32 row block.
- my $row_offset = 0;
- # Track rows that have cell data or modified by set_row().
- my @written_rows;
- # Write the ROW records with updated max/min col fields.
- #
- for my $row (0 .. $self->{_dim_rowmax} -1) {
- # Skip unless there is cell data in row or the row has been modified.
- next unless $self->{_table}->[$row] or $self->{_row_data}->{$row};
- # Store the rows with data.
- push @written_rows, $row;
- # Increase the row offset by the length of a ROW record;
- $row_offset += 20;
- # The max/min cols in the ROW records are the same as in DIMENSIONS.
- my $col_min = $self->{_dim_colmin};
- my $col_max = $self->{_dim_colmax};
- # Write a user specified ROW record (modified by set_row()).
- if ($self->{_row_data}->{$row}) {
- # Rewrite the min and max cols for user defined row record.
- my $packed_row = $self->{_row_data}->{$row};
- substr $packed_row, 6, 4, pack('vv', $col_min, $col_max);
- $self->_append($packed_row);
- }
- else {
- # Write a default Row record if there isn't a user defined ROW.
- $self->_write_row_default($row, $col_min, $col_max);
- }
- # If 32 rows have been written or we are at the last row in the
- # worksheet then write the cell data and the DBCELL record.
- #
- if (@written_rows == 32 or $row == $self->{_dim_rowmax} -1) {
- # Offsets to the first cell of each row.
- my @cell_offsets;
- push @cell_offsets, $row_offset - 20;
- # Write the cell data in each row and sum their lengths for the
- # cell offsets.
- #
- for my $row (@written_rows) {
- my $cell_offset = 0;
- for my $col (@{$self->{_table}->[$row]}) {
- next unless $col;
- $self->_append($col);
- my $length = length $col;
- $row_offset += $length;
- $cell_offset += $length;
- }
- push @cell_offsets, $cell_offset;
- }
- # The last offset isn't required.
- pop @cell_offsets;
- # Stores the DBCELL offset for use in the INDEX record.
- push @{$self->{_db_indices}}, $self->{_datasize};
- # Write the DBCELL record.
- $self->_store_dbcell($row_offset, @cell_offsets);
- # Clear the variable for the next block of rows.
- @written_rows = ();
- @cell_offsets = ();
- $row_offset = 0;
- }
- }
- }
- ###############################################################################
- #
- # _store_dbcell()
- #
- # Store the DBCELL record using the offset calculated in _store_table().
- #
- # This is only used when compatibity_mode() is in operation.
- #
- sub _store_dbcell {
- my $self = shift;
- my $row_offset = shift;
- my @cell_offsets = @_;
- my $record = 0x00D7; # Record identifier
- my $length = 4 + 2 * @cell_offsets; # Bytes to follow
- my $header = pack 'vv', $record, $length;
- my $data = pack 'V', $row_offset;
- $data .= pack 'v', $_ for @cell_offsets;
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_index()
- #
- # Store the INDEX record using the DBCELL offsets calculated in _store_table().
- #
- # This is only used when compatibity_mode() is in operation.
- #
- sub _store_index {
- my $self = shift;
- return unless $self->{_compatibility};
- my @indices = @{$self->{_db_indices}};
- my $reserved = 0x00000000;
- my $row_min = $self->{_dim_rowmin};
- my $row_max = $self->{_dim_rowmax};
- my $record = 0x020B; # Record identifier
- my $length = 16 + 4 * @indices; # Bytes to follow
- my $header = pack 'vv', $record, $length;
- my $data = pack 'VVVV', $reserved,
- $row_min,
- $row_max,
- $reserved;
- for my $index (@indices) {
- $data .= pack 'V', $index + $self->{_offset} + 20 + $length +4;
- }
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # insert_chart($row, $col, $chart, $x, $y, $scale_x, $scale_y)
- #
- # Insert a chart into a worksheet. The $chart argument should be a Chart
- # object or else it is assumed to be a filename of an external binary file.
- # The latter is for backwards compatibility.
- #
- sub insert_chart {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- my $row = $_[0];
- my $col = $_[1];
- my $chart = $_[2];
- my $x_offset = $_[3] || 0;
- my $y_offset = $_[4] || 0;
- my $scale_x = $_[5] || 1;
- my $scale_y = $_[6] || 1;
- croak "Insufficient arguments in insert_chart()" unless @_ >= 3;
- if ( ref $chart ) {
- # Check for a Chart object.
- croak "Not a Chart object in insert_chart()"
- unless $chart->isa( 'Spreadsheet::WriteExcel::Chart' );
- # Check that the chart is an embedded style chart.
- croak "Not a embedded style Chart object in insert_chart()"
- unless $chart->{_embedded};
- }
- else {
- # Assume an external bin filename.
- croak "Couldn't locate $chart in insert_chart(): $!" unless -e $chart;
- }
- $self->{_charts}->{$row}->{$col} = [
- $row,
- $col,
- $chart,
- $x_offset,
- $y_offset,
- $scale_x,
- $scale_y,
- ];
- }
- # Older method name for backwards compatibility.
- *embed_chart = *insert_chart;
- ###############################################################################
- #
- # insert_image($row, $col, $filename, $x, $y, $scale_x, $scale_y)
- #
- # Insert an image into the worksheet.
- #
- sub insert_image {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- my $row = $_[0];
- my $col = $_[1];
- my $image = $_[2];
- my $x_offset = $_[3] || 0;
- my $y_offset = $_[4] || 0;
- my $scale_x = $_[5] || 1;
- my $scale_y = $_[6] || 1;
- croak "Insufficient arguments in insert_image()" unless @_ >= 3;
- croak "Couldn't locate $image: $!" unless -e $image;
- $self->{_images}->{$row}->{$col} = [
- $row,
- $col,
- $image,
- $x_offset,
- $y_offset,
- $scale_x,
- $scale_y,
- ];
- }
- # Older method name for backwards compatibility.
- *insert_bitmap = *insert_image;
- ###############################################################################
- #
- # _position_object()
- #
- # Calculate the vertices that define the position of a graphical object within
- # the worksheet.
- #
- # +------------+------------+
- # | A | B |
- # +-----+------------+------------+
- # | |(x1,y1) | |
- # | 1 |(A1)._______|______ |
- # | | | | |
- # | | | | |
- # +-----+----| BITMAP |-----+
- # | | | | |
- # | 2 | |______________. |
- # | | | (B2)|
- # | | | (x2,y2)|
- # +---- +------------+------------+
- #
- # Example of a bitmap that covers some of the area from cell A1 to cell B2.
- #
- # Based on the width and height of the bitmap we need to calculate 8 vars:
- # $col_start, $row_start, $col_end, $row_end, $x1, $y1, $x2, $y2.
- # The width and height of the cells are also variable and have to be taken into
- # account.
- # The values of $col_start and $row_start are passed in from the calling
- # function. The values of $col_end and $row_end are calculated by subtracting
- # the width and height of the bitmap from the width and height of the
- # underlying cells.
- # The vertices are expressed as a percentage of the underlying cell width as
- # follows (rhs values are in pixels):
- #
- # x1 = X / W *1024
- # y1 = Y / H *256
- # x2 = (X-1) / W *1024
- # y2 = (Y-1) / H *256
- #
- # Where: X is distance from the left side of the underlying cell
- # Y is distance from the top of the underlying cell
- # W is the width of the cell
- # H is the height of the cell
- #
- # Note: the SDK incorrectly states that the height should be expressed as a
- # percentage of 1024.
- #
- sub _position_object {
- my $self = shift;
- my $col_start; # Col containing upper left corner of object
- my $x1; # Distance to left side of object
- my $row_start; # Row containing top left corner of object
- my $y1; # Distance to top of object
- my $col_end; # Col containing lower right corner of object
- my $x2; # Distance to right side of object
- my $row_end; # Row containing bottom right corner of object
- my $y2; # Distance to bottom of object
- my $width; # Width of image frame
- my $height; # Height of image frame
- ($col_start, $row_start, $x1, $y1, $width, $height) = @_;
- # Adjust start column for offsets that are greater than the col width
- while ($x1 >= $self->_size_col($col_start)) {
- $x1 -= $self->_size_col($col_start);
- $col_start++;
- }
- # Adjust start row for offsets that are greater than the row height
- while ($y1 >= $self->_size_row($row_start)) {
- $y1 -= $self->_size_row($row_start);
- $row_start++;
- }
- # Initialise end cell to the same as the start cell
- $col_end = $col_start;
- $row_end = $row_start;
- $width = $width + $x1;
- $height = $height + $y1;
- # Subtract the underlying cell widths to find the end cell of the image
- while ($width >= $self->_size_col($col_end)) {
- $width -= $self->_size_col($col_end);
- $col_end++;
- }
- # Subtract the underlying cell heights to find the end cell of the image
- while ($height >= $self->_size_row($row_end)) {
- $height -= $self->_size_row($row_end);
- $row_end++;
- }
- # Bitmap isn't allowed to start or finish in a hidden cell, i.e. a cell
- # with zero eight or width.
- #
- return if $self->_size_col($col_start) == 0;
- return if $self->_size_col($col_end) == 0;
- return if $self->_size_row($row_start) == 0;
- return if $self->_size_row($row_end) == 0;
- # Convert the pixel values to the percentage value expected by Excel
- $x1 = $x1 / $self->_size_col($col_start) * 1024;
- $y1 = $y1 / $self->_size_row($row_start) * 256;
- $x2 = $width / $self->_size_col($col_end) * 1024;
- $y2 = $height / $self->_size_row($row_end) * 256;
- # Simulate ceil() without calling POSIX::ceil().
- $x1 = int($x1 +0.5);
- $y1 = int($y1 +0.5);
- $x2 = int($x2 +0.5);
- $y2 = int($y2 +0.5);
- return( $col_start, $x1,
- $row_start, $y1,
- $col_end, $x2,
- $row_end, $y2
- );
- }
- ###############################################################################
- #
- # _size_col($col)
- #
- # Convert the width of a cell from user's units to pixels. Excel rounds the
- # column width to the nearest pixel. If the width hasn't been set by the user
- # we use the default value. If the column is hidden we use a value of zero.
- #
- sub _size_col {
- my $self = shift;
- my $col = $_[0];
- # Look up the cell value to see if it has been changed
- if (exists $self->{_col_sizes}->{$col}) {
- my $width = $self->{_col_sizes}->{$col};
- # The relationship is different for user units less than 1.
- if ($width < 1) {
- return int($width *12);
- }
- else {
- return int($width *7 ) +5;
- }
- }
- else {
- return 64;
- }
- }
- ###############################################################################
- #
- # _size_row($row)
- #
- # Convert the height of a cell from user's units to pixels. By interpolation
- # the relationship is: y = 4/3x. If the height hasn't been set by the user we
- # use the default value. If the row is hidden we use a value of zero. (Not
- # possible to hide row yet).
- #
- sub _size_row {
- my $self = shift;
- my $row = $_[0];
- # Look up the cell value to see if it has been changed
- if (exists $self->{_row_sizes}->{$row}) {
- if ($self->{_row_sizes}->{$row} == 0) {
- return 0;
- }
- else {
- return int (4/3 * $self->{_row_sizes}->{$row});
- }
- }
- else {
- return 17;
- }
- }
- ###############################################################################
- #
- # _store_zoom($zoom)
- #
- #
- # Store the window zoom factor. This should be a reduced fraction but for
- # simplicity we will store all fractions with a numerator of 100.
- #
- sub _store_zoom {
- my $self = shift;
- # If scale is 100 we don't need to write a record
- return if $self->{_zoom} == 100;
- my $record = 0x00A0; # Record identifier
- my $length = 0x0004; # Bytes to follow
- my $header = pack("vv", $record, $length );
- my $data = pack("vv", $self->{_zoom}, 100);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # write_utf16be_string($row, $col, $string, $format)
- #
- # Write a Unicode string to the specified row and column (zero indexed).
- # $format is optional.
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : long string truncated to 255 chars
- #
- sub write_utf16be_string {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $record = 0x00FD; # Record identifier
- my $length = 0x000A; # Bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $strlen = length($_[2]);
- my $str = $_[2];
- my $xf = _XF($self, $row, $col, $_[3]); # The cell format
- my $encoding = 0x1;
- my $str_error = 0;
- # Check that row and col are valid and store max and min values
- return -2 if $self->_check_dimensions($row, $col);
- # Limit the utf16 string to the max number of chars (not bytes).
- if ($strlen > 32767* 2) {
- $str = substr($str, 0, 32767*2);
- $str_error = -3;
- }
- my $num_bytes = length $str;
- my $num_chars = int($num_bytes / 2);
- # Check for a valid 2-byte char string.
- croak "Uneven number of bytes in Unicode string" if $num_bytes % 2;
- # Change from UTF16 big-endian to little endian
- $str = pack "v*", unpack "n*", $str;
- # Add the encoding and length header to the string.
- my $str_header = pack("vC", $num_chars, $encoding);
- $str = $str_header . $str;
- if (not exists ${$self->{_str_table}}->{$str}) {
- ${$self->{_str_table}}->{$str} = ${$self->{_str_unique}}++;
- }
- ${$self->{_str_total}}++;
- my $header = pack("vv", $record, $length);
- my $data = pack("vvvV", $row, $col, $xf, ${$self->{_str_table}}->{$str});
- # Store the data or write immediately depending on the compatibility mode.
- if ($self->{_compatibility}) {
- $self->{_table}->[$row]->[$col] = $header . $data;
- }
- else {
- $self->_append($header, $data);
- }
- return $str_error;
- }
- ###############################################################################
- #
- # write_utf16le_string($row, $col, $string, $format)
- #
- # Write a UTF-16LE string to the specified row and column (zero indexed).
- # $format is optional.
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : long string truncated to 255 chars
- #
- sub write_utf16le_string {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- if (@_ < 3) { return -1 } # Check the number of args
- my $record = 0x00FD; # Record identifier
- my $length = 0x000A; # Bytes to follow
- my $row = $_[0]; # Zero indexed row
- my $col = $_[1]; # Zero indexed column
- my $str = $_[2];
- my $format = $_[3]; # The cell format
- # Change from UTF16 big-endian to little endian
- $str = pack "v*", unpack "n*", $str;
- return $self->write_utf16be_string($row, $col, $str, $format);
- }
- # Older method name for backwards compatibility.
- *write_unicode = *write_utf16be_string;
- *write_unicode_le = *write_utf16le_string;
- ###############################################################################
- #
- # _store_autofilters()
- #
- # Function to iterate through the columns that form part of an autofilter
- # range and write Biff AUTOFILTER records if a filter expression has been set.
- #
- sub _store_autofilters {
- my $self = shift;
- # Skip all columns if no filter have been set.
- return unless $self->{_filter_on};
- my (undef, undef, $col1, $col2) = @{$self->{_filter_area}};
- for my $i ($col1 .. $col2) {
- # Reverse order since records are being pre-pended.
- my $col = $col2 -$i;
- # Skip if column doesn't have an active filter.
- next unless $self->{_filter_cols}->{$col};
- # Retrieve the filter tokens and write the autofilter records.
- my @tokens = @{$self->{_filter_cols}->{$col}};
- $self->_store_autofilter($col, @tokens);
- }
- }
- ###############################################################################
- #
- # _store_autofilter()
- #
- # Function to write worksheet AUTOFILTER records. These contain 2 Biff Doper
- # structures to represent the 2 possible filter conditions.
- #
- sub _store_autofilter {
- my $self = shift;
- my $record = 0x009E;
- my $length = 0x0000;
- my $index = $_[0];
- my $operator_1 = $_[1];
- my $token_1 = $_[2];
- my $join = $_[3]; # And/Or
- my $operator_2 = $_[4];
- my $token_2 = $_[5];
- my $top10_active = 0;
- my $top10_direction = 0;
- my $top10_percent = 0;
- my $top10_value = 101;
- my $grbit = $join;
- my $optimised_1 = 0;
- my $optimised_2 = 0;
- my $doper_1 = '';
- my $doper_2 = '';
- my $string_1 = '';
- my $string_2 = '';
- # Excel used an optimisation in the case of a simple equality.
- $optimised_1 = 1 if $operator_1 == 2;
- $optimised_2 = 1 if defined $operator_2 and $operator_2 == 2;
- # Convert non-simple equalities back to type 2. See _parse_filter_tokens().
- $operator_1 = 2 if $operator_1 == 22;
- $operator_2 = 2 if defined $operator_2 and $operator_2 == 22;
- # Handle a "Top" style expression.
- if ($operator_1 >= 30) {
- # Remove the second expression if present.
- $operator_2 = undef;
- $token_2 = undef;
- # Set the active flag.
- $top10_active = 1;
- if ($operator_1 == 30 or $operator_1 == 31) {
- $top10_direction = 1;
- }
- if ($operator_1 == 31 or $operator_1 == 33) {
- $top10_percent = 1;
- }
- if ($top10_direction == 1) {
- $operator_1 = 6
- }
- else {
- $operator_1 = 3
- }
- $top10_value = $token_1;
- $token_1 = 0;
- }
- $grbit |= $optimised_1 << 2;
- $grbit |= $optimised_2 << 3;
- $grbit |= $top10_active << 4;
- $grbit |= $top10_direction << 5;
- $grbit |= $top10_percent << 6;
- $grbit |= $top10_value << 7;
- ($doper_1, $string_1) = $self->_pack_doper($operator_1, $token_1);
- ($doper_2, $string_2) = $self->_pack_doper($operator_2, $token_2);
- my $data = pack 'v', $index;
- $data .= pack 'v', $grbit;
- $data .= $doper_1;
- $data .= $doper_2;
- $data .= $string_1;
- $data .= $string_2;
- $length = length $data;
- my $header = pack('vv', $record, $length);
- $self->_prepend($header, $data);
- }
- ###############################################################################
- #
- # _pack_doper()
- #
- # Create a Biff Doper structure that represents a filter expression. Depending
- # on the type of the token we pack an Empty, String or Number doper.
- #
- sub _pack_doper {
- my $self = shift;
- my $operator = $_[0];
- my $token = $_[1];
- my $doper = '';
- my $string = '';
- # Return default doper for non-defined filters.
- if (not defined $operator) {
- return ($self->_pack_unused_doper, $string);
- }
- if ($token =~ /^blanks|nonblanks$/i) {
- $doper = $self->_pack_blanks_doper($operator, $token);
- }
- elsif ($operator == 2 or
- $token !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
- {
- # Excel treats all tokens as strings if the operator is equality, =.
- $string = $token;
- my $encoding = 0;
- my $length = length $string;
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16BE", $string);
- $encoding = 1;
- }
- }
- $string = pack('C', $encoding) . $string;
- $doper = $self->_pack_string_doper($operator, $length);
- }
- else {
- $string = '';
- $doper = $self->_pack_number_doper($operator, $token);
- }
- return ($doper, $string);
- }
- ###############################################################################
- #
- # _pack_unused_doper()
- #
- # Pack an empty Doper structure.
- #
- sub _pack_unused_doper {
- my $self = shift;
- return pack 'C10', (0x0) x 10;
- }
- ###############################################################################
- #
- # _pack_blanks_doper()
- #
- # Pack an Blanks/NonBlanks Doper structure.
- #
- sub _pack_blanks_doper {
- my $self = shift;
- my $operator = $_[0];
- my $token = $_[1];
- my $type;
- if ($token eq 'blanks') {
- $type = 0x0C;
- $operator = 2;
- }
- else {
- $type = 0x0E;
- $operator = 5;
- }
- my $doper = pack 'CCVV', $type, # Data type
- $operator, #
- 0x0000, # Reserved
- 0x0000; # Reserved
- return $doper;
- }
- ###############################################################################
- #
- # _pack_string_doper()
- #
- # Pack an string Doper structure.
- #
- sub _pack_string_doper {
- my $self = shift;
- my $operator = $_[0];
- my $length = $_[1];
- my $doper = pack 'CCVCCCC', 0x06, # Data type
- $operator, #
- 0x0000, # Reserved
- $length, # String char length.
- 0x0, 0x0, 0x0; # Reserved
- return $doper;
- }
- ###############################################################################
- #
- # _pack_number_doper()
- #
- # Pack an IEEE double number Doper structure.
- #
- sub _pack_number_doper {
- my $self = shift;
- my $operator = $_[0];
- my $number = $_[1];
- $number = pack 'd', $number;
- $number = reverse $number if $self->{_byte_order};
- my $doper = pack 'CC', 0x04, $operator;
- $doper .= $number;
- return $doper;
- }
- #
- # Methods related to comments and MSO objects.
- #
- ###############################################################################
- #
- # _prepare_images()
- #
- # Turn the HoH that stores the images into an array for easier handling.
- #
- sub _prepare_images {
- my $self = shift;
- my $count = 0;
- my @images;
- # We sort the images by row and column but that isn't strictly required.
- #
- my @rows = sort {$a <=> $b} keys %{$self->{_images}};
- for my $row (@rows) {
- my @cols = sort {$a <=> $b} keys %{$self->{_images}->{$row}};
- for my $col (@cols) {
- push @images, $self->{_images}->{$row}->{$col};
- $count++;
- }
- }
- $self->{_images} = {};
- $self->{_images_array} = \@images;
- return $count;
- }
- ###############################################################################
- #
- # _prepare_comments()
- #
- # Turn the HoH that stores the comments into an array for easier handling.
- #
- sub _prepare_comments {
- my $self = shift;
- my $count = 0;
- my @comments;
- # We sort the comments by row and column but that isn't strictly required.
- #
- my @rows = sort {$a <=> $b} keys %{$self->{_comments}};
- for my $row (@rows) {
- my @cols = sort {$a <=> $b} keys %{$self->{_comments}->{$row}};
- for my $col (@cols) {
- push @comments, $self->{_comments}->{$row}->{$col};
- $count++;
- }
- }
- $self->{_comments} = {};
- $self->{_comments_array} = \@comments;
- return $count;
- }
- ###############################################################################
- #
- # _prepare_charts()
- #
- # Turn the HoH that stores the charts into an array for easier handling.
- #
- sub _prepare_charts {
- my $self = shift;
- my $count = 0;
- my @charts;
- # We sort the charts by row and column but that isn't strictly required.
- #
- my @rows = sort {$a <=> $b} keys %{$self->{_charts}};
- for my $row (@rows) {
- my @cols = sort {$a <=> $b} keys %{$self->{_charts}->{$row}};
- for my $col (@cols) {
- push @charts, $self->{_charts}->{$row}->{$col};
- $count++;
- }
- }
- $self->{_charts} = {};
- $self->{_charts_array} = \@charts;
- return $count;
- }
- ###############################################################################
- #
- # _store_images()
- #
- # Store the collections of records that make up images.
- #
- sub _store_images {
- my $self = shift;
- my $record = 0x00EC; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my @ids = @{$self->{_object_ids }};
- my $spid = shift @ids;
- my @images = @{$self->{_images_array}};
- my $num_images = scalar @images;
- my $num_filters = $self->{_filter_count};
- my $num_comments = @{$self->{_comments_array}};
- my $num_charts = @{$self->{_charts_array }};
- # Skip this if there aren't any images.
- return unless $num_images;
- for my $i (0 .. $num_images-1) {
- my $row = $images[$i]->[0];
- my $col = $images[$i]->[1];
- my $name = $images[$i]->[2];
- my $x_offset = $images[$i]->[3];
- my $y_offset = $images[$i]->[4];
- my $scale_x = $images[$i]->[5];
- my $scale_y = $images[$i]->[6];
- my $image_id = $images[$i]->[7];
- my $type = $images[$i]->[8];
- my $width = $images[$i]->[9];
- my $height = $images[$i]->[10];
- $width *= $scale_x if $scale_x;
- $height *= $scale_y if $scale_y;
- # Calculate the positions of image object.
- my @vertices = $self->_position_object( $col,
- $row,
- $x_offset,
- $y_offset,
- $width,
- $height
- );
- if ($i == 0) {
- # Write the parent MSODRAWIING record.
- my $dg_length = 156 + 84*($num_images -1);
- my $spgr_length = 132 + 84*($num_images -1);
- $dg_length += 120 *$num_charts;
- $spgr_length += 120 *$num_charts;
- $dg_length += 96 *$num_filters;
- $spgr_length += 96 *$num_filters;
- $dg_length += 128 *$num_comments;
- $spgr_length += 128 *$num_comments;
- my $data = $self->_store_mso_dg_container($dg_length);
- $data .= $self->_store_mso_dg(@ids);
- $data .= $self->_store_mso_spgr_container($spgr_length);
- $data .= $self->_store_mso_sp_container(40);
- $data .= $self->_store_mso_spgr();
- $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
- $data .= $self->_store_mso_sp_container(76);
- $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_image($image_id);
- $data .= $self->_store_mso_client_anchor(2, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- else {
- # Write the child MSODRAWIING record.
- my $data = $self->_store_mso_sp_container(76);
- $data .= $self->_store_mso_sp(75, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_image($image_id);
- $data .= $self->_store_mso_client_anchor(2, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- $self->_store_obj_image($i+1);
- }
- $self->{_object_ids}->[0] = $spid;
- }
- ###############################################################################
- #
- # _store_charts()
- #
- # Store the collections of records that make up charts.
- #
- sub _store_charts {
- my $self = shift;
- my $record = 0x00EC; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my @ids = @{$self->{_object_ids}};
- my $spid = shift @ids;
- my @charts = @{$self->{_charts_array}};
- my $num_charts = scalar @charts;
- my $num_filters = $self->{_filter_count};
- my $num_comments = @{$self->{_comments_array}};
- # Number of objects written so far.
- my $num_objects = @{$self->{_images_array}};
- # Skip this if there aren't any charts.
- return unless $num_charts;
- for my $i (0 .. $num_charts-1 ) {
- my $row = $charts[$i]->[0];
- my $col = $charts[$i]->[1];
- my $chart = $charts[$i]->[2];
- my $x_offset = $charts[$i]->[3];
- my $y_offset = $charts[$i]->[4];
- my $scale_x = $charts[$i]->[5];
- my $scale_y = $charts[$i]->[6];
- my $width = 526;
- my $height = 319;
- $width *= $scale_x if $scale_x;
- $height *= $scale_y if $scale_y;
- # Calculate the positions of chart object.
- my @vertices = $self->_position_object( $col,
- $row,
- $x_offset,
- $y_offset,
- $width,
- $height
- );
- if ($i == 0 and not $num_objects) {
- # Write the parent MSODRAWIING record.
- my $dg_length = 192 + 120*($num_charts -1);
- my $spgr_length = 168 + 120*($num_charts -1);
- $dg_length += 96 *$num_filters;
- $spgr_length += 96 *$num_filters;
- $dg_length += 128 *$num_comments;
- $spgr_length += 128 *$num_comments;
- my $data = $self->_store_mso_dg_container($dg_length);
- $data .= $self->_store_mso_dg(@ids);
- $data .= $self->_store_mso_spgr_container($spgr_length);
- $data .= $self->_store_mso_sp_container(40);
- $data .= $self->_store_mso_spgr();
- $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
- $data .= $self->_store_mso_sp_container(112);
- $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_chart();
- $data .= $self->_store_mso_client_anchor(0, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- else {
- # Write the child MSODRAWIING record.
- my $data = $self->_store_mso_sp_container(112);
- $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_chart();
- $data .= $self->_store_mso_client_anchor(0, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- $self->_store_obj_chart($num_objects+$i+1);
- $self->_store_chart_binary($chart);
- }
- # Simulate the EXTERNSHEET link between the chart and data using a formula
- # such as '=Sheet1!A1'.
- # TODO. Won't work for external data refs. Also should use a more direct
- # method.
- #
- my $formula = "='$self->{_name}'!A1";
- $self->store_formula($formula);
- $self->{_object_ids}->[0] = $spid;
- }
- ###############################################################################
- #
- # _store_chart_binary
- #
- # Add the binary data for a chart. This could either be from a Chart object
- # or from an external binary file (for backwards compatibility).
- #
- sub _store_chart_binary {
- my $self = shift;
- my $chart = $_[0];
- my $tmp;
- if ( ref $chart ) {
- $chart->_close();
- my $tmp = $chart->get_data();
- $self->_append( $tmp );
- }
- else {
- my $filehandle = FileHandle->new( $chart )
- or die "Couldn't open $chart in insert_chart(): $!.\n";
- binmode( $filehandle );
- while ( read( $filehandle, $tmp, 4096 ) ) {
- $self->_append( $tmp );
- }
- }
- }
- ###############################################################################
- #
- # _store_filters()
- #
- # Store the collections of records that make up filters.
- #
- sub _store_filters {
- my $self = shift;
- my $record = 0x00EC; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my @ids = @{$self->{_object_ids}};
- my $spid = shift @ids;
- my $filter_area = $self->{_filter_area};
- my $num_filters = $self->{_filter_count};
- my $num_comments = @{$self->{_comments_array}};
- # Number of objects written so far.
- my $num_objects = @{$self->{_images_array}}
- + @{$self->{_charts_array}};
- # Skip this if there aren't any filters.
- return unless $num_filters;
- my ($row1, $row2, $col1, $col2) = @$filter_area;
- for my $i (0 .. $num_filters-1 ) {
- my @vertices = ( $col1 +$i,
- 0,
- $row1,
- 0,
- $col1 +$i +1,
- 0,
- $row1 +1,
- 0);
- if ($i == 0 and not $num_objects) {
- # Write the parent MSODRAWIING record.
- my $dg_length = 168 + 96*($num_filters -1);
- my $spgr_length = 144 + 96*($num_filters -1);
- $dg_length += 128 *$num_comments;
- $spgr_length += 128 *$num_comments;
- my $data = $self->_store_mso_dg_container($dg_length);
- $data .= $self->_store_mso_dg(@ids);
- $data .= $self->_store_mso_spgr_container($spgr_length);
- $data .= $self->_store_mso_sp_container(40);
- $data .= $self->_store_mso_spgr();
- $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
- $data .= $self->_store_mso_sp_container(88);
- $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_filter();
- $data .= $self->_store_mso_client_anchor(1, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- else {
- # Write the child MSODRAWIING record.
- my $data = $self->_store_mso_sp_container(88);
- $data .= $self->_store_mso_sp(201, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_filter();
- $data .= $self->_store_mso_client_anchor(1, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- $self->_store_obj_filter($num_objects+$i+1, $col1 +$i);
- }
- # Simulate the EXTERNSHEET link between the filter and data using a formula
- # such as '=Sheet1!A1'.
- # TODO. Won't work for external data refs. Also should use a more direct
- # method.
- #
- my $formula = "='$self->{_name}'!A1";
- $self->store_formula($formula);
- $self->{_object_ids}->[0] = $spid;
- }
- ###############################################################################
- #
- # _store_comments()
- #
- # Store the collections of records that make up cell comments.
- #
- # NOTE: We write the comment objects last since that makes it a little easier
- # to write the NOTE records directly after the MSODRAWIING records.
- #
- sub _store_comments {
- my $self = shift;
- my $record = 0x00EC; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my @ids = @{$self->{_object_ids}};
- my $spid = shift @ids;
- my @comments = @{$self->{_comments_array}};
- my $num_comments = scalar @comments;
- # Number of objects written so far.
- my $num_objects = @{$self->{_images_array}}
- + $self->{_filter_count}
- + @{$self->{_charts_array}};
- # Skip this if there aren't any comments.
- return unless $num_comments;
- for my $i (0 .. $num_comments-1) {
- my $row = $comments[$i]->[0];
- my $col = $comments[$i]->[1];
- my $str = $comments[$i]->[2];
- my $encoding = $comments[$i]->[3];
- my $visible = $comments[$i]->[6];
- my $color = $comments[$i]->[7];
- my @vertices = @{$comments[$i]->[8]};
- my $str_len = length $str;
- $str_len /= 2 if $encoding; # Num of chars not bytes.
- my $formats = [[0, 9], [$str_len, 0]];
- if ($i == 0 and not $num_objects) {
- # Write the parent MSODRAWIING record.
- my $dg_length = 200 + 128*($num_comments -1);
- my $spgr_length = 176 + 128*($num_comments -1);
- my $data = $self->_store_mso_dg_container($dg_length);
- $data .= $self->_store_mso_dg(@ids);
- $data .= $self->_store_mso_spgr_container($spgr_length);
- $data .= $self->_store_mso_sp_container(40);
- $data .= $self->_store_mso_spgr();
- $data .= $self->_store_mso_sp(0x0, $spid++, 0x0005);
- $data .= $self->_store_mso_sp_container(120);
- $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
- $data .= $self->_store_mso_client_anchor(3, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- else {
- # Write the child MSODRAWIING record.
- my $data = $self->_store_mso_sp_container(120);
- $data .= $self->_store_mso_sp(202, $spid++, 0x0A00);
- $data .= $self->_store_mso_opt_comment(0x80, $visible, $color);
- $data .= $self->_store_mso_client_anchor(3, @vertices);
- $data .= $self->_store_mso_client_data();
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- $self->_store_obj_comment($num_objects+$i+1);
- $self->_store_mso_drawing_text_box();
- $self->_store_txo($str_len);
- $self->_store_txo_continue_1($str, $encoding);
- $self->_store_txo_continue_2($formats);
- }
- # Write the NOTE records after MSODRAWIING records.
- for my $i (0 .. $num_comments-1) {
- my $row = $comments[$i]->[0];
- my $col = $comments[$i]->[1];
- my $author = $comments[$i]->[4];
- my $author_enc = $comments[$i]->[5];
- my $visible = $comments[$i]->[6];
- $self->_store_note($row, $col, $num_objects+$i+1,
- $author, $author_enc, $visible);
- }
- }
- ###############################################################################
- #
- # _store_mso_dg_container()
- #
- # Write the Escher DgContainer record that is part of MSODRAWING.
- #
- sub _store_mso_dg_container {
- my $self = shift;
- my $type = 0xF002;
- my $version = 15;
- my $instance = 0;
- my $data = '';
- my $length = $_[0];
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_dg()
- #
- # Write the Escher Dg record that is part of MSODRAWING.
- #
- sub _store_mso_dg {
- my $self = shift;
- my $type = 0xF008;
- my $version = 0;
- my $instance = $_[0];
- my $data = '';
- my $length = 8;
- my $num_shapes = $_[1];
- my $max_spid = $_[2];
- $data = pack "VV", $num_shapes, $max_spid;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_spgr_container()
- #
- # Write the Escher SpgrContainer record that is part of MSODRAWING.
- #
- sub _store_mso_spgr_container {
- my $self = shift;
- my $type = 0xF003;
- my $version = 15;
- my $instance = 0;
- my $data = '';
- my $length = $_[0];
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_sp_container()
- #
- # Write the Escher SpContainer record that is part of MSODRAWING.
- #
- sub _store_mso_sp_container {
- my $self = shift;
- my $type = 0xF004;
- my $version = 15;
- my $instance = 0;
- my $data = '';
- my $length = $_[0];
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_spgr()
- #
- # Write the Escher Spgr record that is part of MSODRAWING.
- #
- sub _store_mso_spgr {
- my $self = shift;
- my $type = 0xF009;
- my $version = 1;
- my $instance = 0;
- my $data = pack "VVVV", 0, 0, 0, 0;
- my $length = 16;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_sp()
- #
- # Write the Escher Sp record that is part of MSODRAWING.
- #
- sub _store_mso_sp {
- my $self = shift;
- my $type = 0xF00A;
- my $version = 2;
- my $instance = $_[0];
- my $data = '';
- my $length = 8;
- my $spid = $_[1];
- my $options = $_[2];
- $data = pack "VV", $spid, $options;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_opt_comment()
- #
- # Write the Escher Opt record that is part of MSODRAWING.
- #
- sub _store_mso_opt_comment {
- my $self = shift;
- my $type = 0xF00B;
- my $version = 3;
- my $instance = 9;
- my $data = '';
- my $length = 54;
- my $spid = $_[0];
- my $visible = $_[1];
- my $colour = $_[2] || 0x50;
- # Use the visible flag if set by the user or else use the worksheet value.
- # Note that the value used is the opposite of _store_note().
- #
- if (defined $visible) {
- $visible = $visible ? 0x0000 : 0x0002;
- }
- else {
- $visible = $self->{_comments_visible} ? 0x0000 : 0x0002;
- }
- $data = pack "V", $spid;
- $data .= pack "H*", '0000BF00080008005801000000008101' ;
- $data .= pack "C", $colour;
- $data .= pack "H*", '000008830150000008BF011000110001' .
- '02000000003F0203000300BF03';
- $data .= pack "v", $visible;
- $data .= pack "H*", '0A00';
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_opt_image()
- #
- # Write the Escher Opt record that is part of MSODRAWING.
- #
- sub _store_mso_opt_image {
- my $self = shift;
- my $type = 0xF00B;
- my $version = 3;
- my $instance = 3;
- my $data = '';
- my $length = undef;
- my $spid = $_[0];
- $data = pack 'v', 0x4104; # Blip -> pib
- $data .= pack 'V', $spid;
- $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
- $data .= pack 'V', 0x00010000;
- $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
- $data .= pack 'V', 0x00080000;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_opt_chart()
- #
- # Write the Escher Opt record that is part of MSODRAWING.
- #
- sub _store_mso_opt_chart {
- my $self = shift;
- my $type = 0xF00B;
- my $version = 3;
- my $instance = 9;
- my $data = '';
- my $length = undef;
- $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
- $data .= pack 'V', 0x01040104;
- $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
- $data .= pack 'V', 0x00080008;
- $data .= pack 'v', 0x0181; # Fill Style -> fillColor
- $data .= pack 'V', 0x0800004E ;
- $data .= pack 'v', 0x0183; # Fill Style -> fillBackColor
- $data .= pack 'V', 0x0800004D;
- $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
- $data .= pack 'V', 0x00110010;
- $data .= pack 'v', 0x01C0; # Line Style -> lineColor
- $data .= pack 'V', 0x0800004D;
- $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
- $data .= pack 'V', 0x00080008;
- $data .= pack 'v', 0x023F; # Shadow Style -> fshadowObscured
- $data .= pack 'V', 0x00020000;
- $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
- $data .= pack 'V', 0x00080000;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_opt_filter()
- #
- # Write the Escher Opt record that is part of MSODRAWING.
- #
- sub _store_mso_opt_filter {
- my $self = shift;
- my $type = 0xF00B;
- my $version = 3;
- my $instance = 5;
- my $data = '';
- my $length = undef;
- $data = pack 'v', 0x007F; # Protection -> fLockAgainstGrouping
- $data .= pack 'V', 0x01040104;
- $data .= pack 'v', 0x00BF; # Text -> fFitTextToShape
- $data .= pack 'V', 0x00080008;
- $data .= pack 'v', 0x01BF; # Fill Style -> fNoFillHitTest
- $data .= pack 'V', 0x00010000;
- $data .= pack 'v', 0x01FF; # Line Style -> fNoLineDrawDash
- $data .= pack 'V', 0x00080000;
- $data .= pack 'v', 0x03BF; # Group Shape -> fPrint
- $data .= pack 'V', 0x000A0000;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_client_anchor()
- #
- # Write the Escher ClientAnchor record that is part of MSODRAWING.
- #
- sub _store_mso_client_anchor {
- my $self = shift;
- my $type = 0xF010;
- my $version = 0;
- my $instance = 0;
- my $data = '';
- my $length = 18;
- my $flag = shift;
- my $col_start = $_[0]; # Col containing upper left corner of object
- my $x1 = $_[1]; # Distance to left side of object
- my $row_start = $_[2]; # Row containing top left corner of object
- my $y1 = $_[3]; # Distance to top of object
- my $col_end = $_[4]; # Col containing lower right corner of object
- my $x2 = $_[5]; # Distance to right side of object
- my $row_end = $_[6]; # Row containing bottom right corner of object
- my $y2 = $_[7]; # Distance to bottom of object
- $data = pack "v9", $flag,
- $col_start, $x1,
- $row_start, $y1,
- $col_end, $x2,
- $row_end, $y2;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_mso_client_data()
- #
- # Write the Escher ClientData record that is part of MSODRAWING.
- #
- sub _store_mso_client_data {
- my $self = shift;
- my $type = 0xF011;
- my $version = 0;
- my $instance = 0;
- my $data = '';
- my $length = 0;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_obj_comment()
- #
- # Write the OBJ record that is part of cell comments.
- #
- sub _store_obj_comment {
- my $self = shift;
- my $record = 0x005D; # Record identifier
- my $length = 0x0034; # Bytes to follow
- my $obj_id = $_[0]; # Object ID number.
- my $obj_type = 0x0019; # Object type (comment).
- my $data = ''; # Record data.
- my $sub_record = 0x0000; # Sub-record identifier.
- my $sub_length = 0x0000; # Length of sub-record.
- my $sub_data = ''; # Data of sub-record.
- my $options = 0x4011;
- my $reserved = 0x0000;
- # Add ftCmo (common object data) subobject
- $sub_record = 0x0015; # ftCmo
- $sub_length = 0x0012;
- $sub_data = pack "vvvVVV", $obj_type, $obj_id, $options,
- $reserved, $reserved, $reserved;
- $data = pack("vv", $sub_record, $sub_length);
- $data .= $sub_data;
- # Add ftNts (note structure) subobject
- $sub_record = 0x000D; # ftNts
- $sub_length = 0x0016;
- $sub_data = pack "VVVVVv", ($reserved) x 6;
- $data .= pack("vv", $sub_record, $sub_length);
- $data .= $sub_data;
- # Add ftEnd (end of object) subobject
- $sub_record = 0x0000; # ftNts
- $sub_length = 0x0000;
- $data .= pack("vv", $sub_record, $sub_length);
- # Pack the record.
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_obj_image()
- #
- # Write the OBJ record that is part of image records.
- #
- sub _store_obj_image {
- my $self = shift;
- my $record = 0x005D; # Record identifier
- my $length = 0x0026; # Bytes to follow
- my $obj_id = $_[0]; # Object ID number.
- my $obj_type = 0x0008; # Object type (Picture).
- my $data = ''; # Record data.
- my $sub_record = 0x0000; # Sub-record identifier.
- my $sub_length = 0x0000; # Length of sub-record.
- my $sub_data = ''; # Data of sub-record.
- my $options = 0x6011;
- my $reserved = 0x0000;
- # Add ftCmo (common object data) subobject
- $sub_record = 0x0015; # ftCmo
- $sub_length = 0x0012;
- $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
- $reserved, $reserved, $reserved;
- $data = pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftCf (Clipboard format) subobject
- $sub_record = 0x0007; # ftCf
- $sub_length = 0x0002;
- $sub_data = pack 'v', 0xFFFF;
- $data .= pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftPioGrbit (Picture option flags) subobject
- $sub_record = 0x0008; # ftPioGrbit
- $sub_length = 0x0002;
- $sub_data = pack 'v', 0x0001;
- $data .= pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftEnd (end of object) subobject
- $sub_record = 0x0000; # ftNts
- $sub_length = 0x0000;
- $data .= pack 'vv', $sub_record, $sub_length;
- # Pack the record.
- my $header = pack('vv', $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_obj_chart()
- #
- # Write the OBJ record that is part of chart records.
- #
- sub _store_obj_chart {
- my $self = shift;
- my $record = 0x005D; # Record identifier
- my $length = 0x001A; # Bytes to follow
- my $obj_id = $_[0]; # Object ID number.
- my $obj_type = 0x0005; # Object type (chart).
- my $data = ''; # Record data.
- my $sub_record = 0x0000; # Sub-record identifier.
- my $sub_length = 0x0000; # Length of sub-record.
- my $sub_data = ''; # Data of sub-record.
- my $options = 0x6011;
- my $reserved = 0x0000;
- # Add ftCmo (common object data) subobject
- $sub_record = 0x0015; # ftCmo
- $sub_length = 0x0012;
- $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
- $reserved, $reserved, $reserved;
- $data = pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftEnd (end of object) subobject
- $sub_record = 0x0000; # ftNts
- $sub_length = 0x0000;
- $data .= pack 'vv', $sub_record, $sub_length;
- # Pack the record.
- my $header = pack('vv', $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_obj_filter()
- #
- # Write the OBJ record that is part of filter records.
- #
- sub _store_obj_filter {
- my $self = shift;
- my $record = 0x005D; # Record identifier
- my $length = 0x0046; # Bytes to follow
- my $obj_id = $_[0]; # Object ID number.
- my $obj_type = 0x0014; # Object type (combo box).
- my $data = ''; # Record data.
- my $sub_record = 0x0000; # Sub-record identifier.
- my $sub_length = 0x0000; # Length of sub-record.
- my $sub_data = ''; # Data of sub-record.
- my $options = 0x2101;
- my $reserved = 0x0000;
- # Add ftCmo (common object data) subobject
- $sub_record = 0x0015; # ftCmo
- $sub_length = 0x0012;
- $sub_data = pack 'vvvVVV', $obj_type, $obj_id, $options,
- $reserved, $reserved, $reserved;
- $data = pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftSbs Scroll bar subobject
- $sub_record = 0x000C; # ftSbs
- $sub_length = 0x0014;
- $sub_data = pack 'H*', '0000000000000000640001000A00000010000100';
- $data .= pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftLbsData (List box data) subobject
- $sub_record = 0x0013; # ftLbsData
- $sub_length = 0x1FEE; # Special case (undocumented).
- # If the filter is active we set one of the undocumented flags.
- my $col = $_[1];
- if ($self->{_filter_cols}->{$col}) {
- $sub_data = pack 'H*', '000000000100010300000A0008005700';
- }
- else {
- $sub_data = pack 'H*', '00000000010001030000020008005700';
- }
- $data .= pack 'vv', $sub_record, $sub_length;
- $data .= $sub_data;
- # Add ftEnd (end of object) subobject
- $sub_record = 0x0000; # ftNts
- $sub_length = 0x0000;
- $data .= pack 'vv', $sub_record, $sub_length;
- # Pack the record.
- my $header = pack('vv', $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_mso_drawing_text_box()
- #
- # Write the MSODRAWING ClientTextbox record that is part of comments.
- #
- sub _store_mso_drawing_text_box {
- my $self = shift;
- my $record = 0x00EC; # Record identifier
- my $length = 0x0008; # Bytes to follow
- my $data = $self->_store_mso_client_text_box();
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_mso_client_text_box()
- #
- # Write the Escher ClientTextbox record that is part of MSODRAWING.
- #
- sub _store_mso_client_text_box {
- my $self = shift;
- my $type = 0xF00D;
- my $version = 0;
- my $instance = 0;
- my $data = '';
- my $length = 0;
- return $self->_add_mso_generic($type, $version, $instance, $data, $length);
- }
- ###############################################################################
- #
- # _store_txo()
- #
- # Write the worksheet TXO record that is part of cell comments.
- #
- sub _store_txo {
- my $self = shift;
- my $record = 0x01B6; # Record identifier
- my $length = 0x0012; # Bytes to follow
- my $string_len = $_[0]; # Length of the note text.
- my $format_len = $_[1] || 16; # Length of the format runs.
- my $rotation = $_[2] || 0; # Options
- my $grbit = 0x0212; # Options
- my $reserved = 0x0000; # Options
- # Pack the record.
- my $header = pack("vv", $record, $length);
- my $data = pack("vvVvvvV", $grbit, $rotation, $reserved, $reserved,
- $string_len, $format_len, $reserved);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_txo_continue_1()
- #
- # Write the first CONTINUE record to follow the TXO record. It contains the
- # text data.
- #
- sub _store_txo_continue_1 {
- my $self = shift;
- my $record = 0x003C; # Record identifier
- my $string = $_[0]; # Comment string.
- my $encoding = $_[1] || 0; # Encoding of the string.
- # Split long comment strings into smaller continue blocks if necessary.
- # We can't let BIFFwriter::_add_continue() handled this since an extra
- # encoding byte has to be added similar to the SST block.
- #
- # We make the limit size smaller than the _add_continue() size and even
- # so that UTF16 chars occur in the same block.
- #
- my $limit = 8218;
- while (length($string) > $limit) {
- my $tmp_str = substr($string, 0, $limit, "");
- my $data = pack("C", $encoding) . $tmp_str;
- my $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- # Pack the record.
- my $data = pack("C", $encoding) . $string;
- my $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_txo_continue_2()
- #
- # Write the second CONTINUE record to follow the TXO record. It contains the
- # formatting information for the string.
- #
- sub _store_txo_continue_2 {
- my $self = shift;
- my $record = 0x003C; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my $formats = $_[0]; # Formatting information
- # Pack the record.
- my $data = '';
- for my $a_ref (@$formats) {
- $data .= pack "vvV", $a_ref->[0], $a_ref->[1], 0x0;
- }
- $length = length $data;
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_note()
- #
- # Write the worksheet NOTE record that is part of cell comments.
- #
- sub _store_note {
- my $self = shift;
- my $record = 0x001C; # Record identifier
- my $length = 0x000C; # Bytes to follow
- my $row = $_[0];
- my $col = $_[1];
- my $obj_id = $_[2];
- my $author = $_[3] || $self->{_comments_author};
- my $author_enc = $_[4] || $self->{_comments_author_enc};
- my $visible = $_[5];
- # Use the visible flag if set by the user or else use the worksheet value.
- # The flag is also set in _store_mso_opt_comment() but with the opposite
- # value.
- if (defined $visible) {
- $visible = $visible ? 0x0002 : 0x0000;
- }
- else {
- $visible = $self->{_comments_visible} ? 0x0002 : 0x0000;
- }
- # Get the number of chars in the author string (not bytes).
- my $num_chars = length $author;
- $num_chars /= 2 if $author_enc;
- # Null terminate the author string.
- $author .= "\0";
- # Pack the record.
- my $data = pack("vvvvvC", $row, $col, $visible, $obj_id,
- $num_chars, $author_enc);
- $length = length($data) + length($author);
- my $header = pack("vv", $record, $length);
- $self->_append($header, $data, $author);
- }
- ###############################################################################
- #
- # _comment_params()
- #
- # This method handles the additional optional parameters to write_comment() as
- # well as calculating the comment object position and vertices.
- #
- sub _comment_params {
- my $self = shift;
- my $row = shift;
- my $col = shift;
- my $string = shift;
- my $default_width = 128;
- my $default_height = 74;
- my %params = (
- author => '',
- author_encoding => 0,
- encoding => 0,
- color => undef,
- start_cell => undef,
- start_col => undef,
- start_row => undef,
- visible => undef,
- width => $default_width,
- height => $default_height,
- x_offset => undef,
- x_scale => 1,
- y_offset => undef,
- y_scale => 1,
- );
- # Overwrite the defaults with any user supplied values. Incorrect or
- # misspelled parameters are silently ignored.
- %params = (%params, @_);
- # Ensure that a width and height have been set.
- $params{width} = $default_width if not $params{width};
- $params{height} = $default_height if not $params{height};
- # Check that utf16 strings have an even number of bytes.
- if ($params{encoding}) {
- croak "Uneven number of bytes in comment string"
- if length($string) % 2;
- # Change from UTF-16BE to UTF-16LE
- $string = pack 'v*', unpack 'n*', $string;
- }
- if ($params{author_encoding}) {
- croak "Uneven number of bytes in author string"
- if length($params{author}) % 2;
- # Change from UTF-16BE to UTF-16LE
- $params{author} = pack 'v*', unpack 'n*', $params{author};
- }
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16LE", $string);
- $params{encoding} = 1;
- }
- if (Encode::is_utf8($params{author})) {
- $params{author} = Encode::encode("UTF-16LE", $params{author});
- $params{author_encoding} = 1;
- }
- }
- # Limit the string to the max number of chars (not bytes).
- my $max_len = 32767;
- $max_len *= 2 if $params{encoding};
- if (length($string) > $max_len) {
- $string = substr($string, 0, $max_len);
- }
- # Set the comment background colour.
- my $color = $params{color};
- $color = &Spreadsheet::WriteExcel::Format::_get_color($color);
- $color = 0x50 if $color == 0x7FFF; # Default color.
- $params{color} = $color;
- # Convert a cell reference to a row and column.
- if (defined $params{start_cell}) {
- my ($row, $col) = $self->_substitute_cellref($params{start_cell});
- $params{start_row} = $row;
- $params{start_col} = $col;
- }
- # Set the default start cell and offsets for the comment. These are
- # generally fixed in relation to the parent cell. However there are
- # some edge cases for cells at the, er, edges.
- #
- if (not defined $params{start_row}) {
- if ($row == 0 ) {$params{start_row} = 0 }
- elsif ($row == 65533) {$params{start_row} = 65529 }
- elsif ($row == 65534) {$params{start_row} = 65530 }
- elsif ($row == 65535) {$params{start_row} = 65531 }
- else {$params{start_row} = $row -1}
- }
- if (not defined $params{y_offset}) {
- if ($row == 0 ) {$params{y_offset} = 2 }
- elsif ($row == 65533) {$params{y_offset} = 4 }
- elsif ($row == 65534) {$params{y_offset} = 4 }
- elsif ($row == 65535) {$params{y_offset} = 2 }
- else {$params{y_offset} = 7 }
- }
- if (not defined $params{start_col}) {
- if ($col == 253 ) {$params{start_col} = 250 }
- elsif ($col == 254 ) {$params{start_col} = 251 }
- elsif ($col == 255 ) {$params{start_col} = 252 }
- else {$params{start_col} = $col +1}
- }
- if (not defined $params{x_offset}) {
- if ($col == 253 ) {$params{x_offset} = 49 }
- elsif ($col == 254 ) {$params{x_offset} = 49 }
- elsif ($col == 255 ) {$params{x_offset} = 49 }
- else {$params{x_offset} = 15 }
- }
- # Scale the size of the comment box if required.
- if ($params{x_scale}) {
- $params{width} = $params{width} * $params{x_scale};
- }
- if ($params{y_scale}) {
- $params{height} = $params{height} * $params{y_scale};
- }
- # Calculate the positions of comment object.
- my @vertices = $self->_position_object( $params{start_col},
- $params{start_row},
- $params{x_offset},
- $params{y_offset},
- $params{width},
- $params{height}
- );
- return(
- $row,
- $col,
- $string,
- $params{encoding},
- $params{author},
- $params{author_encoding},
- $params{visible},
- $params{color},
- [@vertices]
- );
- }
- #
- # DATA VALIDATION
- #
- ###############################################################################
- #
- # data_validation($row, $col, {...})
- #
- # This method handles the interface to Excel data validation.
- # Somewhat ironically the this requires a lot of validation code since the
- # interface is flexible and covers a several types of data validation.
- #
- # We allow data validation to be called on one cell or a range of cells. The
- # hashref contains the validation parameters and must be the last param:
- # data_validation($row, $col, {...})
- # data_validation($first_row, $first_col, $last_row, $last_col, {...})
- #
- # Returns 0 : normal termination
- # -1 : insufficient number of arguments
- # -2 : row or column out of range
- # -3 : incorrect parameter.
- #
- sub data_validation {
- my $self = shift;
- # Check for a cell reference in A1 notation and substitute row and column
- if ($_[0] =~ /^\D/) {
- @_ = $self->_substitute_cellref(@_);
- }
- # Check for a valid number of args.
- if (@_ != 5 && @_ != 3) { return -1 }
- # The final hashref contains the validation parameters.
- my $param = pop;
- # Make the last row/col the same as the first if not defined.
- my ($row1, $col1, $row2, $col2) = @_;
- if (!defined $row2) {
- $row2 = $row1;
- $col2 = $col1;
- }
- # Check that row and col are valid without storing the values.
- return -2 if $self->_check_dimensions($row1, $col1, 1, 1);
- return -2 if $self->_check_dimensions($row2, $col2, 1, 1);
- # Check that the last parameter is a hash list.
- if (ref $param ne 'HASH') {
- carp "Last parameter '$param' in data_validation() must be a hash ref";
- return -3;
- }
- # List of valid input parameters.
- my %valid_parameter = (
- validate => 1,
- criteria => 1,
- value => 1,
- source => 1,
- minimum => 1,
- maximum => 1,
- ignore_blank => 1,
- dropdown => 1,
- show_input => 1,
- input_title => 1,
- input_message => 1,
- show_error => 1,
- error_title => 1,
- error_message => 1,
- error_type => 1,
- other_cells => 1,
- );
- # Check for valid input parameters.
- for my $param_key (keys %$param) {
- if (not exists $valid_parameter{$param_key}) {
- carp "Unknown parameter '$param_key' in data_validation()";
- return -3;
- }
- }
- # Map alternative parameter names 'source' or 'minimum' to 'value'.
- $param->{value} = $param->{source} if defined $param->{source};
- $param->{value} = $param->{minimum} if defined $param->{minimum};
- # 'validate' is a required parameter.
- if (not exists $param->{validate}) {
- carp "Parameter 'validate' is required in data_validation()";
- return -3;
- }
- # List of valid validation types.
- my %valid_type = (
- 'any' => 0,
- 'any value' => 0,
- 'whole number' => 1,
- 'whole' => 1,
- 'integer' => 1,
- 'decimal' => 2,
- 'list' => 3,
- 'date' => 4,
- 'time' => 5,
- 'text length' => 6,
- 'length' => 6,
- 'custom' => 7,
- );
- # Check for valid validation types.
- if (not exists $valid_type{lc($param->{validate})}) {
- carp "Unknown validation type '$param->{validate}' for parameter " .
- "'validate' in data_validation()";
- return -3;
- }
- else {
- $param->{validate} = $valid_type{lc($param->{validate})};
- }
- # No action is required for validation type 'any'.
- # TODO: we should perhaps store 'any' for message only validations.
- return 0 if $param->{validate} == 0;
- # The list and custom validations don't have a criteria so we use a default
- # of 'between'.
- if ($param->{validate} == 3 || $param->{validate} == 7) {
- $param->{criteria} = 'between';
- $param->{maximum} = undef;
- }
- # 'criteria' is a required parameter.
- if (not exists $param->{criteria}) {
- carp "Parameter 'criteria' is required in data_validation()";
- return -3;
- }
- # List of valid criteria types.
- my %criteria_type = (
- 'between' => 0,
- 'not between' => 1,
- 'equal to' => 2,
- '=' => 2,
- '==' => 2,
- 'not equal to' => 3,
- '!=' => 3,
- '<>' => 3,
- 'greater than' => 4,
- '>' => 4,
- 'less than' => 5,
- '<' => 5,
- 'greater than or equal to' => 6,
- '>=' => 6,
- 'less than or equal to' => 7,
- '<=' => 7,
- );
- # Check for valid criteria types.
- if (not exists $criteria_type{lc($param->{criteria})}) {
- carp "Unknown criteria type '$param->{criteria}' for parameter " .
- "'criteria' in data_validation()";
- return -3;
- }
- else {
- $param->{criteria} = $criteria_type{lc($param->{criteria})};
- }
- # 'Between' and 'Not between' criteria require 2 values.
- if ($param->{criteria} == 0 || $param->{criteria} == 1) {
- if (not exists $param->{maximum}) {
- carp "Parameter 'maximum' is required in data_validation() " .
- "when using 'between' or 'not between' criteria";
- return -3;
- }
- }
- else {
- $param->{maximum} = undef;
- }
- # List of valid error dialog types.
- my %error_type = (
- 'stop' => 0,
- 'warning' => 1,
- 'information' => 2,
- );
- # Check for valid error dialog types.
- if (not exists $param->{error_type}) {
- $param->{error_type} = 0;
- }
- elsif (not exists $error_type{lc($param->{error_type})}) {
- carp "Unknown criteria type '$param->{error_type}' for parameter " .
- "'error_type' in data_validation()";
- return -3;
- }
- else {
- $param->{error_type} = $error_type{lc($param->{error_type})};
- }
- # Convert date/times value if required.
- if ($param->{validate} == 4 || $param->{validate} == 5) {
- if ($param->{value} =~ /T/) {
- my $date_time = $self->convert_date_time($param->{value});
- if (!defined $date_time) {
- carp "Invalid date/time value '$param->{value}' " .
- "in data_validation()";
- return -3;
- }
- else {
- $param->{value} = $date_time;
- }
- }
- if (defined $param->{maximum} && $param->{maximum} =~ /T/) {
- my $date_time = $self->convert_date_time($param->{maximum});
- if (!defined $date_time) {
- carp "Invalid date/time value '$param->{maximum}' " .
- "in data_validation()";
- return -3;
- }
- else {
- $param->{maximum} = $date_time;
- }
- }
- }
- # Set some defaults if they haven't been defined by the user.
- $param->{ignore_blank} = 1 if !defined $param->{ignore_blank};
- $param->{dropdown} = 1 if !defined $param->{dropdown};
- $param->{show_input} = 1 if !defined $param->{show_input};
- $param->{show_error} = 1 if !defined $param->{show_error};
- # These are the cells to which the validation is applied.
- $param->{cells} = [[$row1, $col1, $row2, $col2]];
- # A (for now) undocumented parameter to pass additional cell ranges.
- if (exists $param->{other_cells}) {
- push @{$param->{cells}}, @{$param->{other_cells}};
- }
- # Store the validation information until we close the worksheet.
- push @{$self->{_validations}}, $param;
- }
- ###############################################################################
- #
- # _store_validation_count()
- #
- # Store the count of the DV records to follow.
- #
- # Note, this could be wrapped into _store_dv() but we may require separate
- # handling of the object id at a later stage.
- #
- sub _store_validation_count {
- my $self = shift;
- my $dv_count = @{$self->{_validations}};
- my $obj_id = -1;
- return unless $dv_count;
- $self->_store_dval($obj_id , $dv_count);
- }
- ###############################################################################
- #
- # _store_validations()
- #
- # Store the data_validation records.
- #
- sub _store_validations {
- my $self = shift;
- return unless scalar @{$self->{_validations}};
- for my $param (@{$self->{_validations}}) {
- $self->_store_dv( $param->{cells},
- $param->{validate},
- $param->{criteria},
- $param->{value},
- $param->{maximum},
- $param->{input_title},
- $param->{input_message},
- $param->{error_title},
- $param->{error_message},
- $param->{error_type},
- $param->{ignore_blank},
- $param->{dropdown},
- $param->{show_input},
- $param->{show_error},
- );
- }
- }
- ###############################################################################
- #
- # _store_dval()
- #
- # Store the DV record which contains the number of and information common to
- # all DV structures.
- #
- sub _store_dval {
- my $self = shift;
- my $record = 0x01B2; # Record identifier
- my $length = 0x0012; # Bytes to follow
- my $obj_id = $_[0]; # Object ID number.
- my $dv_count = $_[1]; # Count of DV structs to follow.
- my $flags = 0x0004; # Option flags.
- my $x_coord = 0x00000000; # X coord of input box.
- my $y_coord = 0x00000000; # Y coord of input box.
- # Pack the record.
- my $header = pack('vv', $record, $length);
- my $data = pack('vVVVV', $flags, $x_coord, $y_coord, $obj_id, $dv_count);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _store_dv()
- #
- # Store the DV record that specifies the data validation criteria and options
- # for a range of cells..
- #
- sub _store_dv {
- my $self = shift;
- my $record = 0x01BE; # Record identifier
- my $length = 0x0000; # Bytes to follow
- my $flags = 0x00000000; # DV option flags.
- my $cells = $_[0]; # Aref of cells to which DV applies.
- my $validation_type = $_[1]; # Type of data validation.
- my $criteria_type = $_[2]; # Validation criteria.
- my $formula_1 = $_[3]; # Value/Source/Minimum formula.
- my $formula_2 = $_[4]; # Maximum formula.
- my $input_title = $_[5]; # Title of input message.
- my $input_message = $_[6]; # Text of input message.
- my $error_title = $_[7]; # Title of error message.
- my $error_message = $_[8]; # Text of input message.
- my $error_type = $_[9]; # Error dialog type.
- my $ignore_blank = $_[10]; # Ignore blank cells.
- my $dropdown = $_[11]; # Display dropdown with list.
- my $input_box = $_[12]; # Display input box.
- my $error_box = $_[13]; # Display error box.
- my $ime_mode = 0; # IME input mode for far east fonts.
- my $str_lookup = 0; # See below.
- # Set the string lookup flag for 'list' validations with a string array.
- if ($validation_type == 3 && ref $formula_1 eq 'ARRAY') {
- $str_lookup = 1;
- }
- # The dropdown flag is stored as a negated value.
- my $no_dropdown = not $dropdown;
- # Set the required flags.
- $flags |= $validation_type;
- $flags |= $error_type << 4;
- $flags |= $str_lookup << 7;
- $flags |= $ignore_blank << 8;
- $flags |= $no_dropdown << 9;
- $flags |= $ime_mode << 10;
- $flags |= $input_box << 18;
- $flags |= $error_box << 19;
- $flags |= $criteria_type << 20;
- # Pack the validation formulas.
- $formula_1 = $self->_pack_dv_formula($formula_1);
- $formula_2 = $self->_pack_dv_formula($formula_2);
- # Pack the input and error dialog strings.
- $input_title = $self->_pack_dv_string($input_title, 32 );
- $error_title = $self->_pack_dv_string($error_title, 32 );
- $input_message = $self->_pack_dv_string($input_message, 255);
- $error_message = $self->_pack_dv_string($error_message, 255);
- # Pack the DV cell data.
- my $dv_count = scalar @$cells;
- my $dv_data = pack 'v', $dv_count;
- for my $range (@$cells) {
- $dv_data .= pack 'vvvv', $range->[0],
- $range->[2],
- $range->[1],
- $range->[3];
- }
- # Pack the record.
- my $data = pack 'V', $flags;
- $data .= $input_title;
- $data .= $error_title;
- $data .= $input_message;
- $data .= $error_message;
- $data .= $formula_1;
- $data .= $formula_2;
- $data .= $dv_data;
- my $header = pack('vv', $record, length $data);
- $self->_append($header, $data);
- }
- ###############################################################################
- #
- # _pack_dv_string()
- #
- # Pack the strings used in the input and error dialog captions and messages.
- # Captions are limited to 32 characters. Messages are limited to 255 chars.
- #
- sub _pack_dv_string {
- my $self = shift;
- my $string = $_[0];
- my $max_length = $_[1];
- my $str_length = 0;
- my $encoding = 0;
- # The default empty string is "\0".
- if (!defined $string || $string eq '') {
- $string = "\0";
- }
- # Excel limits DV captions to 32 chars and messages to 255.
- if (length $string > $max_length) {
- $string = substr($string, 0, $max_length);
- }
- $str_length = length $string;
- # Handle utf8 strings in perl 5.8.
- if ($] >= 5.008) {
- require Encode;
- if (Encode::is_utf8($string)) {
- $string = Encode::encode("UTF-16LE", $string);
- $encoding = 1;
- }
- }
- return pack('vC', $str_length, $encoding) . $string;
- }
- ###############################################################################
- #
- # _pack_dv_formula()
- #
- # Pack the formula used in the DV record. This is the same as an cell formula
- # with some additional header information. Note, DV formulas in Excel use
- # relative addressing (R1C1 and ptgXxxN) however we use the Formula.pm's
- # default absolute addressing (A1 and ptgXxx).
- #
- sub _pack_dv_formula {
- my $self = shift;
- my $formula = $_[0];
- my $encoding = 0;
- my $length = 0;
- my $unused = 0x0000;
- my @tokens;
- # Return a default structure for unused formulas.
- if (!defined $formula || $formula eq '') {
- return pack('vv', 0, $unused);
- }
- # Pack a list array ref as a null separated string.
- if (ref $formula eq 'ARRAY') {
- $formula = join "\0", @$formula;
- $formula = qq("$formula");
- }
- # Strip the = sign at the beginning of the formula string
- $formula =~ s(^=)();
- # Parse the formula using the parser in Formula.pm
- my $parser = $self->{_parser};
- # In order to raise formula errors from the point of view of the calling
- # program we use an eval block and re-raise the error from here.
- #
- eval { @tokens = $parser->parse_formula($formula) };
- if ($@) {
- $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
- croak $@; # Re-raise the error
- }
- else {
- # TODO test for non valid ptgs such as Sheet2!A1
- }
- # Force 2d ranges to be a reference class.
- s/_range2d/_range2dR/ for @tokens;
- s/_name/_nameR/ for @tokens;
- # Parse the tokens into a formula string.
- $formula = $parser->parse_tokens(@tokens);
- return pack('vv', length $formula, $unused) . $formula;
- }
- 1;
- __END__
- =head1 NAME
- Worksheet - A writer class for Excel Worksheets.
- =head1 SYNOPSIS
- See the documentation for Spreadsheet::WriteExcel
- =head1 DESCRIPTION
- This module is used in conjunction with Spreadsheet::WriteExcel.
- =head1 AUTHOR
- John McNamara jmcnamara@cpan.org
- =head1 COPYRIGHT
- © MM-MMX, John McNamara.
- All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
|