Workbook.pm 110 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666
  1. # DISCLAIMER OF WARRANTY
  2. # Because this software is licensed free of charge, there is no warranty for the software,
  3. # to the extent permitted by applicable law. Except when otherwise stated in writing
  4. # the copyright holders and/or other parties provide the software "as is" without
  5. # warranty of any kind, either expressed or implied, including, but not limited to,
  6. # the implied warranties of merchantability and fitness for a particular purpose.
  7. # The entire risk as to the quality and performance of the software is with you.
  8. # Should the software prove defective, you assume the cost of all necessary
  9. # servicing, repair, or correction.
  10. # In no event unless required by applicable law or agreed to in writing will any
  11. # copyright holder, or any other party who may modify and/or redistribute the software
  12. # as permitted by the above licence, be liable to you for damages, including any general,
  13. # special, incidental, or consequential damages arising out of the use or inability
  14. # to use the software (including but not limited to loss of data or data being rendered
  15. # inaccurate or losses sustained by you or third parties or a failure of the software
  16. # to operate with any other software), even if such holder or other party
  17. # has been advised of the possibility of such damages.
  18. # AUTHOR
  19. # John McNamara jmcnamara@cpan.org
  20. # COPYRIGHT
  21. # Copyright MM-MMX, John McNamara.
  22. # All Rights Reserved. This module is free software. It may be used,
  23. # redistributed and/or modified under the terms of
  24. # the Artistic License(full text of the Artistic License http://dev.perl.org/licenses/artistic.html).
  25. package Spreadsheet::WriteExcel::Workbook;
  26. ###############################################################################
  27. #
  28. # Workbook - A writer class for Excel Workbooks.
  29. #
  30. #
  31. # Used in conjunction with Spreadsheet::WriteExcel
  32. #
  33. # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
  34. #
  35. # Documentation after __END__
  36. #
  37. use Exporter;
  38. use strict;
  39. use Carp;
  40. use Spreadsheet::WriteExcel::BIFFwriter;
  41. use Spreadsheet::WriteExcel::OLEwriter;
  42. use Spreadsheet::WriteExcel::Worksheet;
  43. use Spreadsheet::WriteExcel::Format;
  44. use Spreadsheet::WriteExcel::Chart;
  45. use Spreadsheet::WriteExcel::Properties ':property_sets';
  46. use vars qw($VERSION @ISA);
  47. @ISA = qw(Spreadsheet::WriteExcel::BIFFwriter Exporter);
  48. $VERSION = '2.37';
  49. ###############################################################################
  50. #
  51. # new()
  52. #
  53. # Constructor. Creates a new Workbook object from a BIFFwriter object.
  54. #
  55. sub new {
  56. my $class = shift;
  57. my $self = Spreadsheet::WriteExcel::BIFFwriter->new();
  58. my $byte_order = $self->{_byte_order};
  59. my $parser = Spreadsheet::WriteExcel::Formula->new($byte_order);
  60. $self->{_filename} = $_[0] || '';
  61. $self->{_parser} = $parser;
  62. $self->{_tempdir} = undef;
  63. $self->{_1904} = 0;
  64. $self->{_activesheet} = 0;
  65. $self->{_firstsheet} = 0;
  66. $self->{_selected} = 0;
  67. $self->{_xf_index} = 0;
  68. $self->{_fileclosed} = 0;
  69. $self->{_biffsize} = 0;
  70. $self->{_sheet_name} = 'Sheet';
  71. $self->{_chart_name} = 'Chart';
  72. $self->{_sheet_count} = 0;
  73. $self->{_chart_count} = 0;
  74. $self->{_url_format} = '';
  75. $self->{_codepage} = 0x04E4;
  76. $self->{_country} = 1;
  77. $self->{_worksheets} = [];
  78. $self->{_sheetnames} = [];
  79. $self->{_formats} = [];
  80. $self->{_palette} = [];
  81. $self->{_using_tmpfile} = 1;
  82. $self->{_filehandle} = "";
  83. $self->{_temp_file} = "";
  84. $self->{_internal_fh} = 0;
  85. $self->{_fh_out} = "";
  86. $self->{_str_total} = 0;
  87. $self->{_str_unique} = 0;
  88. $self->{_str_table} = {};
  89. $self->{_str_array} = [];
  90. $self->{_str_block_sizes} = [];
  91. $self->{_extsst_offsets} = [];
  92. $self->{_extsst_buckets} = 0;
  93. $self->{_extsst_bucket_size} = 0;
  94. $self->{_ext_ref_count} = 0;
  95. $self->{_ext_refs} = {};
  96. $self->{_mso_clusters} = [];
  97. $self->{_mso_size} = 0;
  98. $self->{_hideobj} = 0;
  99. $self->{_compatibility} = 0;
  100. $self->{_add_doc_properties} = 0;
  101. $self->{_localtime} = [localtime()];
  102. $self->{_defined_names} = [];
  103. bless $self, $class;
  104. # Add the in-built style formats and the default cell format.
  105. $self->add_format(type => 1); # 0 Normal
  106. $self->add_format(type => 1); # 1 RowLevel 1
  107. $self->add_format(type => 1); # 2 RowLevel 2
  108. $self->add_format(type => 1); # 3 RowLevel 3
  109. $self->add_format(type => 1); # 4 RowLevel 4
  110. $self->add_format(type => 1); # 5 RowLevel 5
  111. $self->add_format(type => 1); # 6 RowLevel 6
  112. $self->add_format(type => 1); # 7 RowLevel 7
  113. $self->add_format(type => 1); # 8 ColLevel 1
  114. $self->add_format(type => 1); # 9 ColLevel 2
  115. $self->add_format(type => 1); # 10 ColLevel 3
  116. $self->add_format(type => 1); # 11 ColLevel 4
  117. $self->add_format(type => 1); # 12 ColLevel 5
  118. $self->add_format(type => 1); # 13 ColLevel 6
  119. $self->add_format(type => 1); # 14 ColLevel 7
  120. $self->add_format(); # 15 Cell XF
  121. $self->add_format(type => 1, num_format => 0x2B); # 16 Comma
  122. $self->add_format(type => 1, num_format => 0x29); # 17 Comma[0]
  123. $self->add_format(type => 1, num_format => 0x2C); # 18 Currency
  124. $self->add_format(type => 1, num_format => 0x2A); # 19 Currency[0]
  125. $self->add_format(type => 1, num_format => 0x09); # 20 Percent
  126. # Add the default format for hyperlinks
  127. $self->{_url_format} = $self->add_format(color => 'blue', underline => 1);
  128. # Check for a filename unless it is an existing filehandle
  129. if (not ref $self->{_filename} and $self->{_filename} eq '') {
  130. carp 'Filename required by Spreadsheet::WriteExcel->new()';
  131. return undef;
  132. }
  133. # Convert the filename to a filehandle to pass to the OLE writer when the
  134. # file is closed. If the filename is a reference it is assumed that it is
  135. # a valid filehandle.
  136. #
  137. if (not ref $self->{_filename}) {
  138. my $fh = FileHandle->new('>'. $self->{_filename});
  139. if (not defined $fh) {
  140. carp "Can't open " .
  141. $self->{_filename} .
  142. ". It may be in use or protected";
  143. return undef;
  144. }
  145. # binmode file whether platform requires it or not
  146. binmode($fh);
  147. $self->{_internal_fh} = 1;
  148. $self->{_fh_out} = $fh;
  149. }
  150. else {
  151. $self->{_internal_fh} = 0;
  152. $self->{_fh_out} = $self->{_filename};
  153. }
  154. # Set colour palette.
  155. $self->set_palette_xl97();
  156. # Load Encode if we can.
  157. require Encode if $] >= 5.008;
  158. $self->_initialize();
  159. $self->_get_checksum_method();
  160. return $self;
  161. }
  162. ###############################################################################
  163. #
  164. # _initialize()
  165. #
  166. # Open a tmp file to store the majority of the Worksheet data. If this fails,
  167. # for example due to write permissions, store the data in memory. This can be
  168. # slow for large files.
  169. #
  170. # TODO: Move this and other methods shared with Worksheet up into BIFFwriter.
  171. #
  172. sub _initialize {
  173. my $self = shift;
  174. my $fh;
  175. my $tmp_dir;
  176. # The following code is complicated by Windows limitations. Porters can
  177. # choose a more direct method.
  178. # In the default case we use IO::File->new_tmpfile(). This may fail, in
  179. # particular with IIS on Windows, so we allow the user to specify a temp
  180. # directory via File::Temp.
  181. #
  182. if (defined $self->{_tempdir}) {
  183. # Delay loading File:Temp to reduce the module dependencies.
  184. eval { require File::Temp };
  185. die "The File::Temp module must be installed in order ".
  186. "to call set_tempdir().\n" if $@;
  187. # Trap but ignore File::Temp errors.
  188. eval { $fh = File::Temp::tempfile(DIR => $self->{_tempdir}) };
  189. # Store the failed tmp dir in case of errors.
  190. $tmp_dir = $self->{_tempdir} || File::Spec->tmpdir if not $fh;
  191. }
  192. else {
  193. $fh = IO::File->new_tmpfile();
  194. # Store the failed tmp dir in case of errors.
  195. $tmp_dir = "POSIX::tmpnam() directory" if not $fh;
  196. }
  197. # Check if the temp file creation was successful. Else store data in memory.
  198. if ($fh) {
  199. # binmode file whether platform requires it or not.
  200. binmode($fh);
  201. # Store filehandle
  202. $self->{_filehandle} = $fh;
  203. }
  204. else {
  205. # Set flag to store data in memory if XX::tempfile() failed.
  206. $self->{_using_tmpfile} = 0;
  207. if ($^W) {
  208. my $dir = $self->{_tempdir} || File::Spec->tmpdir();
  209. warn "Unable to create temp files in $tmp_dir. Data will be ".
  210. "stored in memory. Refer to set_tempdir() in the ".
  211. "Spreadsheet::WriteExcel documentation.\n" ;
  212. }
  213. }
  214. }
  215. ###############################################################################
  216. #
  217. # _get_checksum_method.
  218. #
  219. # Check for modules available to calculate image checksum. Excel uses MD4 but
  220. # MD5 will also work.
  221. #
  222. sub _get_checksum_method {
  223. my $self = shift;
  224. eval { require Digest::MD4};
  225. if (not $@) {
  226. $self->{_checksum_method} = 1;
  227. return;
  228. }
  229. eval { require Digest::Perl::MD4};
  230. if (not $@) {
  231. $self->{_checksum_method} = 2;
  232. return;
  233. }
  234. eval { require Digest::MD5};
  235. if (not $@) {
  236. $self->{_checksum_method} = 3;
  237. return;
  238. }
  239. # Default.
  240. $self->{_checksum_method} = 0;
  241. }
  242. ###############################################################################
  243. #
  244. # _append(), overridden.
  245. #
  246. # Store Worksheet data in memory using the base class _append() or to a
  247. # temporary file, the default.
  248. #
  249. sub _append {
  250. my $self = shift;
  251. my $data = '';
  252. if ($self->{_using_tmpfile}) {
  253. $data = join('', @_);
  254. # Add CONTINUE records if necessary
  255. $data = $self->_add_continue($data) if length($data) > $self->{_limit};
  256. # Protect print() from -l on the command line.
  257. local $\ = undef;
  258. print {$self->{_filehandle}} $data;
  259. $self->{_datasize} += length($data);
  260. }
  261. else {
  262. $data = $self->SUPER::_append(@_);
  263. }
  264. return $data;
  265. }
  266. ###############################################################################
  267. #
  268. # get_data().
  269. #
  270. # Retrieves data from memory in one chunk, or from disk in $buffer
  271. # sized chunks.
  272. #
  273. sub get_data {
  274. my $self = shift;
  275. my $buffer = 4096;
  276. my $tmp;
  277. # Return data stored in memory
  278. if (defined $self->{_data}) {
  279. $tmp = $self->{_data};
  280. $self->{_data} = undef;
  281. my $fh = $self->{_filehandle};
  282. seek($fh, 0, 0) if $self->{_using_tmpfile};
  283. return $tmp;
  284. }
  285. # Return data stored on disk
  286. if ($self->{_using_tmpfile}) {
  287. return $tmp if read($self->{_filehandle}, $tmp, $buffer);
  288. }
  289. # No data to return
  290. return undef;
  291. }
  292. ###############################################################################
  293. #
  294. # close()
  295. #
  296. # Calls finalization methods and explicitly close the OLEwriter file
  297. # handle.
  298. #
  299. sub close {
  300. my $self = shift;
  301. return if $self->{_fileclosed}; # Prevent close() from being called twice.
  302. $self->{_fileclosed} = 1;
  303. return $self->_store_workbook();
  304. }
  305. ###############################################################################
  306. #
  307. # DESTROY()
  308. #
  309. # Close the workbook if it hasn't already been explicitly closed.
  310. #
  311. sub DESTROY {
  312. my $self = shift;
  313. local ($@, $!, $^E, $?);
  314. $self->close() if not $self->{_fileclosed};
  315. }
  316. ###############################################################################
  317. #
  318. # sheets(slice,...)
  319. #
  320. # An accessor for the _worksheets[] array
  321. #
  322. # Returns: an optionally sliced list of the worksheet objects in a workbook.
  323. #
  324. sub sheets {
  325. my $self = shift;
  326. if (@_) {
  327. # Return a slice of the array
  328. return @{$self->{_worksheets}}[@_];
  329. }
  330. else {
  331. # Return the entire list
  332. return @{$self->{_worksheets}};
  333. }
  334. }
  335. ###############################################################################
  336. #
  337. # worksheets()
  338. #
  339. # An accessor for the _worksheets[] array.
  340. # This method is now deprecated. Use the sheets() method instead.
  341. #
  342. # Returns: an array reference
  343. #
  344. sub worksheets {
  345. my $self = shift;
  346. return $self->{_worksheets};
  347. }
  348. ###############################################################################
  349. #
  350. # add_worksheet($name, $encoding)
  351. #
  352. # Add a new worksheet to the Excel workbook.
  353. #
  354. # Returns: reference to a worksheet object
  355. #
  356. sub add_worksheet {
  357. my $self = shift;
  358. my $index = @{$self->{_worksheets}};
  359. my ($name, $encoding) = $self->_check_sheetname($_[0], $_[1]);
  360. # Porters take note, the following scheme of passing references to Workbook
  361. # data (in the \$self->{_foo} cases) instead of a reference to the Workbook
  362. # itself is a workaround to avoid circular references between Workbook and
  363. # Worksheet objects. Feel free to implement this in any way the suits your
  364. # language.
  365. #
  366. my @init_data = (
  367. $name,
  368. $index,
  369. $encoding,
  370. \$self->{_activesheet},
  371. \$self->{_firstsheet},
  372. $self->{_url_format},
  373. $self->{_parser},
  374. $self->{_tempdir},
  375. \$self->{_str_total},
  376. \$self->{_str_unique},
  377. \$self->{_str_table},
  378. $self->{_1904},
  379. $self->{_compatibility},
  380. undef, # Palette. Not used yet. See add_chart().
  381. );
  382. my $worksheet = Spreadsheet::WriteExcel::Worksheet->new(@init_data);
  383. $self->{_worksheets}->[$index] = $worksheet; # Store ref for iterator
  384. $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
  385. $self->{_parser}->set_ext_sheets($name, $index); # Store names in Formula.pm
  386. return $worksheet;
  387. }
  388. # Older method name for backwards compatibility.
  389. *addworksheet = *add_worksheet;
  390. ###############################################################################
  391. #
  392. # add_chart(%args)
  393. #
  394. # Create a chart for embedding or as as new sheet.
  395. #
  396. #
  397. sub add_chart {
  398. my $self = shift;
  399. my %arg = @_;
  400. my $name = '';
  401. my $encoding = 0;
  402. my $index = @{ $self->{_worksheets} };
  403. # Type must be specified so we can create the required chart instance.
  404. my $type = $arg{type};
  405. if ( !defined $type ) {
  406. croak "Must define chart type in add_chart()";
  407. }
  408. # Ensure that the chart defaults to non embedded.
  409. my $embedded = $arg{embedded} ||= 0;
  410. # Check the worksheet name for non-embedded charts.
  411. if ( !$embedded ) {
  412. ( $name, $encoding ) =
  413. $self->_check_sheetname( $arg{name}, $arg{name_encoding}, 1 );
  414. }
  415. my @init_data = (
  416. $name,
  417. $index,
  418. $encoding,
  419. \$self->{_activesheet},
  420. \$self->{_firstsheet},
  421. $self->{_url_format},
  422. $self->{_parser},
  423. $self->{_tempdir},
  424. \$self->{_str_total},
  425. \$self->{_str_unique},
  426. \$self->{_str_table},
  427. $self->{_1904},
  428. $self->{_compatibility},
  429. $self->{_palette},
  430. );
  431. my $chart = Spreadsheet::WriteExcel::Chart->factory( $type, @init_data );
  432. # If the chart isn't embedded let the workbook control it.
  433. if ( !$embedded ) {
  434. $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
  435. $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
  436. }
  437. else {
  438. # Set index to 0 so that the activate() and set_first_sheet() methods
  439. # point back to the first worksheet if used for embedded charts.
  440. $chart->{_index} = 0;
  441. $chart->_set_embedded_config_data();
  442. }
  443. return $chart;
  444. }
  445. ###############################################################################
  446. #
  447. # add_chart_ext($filename, $name)
  448. #
  449. # Add an externally created chart.
  450. #
  451. #
  452. sub add_chart_ext {
  453. my $self = shift;
  454. my $filename = $_[0];
  455. my $index = @{$self->{_worksheets}};
  456. my $type = 'external';
  457. my ($name, $encoding) = $self->_check_sheetname($_[1], $_[2]);
  458. my @init_data = (
  459. $filename,
  460. $name,
  461. $index,
  462. $encoding,
  463. \$self->{_activesheet},
  464. \$self->{_firstsheet},
  465. );
  466. my $chart = Spreadsheet::WriteExcel::Chart->factory($type, @init_data);
  467. $self->{_worksheets}->[$index] = $chart; # Store ref for iterator
  468. $self->{_sheetnames}->[$index] = $name; # Store EXTERNSHEET names
  469. return $chart;
  470. }
  471. ###############################################################################
  472. #
  473. # _check_sheetname($name, $encoding)
  474. #
  475. # Check for valid worksheet names. We check the length, if it contains any
  476. # invalid characters and if the name is unique in the workbook.
  477. #
  478. sub _check_sheetname {
  479. my $self = shift;
  480. my $name = $_[0] || "";
  481. my $encoding = $_[1] || 0;
  482. my $chart = $_[2] || 0;
  483. my $limit = $encoding ? 62 : 31;
  484. my $invalid_char = qr([\[\]:*?/\\]);
  485. # Increment the Sheet/Chart number used for default sheet names below.
  486. if ( $chart ) {
  487. $self->{_chart_count}++;
  488. }
  489. else {
  490. $self->{_sheet_count}++;
  491. }
  492. # Supply default Sheet/Chart name if none has been defined.
  493. if ( $name eq "" ) {
  494. $encoding = 0;
  495. if ( $chart ) {
  496. $name = $self->{_chart_name} . $self->{_chart_count};
  497. }
  498. else {
  499. $name = $self->{_sheet_name} . $self->{_sheet_count};
  500. }
  501. }
  502. # Check that sheetname is <= 31 (1 or 2 byte chars). Excel limit.
  503. croak "Sheetname $name must be <= 31 chars" if length $name > $limit;
  504. # Check that Unicode sheetname has an even number of bytes
  505. croak 'Odd number of bytes in Unicode worksheet name:' . $name
  506. if $encoding == 1 and length($name) % 2;
  507. # Check that sheetname doesn't contain any invalid characters
  508. if ($encoding != 1 and $name =~ $invalid_char) {
  509. # Check ASCII names
  510. croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
  511. }
  512. else {
  513. # Extract any 8bit clean chars from the UTF16 name and validate them.
  514. for my $wchar ($name =~ /../sg) {
  515. my ($hi, $lo) = unpack "aa", $wchar;
  516. if ($hi eq "\0" and $lo =~ $invalid_char) {
  517. croak 'Invalid character []:*?/\\ in worksheet name: ' . $name;
  518. }
  519. }
  520. }
  521. # Handle utf8 strings in perl 5.8.
  522. if ($] >= 5.008) {
  523. require Encode;
  524. if (Encode::is_utf8($name)) {
  525. $name = Encode::encode("UTF-16BE", $name);
  526. $encoding = 1;
  527. }
  528. }
  529. # Check that the worksheet name doesn't already exist since this is a fatal
  530. # error in Excel 97. The check must also exclude case insensitive matches
  531. # since the names 'Sheet1' and 'sheet1' are equivalent. The tests also have
  532. # to take the encoding into account.
  533. #
  534. foreach my $worksheet (@{$self->{_worksheets}}) {
  535. my $name_a = $name;
  536. my $encd_a = $encoding;
  537. my $name_b = $worksheet->{_name};
  538. my $encd_b = $worksheet->{_encoding};
  539. my $error = 0;
  540. if ($encd_a == 0 and $encd_b == 0) {
  541. $error = 1 if lc($name_a) eq lc($name_b);
  542. }
  543. elsif ($encd_a == 0 and $encd_b == 1) {
  544. $name_a = pack "n*", unpack "C*", $name_a;
  545. $error = 1 if lc($name_a) eq lc($name_b);
  546. }
  547. elsif ($encd_a == 1 and $encd_b == 0) {
  548. $name_b = pack "n*", unpack "C*", $name_b;
  549. $error = 1 if lc($name_a) eq lc($name_b);
  550. }
  551. elsif ($encd_a == 1 and $encd_b == 1) {
  552. # We can do a true case insensitive test with Perl 5.8 and utf8.
  553. if ($] >= 5.008) {
  554. $name_a = Encode::decode("UTF-16BE", $name_a);
  555. $name_b = Encode::decode("UTF-16BE", $name_b);
  556. $error = 1 if lc($name_a) eq lc($name_b);
  557. }
  558. else {
  559. # We can't easily do a case insensitive test of the UTF16 names.
  560. # As a special case we check if all of the high bytes are nulls and
  561. # then do an ASCII style case insensitive test.
  562. # Strip out the high bytes (funkily).
  563. my $hi_a = grep {ord} $name_a =~ /(.)./sg;
  564. my $hi_b = grep {ord} $name_b =~ /(.)./sg;
  565. if ($hi_a or $hi_b) {
  566. $error = 1 if $name_a eq $name_b;
  567. }
  568. else {
  569. $error = 1 if lc($name_a) eq lc($name_b);
  570. }
  571. }
  572. }
  573. # If any of the cases failed we throw the error here.
  574. if ($error) {
  575. croak "Worksheet name '$name', with case ignored, " .
  576. "is already in use";
  577. }
  578. }
  579. return ($name, $encoding);
  580. }
  581. ###############################################################################
  582. #
  583. # add_format(%properties)
  584. #
  585. # Add a new format to the Excel workbook. This adds an XF record and
  586. # a FONT record. Also, pass any properties to the Format::new().
  587. #
  588. sub add_format {
  589. my $self = shift;
  590. my $format = Spreadsheet::WriteExcel::Format->new($self->{_xf_index}, @_);
  591. $self->{_xf_index} += 1;
  592. push @{$self->{_formats}}, $format; # Store format reference
  593. return $format;
  594. }
  595. # Older method name for backwards compatibility.
  596. *addformat = *add_format;
  597. ###############################################################################
  598. #
  599. # compatibility_mode()
  600. #
  601. # Set the compatibility mode.
  602. #
  603. # Excel doesn't require every possible Biff record to be present in a file.
  604. # In particular if the indexing records INDEX, ROW and DBCELL aren't present
  605. # it just ignores the fact and reads the cells anyway. This is also true of
  606. # the EXTSST record. Gnumeric and OOo also take this approach. This allows
  607. # WriteExcel to ignore these records in order to minimise the amount of data
  608. # stored in memory. However, other third party applications that read Excel
  609. # files often expect these records to be present. In "compatibility mode"
  610. # WriteExcel writes these records and tries to be as close to an Excel
  611. # generated file as possible.
  612. #
  613. # This requires additional data to be stored in memory until the file is
  614. # about to be written. This incurs a memory and speed penalty and may not be
  615. # suitable for very large files.
  616. #
  617. sub compatibility_mode {
  618. my $self = shift;
  619. croak "compatibility_mode() must be called before add_worksheet()"
  620. if $self->sheets();
  621. if (defined($_[0])) {
  622. $self->{_compatibility} = $_[0];
  623. }
  624. else {
  625. $self->{_compatibility} = 1;
  626. }
  627. }
  628. ###############################################################################
  629. #
  630. # set_1904()
  631. #
  632. # Set the date system: 0 = 1900 (the default), 1 = 1904
  633. #
  634. sub set_1904 {
  635. my $self = shift;
  636. croak "set_1904() must be called before add_worksheet()"
  637. if $self->sheets();
  638. if (defined($_[0])) {
  639. $self->{_1904} = $_[0];
  640. }
  641. else {
  642. $self->{_1904} = 1;
  643. }
  644. }
  645. ###############################################################################
  646. #
  647. # get_1904()
  648. #
  649. # Return the date system: 0 = 1900, 1 = 1904
  650. #
  651. sub get_1904 {
  652. my $self = shift;
  653. return $self->{_1904};
  654. }
  655. ###############################################################################
  656. #
  657. # set_custom_color()
  658. #
  659. # Change the RGB components of the elements in the colour palette.
  660. #
  661. sub set_custom_color {
  662. my $self = shift;
  663. # Match a HTML #xxyyzz style parameter
  664. if (defined $_[1] and $_[1] =~ /^#(\w\w)(\w\w)(\w\w)/ ) {
  665. @_ = ($_[0], hex $1, hex $2, hex $3);
  666. }
  667. my $index = $_[0] || 0;
  668. my $red = $_[1] || 0;
  669. my $green = $_[2] || 0;
  670. my $blue = $_[3] || 0;
  671. my $aref = $self->{_palette};
  672. # Check that the colour index is the right range
  673. if ($index < 8 or $index > 64) {
  674. carp "Color index $index outside range: 8 <= index <= 64";
  675. return 0;
  676. }
  677. # Check that the colour components are in the right range
  678. if ( ($red < 0 or $red > 255) ||
  679. ($green < 0 or $green > 255) ||
  680. ($blue < 0 or $blue > 255) )
  681. {
  682. carp "Color component outside range: 0 <= color <= 255";
  683. return 0;
  684. }
  685. $index -=8; # Adjust colour index (wingless dragonfly)
  686. # Set the RGB value
  687. $aref->[$index] = [$red, $green, $blue, 0];
  688. return $index +8;
  689. }
  690. ###############################################################################
  691. #
  692. # set_palette_xl97()
  693. #
  694. # Sets the colour palette to the Excel 97+ default.
  695. #
  696. sub set_palette_xl97 {
  697. my $self = shift;
  698. $self->{_palette} = [
  699. [0x00, 0x00, 0x00, 0x00], # 8
  700. [0xff, 0xff, 0xff, 0x00], # 9
  701. [0xff, 0x00, 0x00, 0x00], # 10
  702. [0x00, 0xff, 0x00, 0x00], # 11
  703. [0x00, 0x00, 0xff, 0x00], # 12
  704. [0xff, 0xff, 0x00, 0x00], # 13
  705. [0xff, 0x00, 0xff, 0x00], # 14
  706. [0x00, 0xff, 0xff, 0x00], # 15
  707. [0x80, 0x00, 0x00, 0x00], # 16
  708. [0x00, 0x80, 0x00, 0x00], # 17
  709. [0x00, 0x00, 0x80, 0x00], # 18
  710. [0x80, 0x80, 0x00, 0x00], # 19
  711. [0x80, 0x00, 0x80, 0x00], # 20
  712. [0x00, 0x80, 0x80, 0x00], # 21
  713. [0xc0, 0xc0, 0xc0, 0x00], # 22
  714. [0x80, 0x80, 0x80, 0x00], # 23
  715. [0x99, 0x99, 0xff, 0x00], # 24
  716. [0x99, 0x33, 0x66, 0x00], # 25
  717. [0xff, 0xff, 0xcc, 0x00], # 26
  718. [0xcc, 0xff, 0xff, 0x00], # 27
  719. [0x66, 0x00, 0x66, 0x00], # 28
  720. [0xff, 0x80, 0x80, 0x00], # 29
  721. [0x00, 0x66, 0xcc, 0x00], # 30
  722. [0xcc, 0xcc, 0xff, 0x00], # 31
  723. [0x00, 0x00, 0x80, 0x00], # 32
  724. [0xff, 0x00, 0xff, 0x00], # 33
  725. [0xff, 0xff, 0x00, 0x00], # 34
  726. [0x00, 0xff, 0xff, 0x00], # 35
  727. [0x80, 0x00, 0x80, 0x00], # 36
  728. [0x80, 0x00, 0x00, 0x00], # 37
  729. [0x00, 0x80, 0x80, 0x00], # 38
  730. [0x00, 0x00, 0xff, 0x00], # 39
  731. [0x00, 0xcc, 0xff, 0x00], # 40
  732. [0xcc, 0xff, 0xff, 0x00], # 41
  733. [0xcc, 0xff, 0xcc, 0x00], # 42
  734. [0xff, 0xff, 0x99, 0x00], # 43
  735. [0x99, 0xcc, 0xff, 0x00], # 44
  736. [0xff, 0x99, 0xcc, 0x00], # 45
  737. [0xcc, 0x99, 0xff, 0x00], # 46
  738. [0xff, 0xcc, 0x99, 0x00], # 47
  739. [0x33, 0x66, 0xff, 0x00], # 48
  740. [0x33, 0xcc, 0xcc, 0x00], # 49
  741. [0x99, 0xcc, 0x00, 0x00], # 50
  742. [0xff, 0xcc, 0x00, 0x00], # 51
  743. [0xff, 0x99, 0x00, 0x00], # 52
  744. [0xff, 0x66, 0x00, 0x00], # 53
  745. [0x66, 0x66, 0x99, 0x00], # 54
  746. [0x96, 0x96, 0x96, 0x00], # 55
  747. [0x00, 0x33, 0x66, 0x00], # 56
  748. [0x33, 0x99, 0x66, 0x00], # 57
  749. [0x00, 0x33, 0x00, 0x00], # 58
  750. [0x33, 0x33, 0x00, 0x00], # 59
  751. [0x99, 0x33, 0x00, 0x00], # 60
  752. [0x99, 0x33, 0x66, 0x00], # 61
  753. [0x33, 0x33, 0x99, 0x00], # 62
  754. [0x33, 0x33, 0x33, 0x00], # 63
  755. ];
  756. return 0;
  757. }
  758. ###############################################################################
  759. #
  760. # set_tempdir()
  761. #
  762. # Change the default temp directory used by _initialize() in Worksheet.pm.
  763. #
  764. sub set_tempdir {
  765. my $self = shift;
  766. # Windows workaround. See Worksheet::_initialize()
  767. my $dir = shift || '';
  768. croak "$dir is not a valid directory" if $dir ne '' and not -d $dir;
  769. croak "set_tempdir must be called before add_worksheet" if $self->sheets();
  770. $self->{_tempdir} = $dir ;
  771. }
  772. ###############################################################################
  773. #
  774. # set_codepage()
  775. #
  776. # See also the _store_codepage method. This is used to store the code page, i.e.
  777. # the character set used in the workbook.
  778. #
  779. sub set_codepage {
  780. my $self = shift;
  781. my $codepage = $_[0] || 1;
  782. $codepage = 0x04E4 if $codepage == 1;
  783. $codepage = 0x8000 if $codepage == 2;
  784. $self->{_codepage} = $codepage;
  785. }
  786. ###############################################################################
  787. #
  788. # set_country()
  789. #
  790. # See also the _store_country method. This is used to store the country code.
  791. # Some non-english versions of Excel may need this set to some value other
  792. # than 1 = "United States". In general the country code is equal to the
  793. # international dialling code.
  794. #
  795. sub set_country {
  796. my $self = shift;
  797. $self->{_country} = $_[0] || 1;
  798. }
  799. ###############################################################################
  800. #
  801. # define_name()
  802. #
  803. # TODO.
  804. #
  805. sub define_name {
  806. my $self = shift;
  807. my $name = shift;
  808. my $formula = shift;
  809. my $encoding = shift || 0;
  810. my $sheet_index = 0;
  811. my @tokens;
  812. my $full_name = $name;
  813. if ($name =~ /^(.*)!(.*)$/) {
  814. my $sheetname = $1;
  815. $name = $2;
  816. $sheet_index = 1 + $self->{_parser}->_get_sheet_index($sheetname);
  817. }
  818. # Strip the = sign at the beginning of the formula string
  819. $formula =~ s(^=)();
  820. # Parse the formula using the parser in Formula.pm
  821. my $parser = $self->{_parser};
  822. # In order to raise formula errors from the point of view of the calling
  823. # program we use an eval block and re-raise the error from here.
  824. #
  825. eval { @tokens = $parser->parse_formula($formula) };
  826. if ($@) {
  827. $@ =~ s/\n$//; # Strip the \n used in the Formula.pm die()
  828. croak $@; # Re-raise the error
  829. }
  830. # Force 2d ranges to be a reference class.
  831. s/_ref3d/_ref3dR/ for @tokens;
  832. s/_range3d/_range3dR/ for @tokens;
  833. # Parse the tokens into a formula string.
  834. $formula = $parser->parse_tokens(@tokens);
  835. $full_name = lc $full_name;
  836. push @{$self->{_defined_names}}, {
  837. name => $name,
  838. encoding => $encoding,
  839. sheet_index => $sheet_index,
  840. formula => $formula,
  841. };
  842. my $index = scalar @{$self->{_defined_names}};
  843. $parser->set_ext_name($name, $index);
  844. }
  845. ###############################################################################
  846. #
  847. # set_properties()
  848. #
  849. # Set the document properties such as Title, Author etc. These are written to
  850. # property sets in the OLE container.
  851. #
  852. sub set_properties {
  853. my $self = shift;
  854. my %param;
  855. # Ignore if no args were passed.
  856. return -1 unless @_;
  857. # Allow the parameters to be passed as a hash or hash ref.
  858. if (ref $_[0] eq 'HASH') {
  859. %param = %{$_[0]};
  860. }
  861. else {
  862. %param = @_;
  863. }
  864. # List of valid input parameters.
  865. my %properties = (
  866. codepage => [0x0001, 'VT_I2' ],
  867. title => [0x0002, 'VT_LPSTR' ],
  868. subject => [0x0003, 'VT_LPSTR' ],
  869. author => [0x0004, 'VT_LPSTR' ],
  870. keywords => [0x0005, 'VT_LPSTR' ],
  871. comments => [0x0006, 'VT_LPSTR' ],
  872. last_author => [0x0008, 'VT_LPSTR' ],
  873. created => [0x000C, 'VT_FILETIME'],
  874. category => [0x0002, 'VT_LPSTR' ],
  875. manager => [0x000E, 'VT_LPSTR' ],
  876. company => [0x000F, 'VT_LPSTR' ],
  877. utf8 => 1,
  878. );
  879. # Check for valid input parameters.
  880. for my $parameter (keys %param) {
  881. if (not exists $properties{$parameter}) {
  882. carp "Unknown parameter '$parameter' in set_properties()";
  883. return -1;
  884. }
  885. }
  886. # Set the creation time unless specified by the user.
  887. if (!exists $param{created}){
  888. $param{created} = $self->{_localtime};
  889. }
  890. #
  891. # Create the SummaryInformation property set.
  892. #
  893. # Get the codepage of the strings in the property set.
  894. my @strings = qw(title subject author keywords comments last_author);
  895. $param{codepage} = $self->_get_property_set_codepage(\%param,
  896. \@strings);
  897. # Create an array of property set values.
  898. my @property_sets;
  899. for my $property (qw(codepage title subject author
  900. keywords comments last_author created))
  901. {
  902. if (exists $param{$property} && defined $param{$property}) {
  903. push @property_sets, [
  904. $properties{$property}->[0],
  905. $properties{$property}->[1],
  906. $param{$property}
  907. ];
  908. }
  909. }
  910. # Pack the property sets.
  911. $self->{summary} = create_summary_property_set(\@property_sets);
  912. #
  913. # Create the DocSummaryInformation property set.
  914. #
  915. # Get the codepage of the strings in the property set.
  916. @strings = qw(category manager company);
  917. $param{codepage} = $self->_get_property_set_codepage(\%param,
  918. \@strings);
  919. # Create an array of property set values.
  920. @property_sets = ();
  921. for my $property (qw(codepage category manager company))
  922. {
  923. if (exists $param{$property} && defined $param{$property}) {
  924. push @property_sets, [
  925. $properties{$property}->[0],
  926. $properties{$property}->[1],
  927. $param{$property}
  928. ];
  929. }
  930. }
  931. # Pack the property sets.
  932. $self->{doc_summary} = create_doc_summary_property_set(\@property_sets);
  933. # Set a flag for when the files is written.
  934. $self->{_add_doc_properties} = 1;
  935. }
  936. ###############################################################################
  937. #
  938. # _get_property_set_codepage()
  939. #
  940. # Get the character codepage used by the strings in a property set. If one of
  941. # the strings used is utf8 then the codepage is marked as utf8. Otherwise
  942. # Latin 1 is used (although in our case this is limited to 7bit ASCII).
  943. #
  944. sub _get_property_set_codepage {
  945. my $self = shift;
  946. my $params = $_[0];
  947. my $strings = $_[1];
  948. # Allow for manually marked utf8 strings.
  949. return 0xFDE9 if defined $params->{utf8};
  950. # Check for utf8 strings in perl 5.8.
  951. if ($] >= 5.008) {
  952. require Encode;
  953. for my $string (@{$strings }) {
  954. next unless exists $params->{$string};
  955. return 0xFDE9 if Encode::is_utf8($params->{$string});
  956. }
  957. }
  958. return 0x04E4; # Default codepage, Latin 1.
  959. }
  960. ###############################################################################
  961. #
  962. # _store_workbook()
  963. #
  964. # Assemble worksheets into a workbook and send the BIFF data to an OLE
  965. # storage.
  966. #
  967. sub _store_workbook {
  968. my $self = shift;
  969. # Add a default worksheet if non have been added.
  970. $self->add_worksheet() if not @{$self->{_worksheets}};
  971. # Calculate size required for MSO records and update worksheets.
  972. $self->_calc_mso_sizes();
  973. # Ensure that at least one worksheet has been selected.
  974. if ($self->{_activesheet} == 0) {
  975. @{$self->{_worksheets}}[0]->{_selected} = 1;
  976. @{$self->{_worksheets}}[0]->{_hidden} = 0;
  977. }
  978. # Calculate the number of selected sheet tabs and set the active sheet.
  979. foreach my $sheet (@{$self->{_worksheets}}) {
  980. $self->{_selected}++ if $sheet->{_selected};
  981. $sheet->{_active} = 1 if $sheet->{_index} == $self->{_activesheet};
  982. }
  983. # Add Workbook globals
  984. $self->_store_bof(0x0005);
  985. $self->_store_codepage();
  986. $self->_store_window1();
  987. $self->_store_hideobj();
  988. $self->_store_1904();
  989. $self->_store_all_fonts();
  990. $self->_store_all_num_formats();
  991. $self->_store_all_xfs();
  992. $self->_store_all_styles();
  993. $self->_store_palette();
  994. # Calculate the offsets required by the BOUNDSHEET records
  995. $self->_calc_sheet_offsets();
  996. # Add BOUNDSHEET records.
  997. foreach my $sheet (@{$self->{_worksheets}}) {
  998. $self->_store_boundsheet($sheet->{_name},
  999. $sheet->{_offset},
  1000. $sheet->{_sheet_type},
  1001. $sheet->{_hidden},
  1002. $sheet->{_encoding});
  1003. }
  1004. # NOTE: If any records are added between here and EOF the
  1005. # _calc_sheet_offsets() should be updated to include the new length.
  1006. $self->_store_country();
  1007. if ($self->{_ext_ref_count}) {
  1008. $self->_store_supbook();
  1009. $self->_store_externsheet();
  1010. $self->_store_names();
  1011. }
  1012. $self->_add_mso_drawing_group();
  1013. $self->_store_shared_strings();
  1014. $self->_store_extsst();
  1015. # End Workbook globals
  1016. $self->_store_eof();
  1017. # Store the workbook in an OLE container
  1018. return $self->_store_OLE_file();
  1019. }
  1020. ###############################################################################
  1021. #
  1022. # _store_OLE_file()
  1023. #
  1024. # Store the workbook in an OLE container using the default handler or using
  1025. # OLE::Storage_Lite if the workbook data is > ~ 7MB.
  1026. #
  1027. sub _store_OLE_file {
  1028. my $self = shift;
  1029. my $maxsize = 7_087_104;
  1030. if (!$self->{_add_doc_properties} && $self->{_biffsize} <= $maxsize) {
  1031. # Write the OLE file using OLEwriter if data <= 7MB
  1032. my $OLE = Spreadsheet::WriteExcel::OLEwriter->new($self->{_fh_out});
  1033. # Write the BIFF data without the OLE container for testing.
  1034. $OLE->{_biff_only} = $self->{_biff_only};
  1035. # Indicate that we created the filehandle and want to close it.
  1036. $OLE->{_internal_fh} = $self->{_internal_fh};
  1037. $OLE->set_size($self->{_biffsize});
  1038. $OLE->write_header();
  1039. while (my $tmp = $self->get_data()) {
  1040. $OLE->write($tmp);
  1041. }
  1042. foreach my $worksheet (@{$self->{_worksheets}}) {
  1043. while (my $tmp = $worksheet->get_data()) {
  1044. $OLE->write($tmp);
  1045. }
  1046. }
  1047. return $OLE->close();
  1048. }
  1049. else {
  1050. # Write the OLE file using OLE::Storage_Lite if data > 7MB
  1051. eval { require OLE::Storage_Lite };
  1052. if (not $@) {
  1053. # Protect print() from -l on the command line.
  1054. local $\ = undef;
  1055. my @streams;
  1056. # Create the Workbook stream.
  1057. my $stream = pack 'v*', unpack 'C*', 'Workbook';
  1058. my $workbook = OLE::Storage_Lite::PPS::File->newFile($stream);
  1059. while (my $tmp = $self->get_data()) {
  1060. $workbook->append($tmp);
  1061. }
  1062. foreach my $worksheet (@{$self->{_worksheets}}) {
  1063. while (my $tmp = $worksheet->get_data()) {
  1064. $workbook->append($tmp);
  1065. }
  1066. }
  1067. push @streams, $workbook;
  1068. # Create the properties streams, if any.
  1069. if ($self->{_add_doc_properties}) {
  1070. my $stream;
  1071. my $summary;
  1072. $stream = pack 'v*', unpack 'C*', "\5SummaryInformation";
  1073. $summary = $self->{summary};
  1074. $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
  1075. push @streams, $summary;
  1076. $stream = pack 'v*', unpack 'C*', "\5DocumentSummaryInformation";
  1077. $summary = $self->{doc_summary};
  1078. $summary = OLE::Storage_Lite::PPS::File->new($stream, $summary);
  1079. push @streams, $summary;
  1080. }
  1081. # Create the OLE root document and add the substreams.
  1082. my @localtime = @{ $self->{_localtime} };
  1083. splice(@localtime, 6);
  1084. my $ole_root = OLE::Storage_Lite::PPS::Root->new(\@localtime,
  1085. \@localtime,
  1086. \@streams);
  1087. $ole_root->save($self->{_filename});
  1088. # Close the filehandle if it was created internally.
  1089. return CORE::close($self->{_fh_out}) if $self->{_internal_fh};
  1090. }
  1091. else {
  1092. # File in greater than limit, set $! to "File too large"
  1093. $! = 27; # Perl error code "File too large"
  1094. croak "Maximum Spreadsheet::WriteExcel filesize, $maxsize bytes, ".
  1095. "exceeded. To create files bigger than this limit please " .
  1096. "install OLE::Storage_Lite\n";
  1097. # return 0;
  1098. }
  1099. }
  1100. }
  1101. ###############################################################################
  1102. #
  1103. # _calc_sheet_offsets()
  1104. #
  1105. # Calculate Worksheet BOF offsets records for use in the BOUNDSHEET records.
  1106. #
  1107. sub _calc_sheet_offsets {
  1108. my $self = shift;
  1109. my $BOF = 12;
  1110. my $EOF = 4;
  1111. my $offset = $self->{_datasize};
  1112. # Add the length of the COUNTRY record
  1113. $offset += 8;
  1114. # Add the length of the SST and associated CONTINUEs
  1115. $offset += $self->_calculate_shared_string_sizes();
  1116. # Add the length of the EXTSST record.
  1117. $offset += $self->_calculate_extsst_size();
  1118. # Add the length of the SUPBOOK, EXTERNSHEET and NAME records
  1119. $offset += $self->_calculate_extern_sizes();
  1120. # Add the length of the MSODRAWINGGROUP records including an extra 4 bytes
  1121. # for any CONTINUE headers. See _add_mso_drawing_group_continue().
  1122. my $mso_size = $self->{_mso_size};
  1123. $mso_size += 4 * int(($mso_size -1) / $self->{_limit});
  1124. $offset += $mso_size ;
  1125. foreach my $sheet (@{$self->{_worksheets}}) {
  1126. $offset += $BOF + length($sheet->{_name});
  1127. }
  1128. $offset += $EOF;
  1129. foreach my $sheet (@{$self->{_worksheets}}) {
  1130. $sheet->{_offset} = $offset;
  1131. $sheet->_close();
  1132. $offset += $sheet->{_datasize};
  1133. }
  1134. $self->{_biffsize} = $offset;
  1135. }
  1136. ###############################################################################
  1137. #
  1138. # _calc_mso_sizes()
  1139. #
  1140. # Calculate the MSODRAWINGGROUP sizes and the indexes of the Worksheet
  1141. # MSODRAWING records.
  1142. #
  1143. # In the following SPID is shape id, according to Escher nomenclature.
  1144. #
  1145. sub _calc_mso_sizes {
  1146. my $self = shift;
  1147. my $mso_size = 0; # Size of the MSODRAWINGGROUP record
  1148. my $start_spid = 1024; # Initial spid for each sheet
  1149. my $max_spid = 1024; # spidMax
  1150. my $num_clusters = 1; # cidcl
  1151. my $shapes_saved = 0; # cspSaved
  1152. my $drawings_saved = 0; # cdgSaved
  1153. my @clusters = ();
  1154. $self->_process_images();
  1155. # Add Bstore container size if there are images.
  1156. $mso_size += 8 if @{$self->{_images_data}};
  1157. # Iterate through the worksheets, calculate the MSODRAWINGGROUP parameters
  1158. # and space required to store the record and the MSODRAWING parameters
  1159. # required by each worksheet.
  1160. #
  1161. foreach my $sheet (@{$self->{_worksheets}}) {
  1162. next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
  1163. my $num_images = $sheet->{_num_images} || 0;
  1164. my $image_mso_size = $sheet->{_image_mso_size} || 0;
  1165. my $num_comments = $sheet->_prepare_comments();
  1166. my $num_charts = $sheet->_prepare_charts();
  1167. my $num_filters = $sheet->{_filter_count};
  1168. next unless $num_images + $num_comments + $num_charts +$num_filters;
  1169. # Include 1 parent MSODRAWING shape, per sheet, in the shape count.
  1170. my $num_shapes += 1 + $num_images
  1171. + $num_comments
  1172. + $num_charts
  1173. + $num_filters;
  1174. $shapes_saved += $num_shapes;
  1175. $mso_size += $image_mso_size;
  1176. # Add a drawing object for each sheet with comments.
  1177. $drawings_saved++;
  1178. # For each sheet start the spids at the next 1024 interval.
  1179. $max_spid = 1024 * (1 + int(($max_spid -1)/1024));
  1180. $start_spid = $max_spid;
  1181. # Max spid for each sheet and eventually for the workbook.
  1182. $max_spid += $num_shapes;
  1183. # Store the cluster ids
  1184. for (my $i = $num_shapes; $i > 0; $i -= 1024) {
  1185. $num_clusters += 1;
  1186. $mso_size += 8;
  1187. my $size = $i > 1024 ? 1024 : $i;
  1188. push @clusters, [$drawings_saved, $size];
  1189. }
  1190. # Pass calculated values back to the worksheet
  1191. $sheet->{_object_ids} = [$start_spid, $drawings_saved,
  1192. $num_shapes, $max_spid -1];
  1193. }
  1194. # Calculate the MSODRAWINGGROUP size if we have stored some shapes.
  1195. $mso_size += 86 if $mso_size; # Smallest size is 86+8=94
  1196. $self->{_mso_size} = $mso_size;
  1197. $self->{_mso_clusters} = [
  1198. $max_spid, $num_clusters, $shapes_saved,
  1199. $drawings_saved, [@clusters]
  1200. ];
  1201. }
  1202. ###############################################################################
  1203. #
  1204. # _process_images()
  1205. #
  1206. # We need to process each image in each worksheet and extract information.
  1207. # Some of this information is stored and used in the Workbook and some is
  1208. # passed back into each Worksheet. The overall size for the image related
  1209. # BIFF structures in the Workbook is calculated here.
  1210. #
  1211. # MSO size = 8 bytes for bstore_container +
  1212. # 44 bytes for blip_store_entry +
  1213. # 25 bytes for blip
  1214. # = 77 + image size.
  1215. #
  1216. sub _process_images {
  1217. my $self = shift;
  1218. my %images_seen;
  1219. my @image_data;
  1220. my @previous_images;
  1221. my $image_id = 1;
  1222. my $images_size = 0;
  1223. foreach my $sheet (@{$self->{_worksheets}}) {
  1224. next unless $sheet->{_sheet_type} == 0x0000; # Ignore charts.
  1225. next unless $sheet->_prepare_images();
  1226. my $num_images = 0;
  1227. my $image_mso_size = 0;
  1228. for my $image_ref (@{$sheet->{_images_array}}) {
  1229. my $filename = $image_ref->[2];
  1230. $num_images++;
  1231. #
  1232. # For each Worksheet image we get a structure like this
  1233. # [
  1234. # $row,
  1235. # $col,
  1236. # $name,
  1237. # $x_offset,
  1238. # $y_offset,
  1239. # $scale_x,
  1240. # $scale_y,
  1241. # ]
  1242. #
  1243. # And we add additional information:
  1244. #
  1245. # $image_id,
  1246. # $type,
  1247. # $width,
  1248. # $height;
  1249. if (not exists $images_seen{$filename}) {
  1250. # TODO should also match seen images based on checksum.
  1251. # Open the image file and import the data.
  1252. my $fh = FileHandle->new($filename);
  1253. croak "Couldn't import $filename: $!" unless defined $fh;
  1254. binmode $fh;
  1255. # Slurp the file into a string and do some size calcs.
  1256. my $data = do {local $/; <$fh>};
  1257. my $size = length $data;
  1258. my $checksum1 = $self->_image_checksum($data, $image_id);
  1259. my $checksum2 = $checksum1;
  1260. my $ref_count = 1;
  1261. # Process the image and extract dimensions.
  1262. my ($type, $width, $height);
  1263. # Test for PNGs...
  1264. if (unpack('x A3', $data) eq 'PNG') {
  1265. ($type, $width, $height) = $self->_process_png($data);
  1266. }
  1267. # Test for JFIF and Exif JPEGs...
  1268. elsif ( (unpack('n', $data) == 0xFFD8) &&
  1269. ( (unpack('x6 A4', $data) eq 'JFIF') ||
  1270. (unpack('x6 A4', $data) eq 'Exif')
  1271. )
  1272. )
  1273. {
  1274. ($type, $width, $height) = $self->_process_jpg($data, $filename);
  1275. }
  1276. # Test for BMPs...
  1277. elsif (unpack('A2', $data) eq 'BM') {
  1278. ($type, $width, $height) = $self->_process_bmp($data,
  1279. $filename);
  1280. # The 14 byte header of the BMP is stripped off.
  1281. $data = substr $data, 14;
  1282. # A checksum of the new image data is also required.
  1283. $checksum2 = $self->_image_checksum($data,
  1284. $image_id,
  1285. $image_id
  1286. );
  1287. # Adjust size -14 (header) + 16 (extra checksum).
  1288. $size += 2;
  1289. }
  1290. else {
  1291. croak "Unsupported image format for file: $filename\n";
  1292. }
  1293. # Push the new data back into the Worksheet array;
  1294. push @$image_ref, $image_id, $type, $width, $height;
  1295. # Also store new data for use in duplicate images.
  1296. push @previous_images, [$image_id, $type, $width, $height];
  1297. # Store information required by the Workbook.
  1298. push @image_data, [$ref_count, $type, $data, $size,
  1299. $checksum1, $checksum2];
  1300. # Keep track of overall data size.
  1301. $images_size += $size +61; # Size for bstore container.
  1302. $image_mso_size += $size +69; # Size for dgg container.
  1303. $images_seen{$filename} = $image_id++;
  1304. $fh->close;
  1305. }
  1306. else {
  1307. # We've processed this file already.
  1308. my $index = $images_seen{$filename} -1;
  1309. # Increase image reference count.
  1310. $image_data[$index]->[0]++;
  1311. # Add previously calculated data back onto the Worksheet array.
  1312. # $image_id, $type, $width, $height
  1313. my $a_ref = $sheet->{_images_array}->[$index];
  1314. push @$image_ref, @{$previous_images[$index]};
  1315. }
  1316. }
  1317. # Store information required by the Worksheet.
  1318. $sheet->{_num_images} = $num_images;
  1319. $sheet->{_image_mso_size} = $image_mso_size;
  1320. }
  1321. # Store information required by the Workbook.
  1322. $self->{_images_size} = $images_size;
  1323. $self->{_images_data} = \@image_data; # Store the data for MSODRAWINGGROUP.
  1324. }
  1325. ###############################################################################
  1326. #
  1327. # _image_checksum()
  1328. #
  1329. # Generate a checksum for the image using whichever module is available..The
  1330. # available modules are checked in _get_checksum_method(). Excel uses an MD4
  1331. # checksum but any other will do. In the event of no checksum module being
  1332. # available we simulate a checksum using the image index.
  1333. #
  1334. sub _image_checksum {
  1335. my $self = shift;
  1336. my $data = $_[0];
  1337. my $index1 = $_[1];
  1338. my $index2 = $_[2] || 0;
  1339. if ($self->{_checksum_method} == 1) {
  1340. # Digest::MD4
  1341. return Digest::MD4::md4_hex($data);
  1342. }
  1343. elsif ($self->{_checksum_method} == 2) {
  1344. # Digest::Perl::MD4
  1345. return Digest::Perl::MD4::md4_hex($data);
  1346. }
  1347. elsif ($self->{_checksum_method} == 3) {
  1348. # Digest::MD5
  1349. return Digest::MD5::md5_hex($data);
  1350. }
  1351. else {
  1352. # Default
  1353. return sprintf '%016X%016X', $index2, $index1;
  1354. }
  1355. }
  1356. ###############################################################################
  1357. #
  1358. # _process_png()
  1359. #
  1360. # Extract width and height information from a PNG file.
  1361. #
  1362. sub _process_png {
  1363. my $self = shift;
  1364. my $type = 6; # Excel Blip type (MSOBLIPTYPE).
  1365. my $width = unpack "N", substr $_[0], 16, 4;
  1366. my $height = unpack "N", substr $_[0], 20, 4;
  1367. return ($type, $width, $height);
  1368. }
  1369. ###############################################################################
  1370. #
  1371. # _process_bmp()
  1372. #
  1373. # Extract width and height information from a BMP file.
  1374. #
  1375. # Most of these checks came from the old Worksheet::_process_bitmap() method.
  1376. #
  1377. sub _process_bmp {
  1378. my $self = shift;
  1379. my $data = $_[0];
  1380. my $filename = $_[1];
  1381. my $type = 7; # Excel Blip type (MSOBLIPTYPE).
  1382. # Check that the file is big enough to be a bitmap.
  1383. if (length $data <= 0x36) {
  1384. croak "$filename doesn't contain enough data.";
  1385. }
  1386. # Read the bitmap width and height. Verify the sizes.
  1387. my ($width, $height) = unpack "x18 V2", $data;
  1388. if ($width > 0xFFFF) {
  1389. croak "$filename: largest image width $width supported is 65k.";
  1390. }
  1391. if ($height > 0xFFFF) {
  1392. croak "$filename: largest image height supported is 65k.";
  1393. }
  1394. # Read the bitmap planes and bpp data. Verify them.
  1395. my ($planes, $bitcount) = unpack "x26 v2", $data;
  1396. if ($bitcount != 24) {
  1397. croak "$filename isn't a 24bit true color bitmap.";
  1398. }
  1399. if ($planes != 1) {
  1400. croak "$filename: only 1 plane supported in bitmap image.";
  1401. }
  1402. # Read the bitmap compression. Verify compression.
  1403. my $compression = unpack "x30 V", $data;
  1404. if ($compression != 0) {
  1405. croak "$filename: compression not supported in bitmap image.";
  1406. }
  1407. return ($type, $width, $height);
  1408. }
  1409. ###############################################################################
  1410. #
  1411. # _process_jpg()
  1412. #
  1413. # Extract width and height information from a JPEG file.
  1414. #
  1415. sub _process_jpg {
  1416. my $self = shift;
  1417. my $data = $_[0];
  1418. my $filename = $_[1];
  1419. my $type = 5; # Excel Blip type (MSOBLIPTYPE).
  1420. my $width;
  1421. my $height;
  1422. my $offset = 2;
  1423. my $data_length = length $data;
  1424. # Search through the image data to find the 0xFFC0 marker. The height and
  1425. # width are contained in the data for that sub element.
  1426. while ($offset < $data_length) {
  1427. my $marker = unpack "n", substr $data, $offset, 2;
  1428. my $length = unpack "n", substr $data, $offset +2, 2;
  1429. if ($marker == 0xFFC0 || $marker == 0xFFC2) {
  1430. $height = unpack "n", substr $data, $offset +5, 2;
  1431. $width = unpack "n", substr $data, $offset +7, 2;
  1432. last;
  1433. }
  1434. $offset = $offset + $length + 2;
  1435. last if $marker == 0xFFDA;
  1436. }
  1437. if (not defined $height) {
  1438. croak "$filename: no size data found in jpeg image.\n";
  1439. }
  1440. return ($type, $width, $height);
  1441. }
  1442. ###############################################################################
  1443. #
  1444. # _store_all_fonts()
  1445. #
  1446. # Store the Excel FONT records.
  1447. #
  1448. sub _store_all_fonts {
  1449. my $self = shift;
  1450. my $format = $self->{_formats}->[15]; # The default cell format.
  1451. my $font = $format->get_font();
  1452. # Fonts are 0-indexed. According to the SDK there is no index 4,
  1453. for (0..3) {
  1454. $self->_append($font);
  1455. }
  1456. # Add the default fonts for charts and comments. This aren't connected
  1457. # to XF formats. Note, the font size, and some other properties of
  1458. # chart fonts are set in the FBI record of the chart.
  1459. my $tmp_format;
  1460. # Index 5. Axis numbers.
  1461. $tmp_format = Spreadsheet::WriteExcel::Format->new(
  1462. undef,
  1463. font_only => 1,
  1464. );
  1465. $self->_append( $tmp_format->get_font() );
  1466. # Index 6. Series names.
  1467. $tmp_format = Spreadsheet::WriteExcel::Format->new(
  1468. undef,
  1469. font_only => 1,
  1470. );
  1471. $self->_append( $tmp_format->get_font() );
  1472. # Index 7. Title.
  1473. $tmp_format = Spreadsheet::WriteExcel::Format->new(
  1474. undef,
  1475. font_only => 1,
  1476. bold => 1,
  1477. );
  1478. $self->_append( $tmp_format->get_font() );
  1479. # Index 8. Axes.
  1480. $tmp_format = Spreadsheet::WriteExcel::Format->new(
  1481. undef,
  1482. font_only => 1,
  1483. bold => 1,
  1484. );
  1485. $self->_append( $tmp_format->get_font() );
  1486. # Index 9. Comments.
  1487. $tmp_format = Spreadsheet::WriteExcel::Format->new(
  1488. undef,
  1489. font_only => 1,
  1490. font => 'Tahoma',
  1491. size => 8,
  1492. );
  1493. $self->_append( $tmp_format->get_font() );
  1494. # Iterate through the XF objects and write a FONT record if it isn't the
  1495. # same as the default FONT and if it hasn't already been used.
  1496. #
  1497. my %fonts;
  1498. my $key;
  1499. my $index = 10; # The first user defined FONT
  1500. $key = $format->get_font_key(); # The default font for cell formats.
  1501. $fonts{$key} = 0; # Index of the default font
  1502. # Fonts that are marked as '_font_only' are always stored. These are used
  1503. # mainly for charts and may not have an associated XF record.
  1504. foreach $format (@{$self->{_formats}}) {
  1505. $key = $format->get_font_key();
  1506. if (not $format->{_font_only} and exists $fonts{$key}) {
  1507. # FONT has already been used
  1508. $format->{_font_index} = $fonts{$key};
  1509. }
  1510. else {
  1511. # Add a new FONT record
  1512. if (not $format->{_font_only}) {
  1513. $fonts{$key} = $index;
  1514. }
  1515. $format->{_font_index} = $index;
  1516. $index++;
  1517. $font = $format->get_font();
  1518. $self->_append($font);
  1519. }
  1520. }
  1521. }
  1522. ###############################################################################
  1523. #
  1524. # _store_all_num_formats()
  1525. #
  1526. # Store user defined numerical formats i.e. FORMAT records
  1527. #
  1528. sub _store_all_num_formats {
  1529. my $self = shift;
  1530. my %num_formats;
  1531. my @num_formats;
  1532. my $num_format;
  1533. my $index = 164; # User defined FORMAT records start from 0xA4
  1534. # Iterate through the XF objects and write a FORMAT record if it isn't a
  1535. # built-in format type and if the FORMAT string hasn't already been used.
  1536. #
  1537. foreach my $format (@{$self->{_formats}}) {
  1538. my $num_format = $format->{_num_format};
  1539. my $encoding = $format->{_num_format_enc};
  1540. # Check if $num_format is an index to a built-in format.
  1541. # Also check for a string of zeros, which is a valid format string
  1542. # but would evaluate to zero.
  1543. #
  1544. if ($num_format !~ m/^0+\d/) {
  1545. next if $num_format =~ m/^\d+$/; # built-in
  1546. }
  1547. if (exists($num_formats{$num_format})) {
  1548. # FORMAT has already been used
  1549. $format->{_num_format} = $num_formats{$num_format};
  1550. }
  1551. else{
  1552. # Add a new FORMAT
  1553. $num_formats{$num_format} = $index;
  1554. $format->{_num_format} = $index;
  1555. $self->_store_num_format($num_format, $index, $encoding);
  1556. $index++;
  1557. }
  1558. }
  1559. }
  1560. ###############################################################################
  1561. #
  1562. # _store_all_xfs()
  1563. #
  1564. # Write all XF records.
  1565. #
  1566. sub _store_all_xfs {
  1567. my $self = shift;
  1568. foreach my $format (@{$self->{_formats}}) {
  1569. my $xf = $format->get_xf();
  1570. $self->_append($xf);
  1571. }
  1572. }
  1573. ###############################################################################
  1574. #
  1575. # _store_all_styles()
  1576. #
  1577. # Write all STYLE records.
  1578. #
  1579. sub _store_all_styles {
  1580. my $self = shift;
  1581. # Excel adds the built-in styles in alphabetical order.
  1582. my @built_ins = (
  1583. [0x03, 16], # Comma
  1584. [0x06, 17], # Comma[0]
  1585. [0x04, 18], # Currency
  1586. [0x07, 19], # Currency[0]
  1587. [0x00, 0], # Normal
  1588. [0x05, 20], # Percent
  1589. # We don't deal with these styles yet.
  1590. #[0x08, 21], # Hyperlink
  1591. #[0x02, 8], # ColLevel_n
  1592. #[0x01, 1], # RowLevel_n
  1593. );
  1594. for my $aref (@built_ins) {
  1595. my $type = $aref->[0];
  1596. my $xf_index = $aref->[1];
  1597. $self->_store_style($type, $xf_index);
  1598. }
  1599. }
  1600. ###############################################################################
  1601. #
  1602. # _store_names()
  1603. #
  1604. # Write the NAME record to define the print area and the repeat rows and cols.
  1605. #
  1606. sub _store_names {
  1607. my $self = shift;
  1608. my $index;
  1609. my %ext_refs = %{$self->{_ext_refs}};
  1610. # Create the user defined names.
  1611. for my $defined_name (@{$self->{_defined_names}}) {
  1612. $self->_store_name(
  1613. $defined_name->{name},
  1614. $defined_name->{encoding},
  1615. $defined_name->{sheet_index},
  1616. $defined_name->{formula},
  1617. );
  1618. }
  1619. # Sort the worksheets into alphabetical order by name. This is a
  1620. # requirement for some non-English language Excel patch levels.
  1621. my @worksheets = @{$self->{_worksheets}};
  1622. @worksheets = sort { $a->{_name} cmp $b->{_name} } @worksheets;
  1623. # Create the autofilter NAME records
  1624. foreach my $worksheet (@worksheets) {
  1625. $index = $worksheet->{_index};
  1626. my $key = "$index:$index";
  1627. my $ref = $ext_refs{$key};
  1628. # Write a Name record if Autofilter has been defined
  1629. if ($worksheet->{_filter_count}) {
  1630. $self->_store_name_short(
  1631. $worksheet->{_index},
  1632. 0x0D, # NAME type = Filter Database
  1633. $ref,
  1634. $worksheet->{_filter_area}->[0],
  1635. $worksheet->{_filter_area}->[1],
  1636. $worksheet->{_filter_area}->[2],
  1637. $worksheet->{_filter_area}->[3],
  1638. 1, # Hidden
  1639. );
  1640. }
  1641. }
  1642. # Create the print area NAME records
  1643. foreach my $worksheet (@worksheets) {
  1644. $index = $worksheet->{_index};
  1645. my $key = "$index:$index";
  1646. my $ref = $ext_refs{$key};
  1647. # Write a Name record if the print area has been defined
  1648. if (defined $worksheet->{_print_rowmin}) {
  1649. $self->_store_name_short(
  1650. $worksheet->{_index},
  1651. 0x06, # NAME type = Print_Area
  1652. $ref,
  1653. $worksheet->{_print_rowmin},
  1654. $worksheet->{_print_rowmax},
  1655. $worksheet->{_print_colmin},
  1656. $worksheet->{_print_colmax}
  1657. );
  1658. }
  1659. }
  1660. # Create the print title NAME records
  1661. foreach my $worksheet (@worksheets) {
  1662. $index = $worksheet->{_index};
  1663. my $rowmin = $worksheet->{_title_rowmin};
  1664. my $rowmax = $worksheet->{_title_rowmax};
  1665. my $colmin = $worksheet->{_title_colmin};
  1666. my $colmax = $worksheet->{_title_colmax};
  1667. my $key = "$index:$index";
  1668. my $ref = $ext_refs{$key};
  1669. # Determine if row + col, row, col or nothing has been defined
  1670. # and write the appropriate record
  1671. #
  1672. if (defined $rowmin && defined $colmin) {
  1673. # Row and column titles have been defined.
  1674. # Row title has been defined.
  1675. $self->_store_name_long(
  1676. $worksheet->{_index},
  1677. 0x07, # NAME type = Print_Titles
  1678. $ref,
  1679. $rowmin,
  1680. $rowmax,
  1681. $colmin,
  1682. $colmax
  1683. );
  1684. }
  1685. elsif (defined $rowmin) {
  1686. # Row title has been defined.
  1687. $self->_store_name_short(
  1688. $worksheet->{_index},
  1689. 0x07, # NAME type = Print_Titles
  1690. $ref,
  1691. $rowmin,
  1692. $rowmax,
  1693. 0x00,
  1694. 0xff
  1695. );
  1696. }
  1697. elsif (defined $colmin) {
  1698. # Column title has been defined.
  1699. $self->_store_name_short(
  1700. $worksheet->{_index},
  1701. 0x07, # NAME type = Print_Titles
  1702. $ref,
  1703. 0x0000,
  1704. 0xffff,
  1705. $colmin,
  1706. $colmax
  1707. );
  1708. }
  1709. else {
  1710. # Nothing left to do
  1711. }
  1712. }
  1713. }
  1714. ###############################################################################
  1715. ###############################################################################
  1716. #
  1717. # BIFF RECORDS
  1718. #
  1719. ###############################################################################
  1720. #
  1721. # _store_window1()
  1722. #
  1723. # Write Excel BIFF WINDOW1 record.
  1724. #
  1725. sub _store_window1 {
  1726. my $self = shift;
  1727. my $record = 0x003D; # Record identifier
  1728. my $length = 0x0012; # Number of bytes to follow
  1729. my $xWn = 0x0000; # Horizontal position of window
  1730. my $yWn = 0x0000; # Vertical position of window
  1731. my $dxWn = 0x355C; # Width of window
  1732. my $dyWn = 0x30ED; # Height of window
  1733. my $grbit = 0x0038; # Option flags
  1734. my $ctabsel = $self->{_selected}; # Number of workbook tabs selected
  1735. my $wTabRatio = 0x0258; # Tab to scrollbar ratio
  1736. my $itabFirst = $self->{_firstsheet}; # 1st displayed worksheet
  1737. my $itabCur = $self->{_activesheet}; # Active worksheet
  1738. my $header = pack("vv", $record, $length);
  1739. my $data = pack("vvvvvvvvv", $xWn, $yWn, $dxWn, $dyWn,
  1740. $grbit,
  1741. $itabCur, $itabFirst,
  1742. $ctabsel, $wTabRatio);
  1743. $self->_append($header, $data);
  1744. }
  1745. ###############################################################################
  1746. #
  1747. # _store_boundsheet()
  1748. #
  1749. # Writes Excel BIFF BOUNDSHEET record.
  1750. #
  1751. sub _store_boundsheet {
  1752. my $self = shift;
  1753. my $record = 0x0085; # Record identifier
  1754. my $length = 0x08 + length($_[0]); # Number of bytes to follow
  1755. my $sheetname = $_[0]; # Worksheet name
  1756. my $offset = $_[1]; # Location of worksheet BOF
  1757. my $type = $_[2]; # Worksheet type
  1758. my $hidden = $_[3]; # Worksheet hidden flag
  1759. my $encoding = $_[4]; # Sheet name encoding
  1760. my $cch = length($sheetname); # Length of sheet name
  1761. my $grbit = $type | $hidden;
  1762. # Character length is num of chars not num of bytes
  1763. $cch /= 2 if $encoding;
  1764. # Change the UTF-16 name from BE to LE
  1765. $sheetname = pack 'n*', unpack 'v*', $sheetname if $encoding;
  1766. my $header = pack("vv", $record, $length);
  1767. my $data = pack("VvCC", $offset, $grbit, $cch, $encoding);
  1768. $self->_append($header, $data, $sheetname);
  1769. }
  1770. ###############################################################################
  1771. #
  1772. # _store_style()
  1773. #
  1774. # Write Excel BIFF STYLE records.
  1775. #
  1776. sub _store_style {
  1777. my $self = shift;
  1778. my $record = 0x0293; # Record identifier
  1779. my $length = 0x0004; # Bytes to follow
  1780. my $type = $_[0]; # Built-in style
  1781. my $xf_index = $_[1]; # Index to style XF
  1782. my $level = 0xff; # Outline style level
  1783. $xf_index |= 0x8000; # Add flag to indicate built-in style.
  1784. my $header = pack("vv", $record, $length);
  1785. my $data = pack("vCC", $xf_index, $type, $level);
  1786. $self->_append($header, $data);
  1787. }
  1788. ###############################################################################
  1789. #
  1790. # _store_num_format()
  1791. #
  1792. # Writes Excel FORMAT record for non "built-in" numerical formats.
  1793. #
  1794. sub _store_num_format {
  1795. my $self = shift;
  1796. my $record = 0x041E; # Record identifier
  1797. my $length; # Number of bytes to follow
  1798. my $format = $_[0]; # Custom format string
  1799. my $ifmt = $_[1]; # Format index code
  1800. my $encoding = $_[2]; # Char encoding for format string
  1801. # Handle utf8 strings in perl 5.8.
  1802. if ($] >= 5.008) {
  1803. require Encode;
  1804. if (Encode::is_utf8($format)) {
  1805. $format = Encode::encode("UTF-16BE", $format);
  1806. $encoding = 1;
  1807. }
  1808. }
  1809. # Char length of format string
  1810. my $cch = length $format;
  1811. # Handle Unicode format strings.
  1812. if ($encoding == 1) {
  1813. croak "Uneven number of bytes in Unicode font name" if $cch % 2;
  1814. $cch /= 2 if $encoding;
  1815. $format = pack 'v*', unpack 'n*', $format;
  1816. }
  1817. # Special case to handle Euro symbol, 0x80, in non-Unicode strings.
  1818. if ($encoding == 0 and $format =~ /\x80/) {
  1819. $format = pack 'v*', unpack 'C*', $format;
  1820. $format =~ s/\x80\x00/\xAC\x20/g;
  1821. $encoding = 1;
  1822. }
  1823. $length = 0x05 + length $format;
  1824. my $header = pack("vv", $record, $length);
  1825. my $data = pack("vvC", $ifmt, $cch, $encoding);
  1826. $self->_append($header, $data, $format);
  1827. }
  1828. ###############################################################################
  1829. #
  1830. # _store_1904()
  1831. #
  1832. # Write Excel 1904 record to indicate the date system in use.
  1833. #
  1834. sub _store_1904 {
  1835. my $self = shift;
  1836. my $record = 0x0022; # Record identifier
  1837. my $length = 0x0002; # Bytes to follow
  1838. my $f1904 = $self->{_1904}; # Flag for 1904 date system
  1839. my $header = pack("vv", $record, $length);
  1840. my $data = pack("v", $f1904);
  1841. $self->_append($header, $data);
  1842. }
  1843. ###############################################################################
  1844. #
  1845. # _store_supbook()
  1846. #
  1847. # Write BIFF record SUPBOOK to indicate that the workbook contains external
  1848. # references, in our case, formula, print area and print title refs.
  1849. #
  1850. sub _store_supbook {
  1851. my $self = shift;
  1852. my $record = 0x01AE; # Record identifier
  1853. my $length = 0x0004; # Number of bytes to follow
  1854. my $ctabs = @{$self->{_worksheets}}; # Number of worksheets
  1855. my $StVirtPath = 0x0401; # Encoded workbook filename
  1856. my $header = pack("vv", $record, $length);
  1857. my $data = pack("vv", $ctabs, $StVirtPath);
  1858. $self->_append($header, $data);
  1859. }
  1860. ###############################################################################
  1861. #
  1862. # _store_externsheet()
  1863. #
  1864. # Writes the Excel BIFF EXTERNSHEET record. These references are used by
  1865. # formulas. TODO NAME record is required to define the print area and the
  1866. # repeat rows and columns.
  1867. #
  1868. sub _store_externsheet {
  1869. my $self = shift;
  1870. my $record = 0x0017; # Record identifier
  1871. my $length; # Number of bytes to follow
  1872. # Get the external refs
  1873. my %ext_refs = %{$self->{_ext_refs}};
  1874. my @ext_refs = sort {$ext_refs{$a} <=> $ext_refs{$b}} keys %ext_refs;
  1875. # Change the external refs from stringified "1:1" to [1, 1]
  1876. foreach my $ref (@ext_refs) {
  1877. $ref = [split /:/, $ref];
  1878. }
  1879. my $cxti = scalar @ext_refs; # Number of Excel XTI structures
  1880. my $rgxti = ''; # Array of XTI structures
  1881. # Write the XTI structs
  1882. foreach my $ext_ref (@ext_refs) {
  1883. $rgxti .= pack("vvv", 0, $ext_ref->[0], $ext_ref->[1])
  1884. }
  1885. my $data = pack("v", $cxti) . $rgxti;
  1886. my $header = pack("vv", $record, length $data);
  1887. $self->_append($header, $data);
  1888. }
  1889. ###############################################################################
  1890. #
  1891. # _store_name()
  1892. #
  1893. #
  1894. # Store the NAME record used for storing the print area, repeat rows, repeat
  1895. # columns, autofilters and defined names.
  1896. #
  1897. # TODO. This is a more generic version that will replace _store_name_short()
  1898. # and _store_name_long().
  1899. #
  1900. sub _store_name {
  1901. my $self = shift;
  1902. my $record = 0x0018; # Record identifier
  1903. my $length; # Number of bytes to follow
  1904. my $name = shift;
  1905. my $encoding = shift;
  1906. my $sheet_index = shift;
  1907. my $formula = shift;
  1908. my $text_length = length $name;
  1909. my $formula_length = length $formula;
  1910. # UTF-16 string length is in characters not bytes.
  1911. $text_length /= 2 if $encoding;
  1912. my $grbit = 0x0000; # Option flags
  1913. my $shortcut = 0x00; # Keyboard shortcut
  1914. my $ixals = 0x0000; # Unused index.
  1915. my $menu_length = 0x00; # Length of cust menu text
  1916. my $desc_length = 0x00; # Length of description text
  1917. my $help_length = 0x00; # Length of help topic text
  1918. my $status_length = 0x00; # Length of status bar text
  1919. # Set grbit built-in flag and the hidden flag for autofilters.
  1920. if ($text_length == 1) {
  1921. $grbit = 0x0020 if ord $name == 0x06; # Print area
  1922. $grbit = 0x0020 if ord $name == 0x07; # Print titles
  1923. $grbit = 0x0021 if ord $name == 0x0D; # Autofilter
  1924. }
  1925. my $data = pack "v", $grbit;
  1926. $data .= pack "C", $shortcut;
  1927. $data .= pack "C", $text_length;
  1928. $data .= pack "v", $formula_length;
  1929. $data .= pack "v", $ixals;
  1930. $data .= pack "v", $sheet_index;
  1931. $data .= pack "C", $menu_length;
  1932. $data .= pack "C", $desc_length;
  1933. $data .= pack "C", $help_length;
  1934. $data .= pack "C", $status_length;
  1935. $data .= pack "C", $encoding;
  1936. $data .= $name;
  1937. $data .= $formula;
  1938. my $header = pack "vv", $record, length $data;
  1939. $self->_append($header, $data);
  1940. }
  1941. ###############################################################################
  1942. #
  1943. # _store_name_short()
  1944. #
  1945. #
  1946. # Store the NAME record in the short format that is used for storing the print
  1947. # area, repeat rows only and repeat columns only.
  1948. #
  1949. sub _store_name_short {
  1950. my $self = shift;
  1951. my $record = 0x0018; # Record identifier
  1952. my $length = 0x001b; # Number of bytes to follow
  1953. my $index = shift; # Sheet index
  1954. my $type = shift;
  1955. my $ext_ref = shift; # TODO
  1956. my $grbit = 0x0020; # Option flags
  1957. my $chKey = 0x00; # Keyboard shortcut
  1958. my $cch = 0x01; # Length of text name
  1959. my $cce = 0x000b; # Length of text definition
  1960. my $unknown01 = 0x0000; #
  1961. my $ixals = $index +1; # Sheet index
  1962. my $unknown02 = 0x00; #
  1963. my $cchCustMenu = 0x00; # Length of cust menu text
  1964. my $cchDescription = 0x00; # Length of description text
  1965. my $cchHelptopic = 0x00; # Length of help topic text
  1966. my $cchStatustext = 0x00; # Length of status bar text
  1967. my $rgch = $type; # Built-in name type
  1968. my $unknown03 = 0x3b; #
  1969. my $rowmin = $_[0]; # Start row
  1970. my $rowmax = $_[1]; # End row
  1971. my $colmin = $_[2]; # Start column
  1972. my $colmax = $_[3]; # end column
  1973. my $hidden = $_[4]; # Name is hidden
  1974. $grbit = 0x0021 if $hidden;
  1975. my $header = pack("vv", $record, $length);
  1976. my $data = pack("v", $grbit);
  1977. $data .= pack("C", $chKey);
  1978. $data .= pack("C", $cch);
  1979. $data .= pack("v", $cce);
  1980. $data .= pack("v", $unknown01);
  1981. $data .= pack("v", $ixals);
  1982. $data .= pack("C", $unknown02);
  1983. $data .= pack("C", $cchCustMenu);
  1984. $data .= pack("C", $cchDescription);
  1985. $data .= pack("C", $cchHelptopic);
  1986. $data .= pack("C", $cchStatustext);
  1987. $data .= pack("C", $rgch);
  1988. $data .= pack("C", $unknown03);
  1989. $data .= pack("v", $ext_ref);
  1990. $data .= pack("v", $rowmin);
  1991. $data .= pack("v", $rowmax);
  1992. $data .= pack("v", $colmin);
  1993. $data .= pack("v", $colmax);
  1994. $self->_append($header, $data);
  1995. }
  1996. ###############################################################################
  1997. #
  1998. # _store_name_long()
  1999. #
  2000. #
  2001. # Store the NAME record in the long format that is used for storing the repeat
  2002. # rows and columns when both are specified. This share a lot of code with
  2003. # _store_name_short() but we use a separate method to keep the code clean.
  2004. # Code abstraction for reuse can be carried too far, and I should know. ;-)
  2005. #
  2006. sub _store_name_long {
  2007. my $self = shift;
  2008. my $record = 0x0018; # Record identifier
  2009. my $length = 0x002a; # Number of bytes to follow
  2010. my $index = shift; # Sheet index
  2011. my $type = shift;
  2012. my $ext_ref = shift; # TODO
  2013. my $grbit = 0x0020; # Option flags
  2014. my $chKey = 0x00; # Keyboard shortcut
  2015. my $cch = 0x01; # Length of text name
  2016. my $cce = 0x001a; # Length of text definition
  2017. my $unknown01 = 0x0000; #
  2018. my $ixals = $index +1; # Sheet index
  2019. my $unknown02 = 0x00; #
  2020. my $cchCustMenu = 0x00; # Length of cust menu text
  2021. my $cchDescription = 0x00; # Length of description text
  2022. my $cchHelptopic = 0x00; # Length of help topic text
  2023. my $cchStatustext = 0x00; # Length of status bar text
  2024. my $rgch = $type; # Built-in name type
  2025. my $unknown03 = 0x29;
  2026. my $unknown04 = 0x0017;
  2027. my $unknown05 = 0x3b;
  2028. my $rowmin = $_[0]; # Start row
  2029. my $rowmax = $_[1]; # End row
  2030. my $colmin = $_[2]; # Start column
  2031. my $colmax = $_[3]; # end column
  2032. my $header = pack("vv", $record, $length);
  2033. my $data = pack("v", $grbit);
  2034. $data .= pack("C", $chKey);
  2035. $data .= pack("C", $cch);
  2036. $data .= pack("v", $cce);
  2037. $data .= pack("v", $unknown01);
  2038. $data .= pack("v", $ixals);
  2039. $data .= pack("C", $unknown02);
  2040. $data .= pack("C", $cchCustMenu);
  2041. $data .= pack("C", $cchDescription);
  2042. $data .= pack("C", $cchHelptopic);
  2043. $data .= pack("C", $cchStatustext);
  2044. $data .= pack("C", $rgch);
  2045. # Column definition
  2046. $data .= pack("C", $unknown03);
  2047. $data .= pack("v", $unknown04);
  2048. $data .= pack("C", $unknown05);
  2049. $data .= pack("v", $ext_ref);
  2050. $data .= pack("v", 0x0000);
  2051. $data .= pack("v", 0xffff);
  2052. $data .= pack("v", $colmin);
  2053. $data .= pack("v", $colmax);
  2054. # Row definition
  2055. $data .= pack("C", $unknown05);
  2056. $data .= pack("v", $ext_ref);
  2057. $data .= pack("v", $rowmin);
  2058. $data .= pack("v", $rowmax);
  2059. $data .= pack("v", 0x00);
  2060. $data .= pack("v", 0xff);
  2061. # End of data
  2062. $data .= pack("C", 0x10);
  2063. $self->_append($header, $data);
  2064. }
  2065. ###############################################################################
  2066. #
  2067. # _store_palette()
  2068. #
  2069. # Stores the PALETTE biff record.
  2070. #
  2071. sub _store_palette {
  2072. my $self = shift;
  2073. my $aref = $self->{_palette};
  2074. my $record = 0x0092; # Record identifier
  2075. my $length = 2 + 4 * @$aref; # Number of bytes to follow
  2076. my $ccv = @$aref; # Number of RGB values to follow
  2077. my $data; # The RGB data
  2078. # Pack the RGB data
  2079. $data .= pack "CCCC", @$_ for @$aref;
  2080. my $header = pack("vvv", $record, $length, $ccv);
  2081. $self->_append($header, $data);
  2082. }
  2083. ###############################################################################
  2084. #
  2085. # _store_codepage()
  2086. #
  2087. # Stores the CODEPAGE biff record.
  2088. #
  2089. sub _store_codepage {
  2090. my $self = shift;
  2091. my $record = 0x0042; # Record identifier
  2092. my $length = 0x0002; # Number of bytes to follow
  2093. my $cv = $self->{_codepage}; # The code page
  2094. my $header = pack("vv", $record, $length);
  2095. my $data = pack("v", $cv);
  2096. $self->_append($header, $data);
  2097. }
  2098. ###############################################################################
  2099. #
  2100. # _store_country()
  2101. #
  2102. # Stores the COUNTRY biff record.
  2103. #
  2104. sub _store_country {
  2105. my $self = shift;
  2106. my $record = 0x008C; # Record identifier
  2107. my $length = 0x0004; # Number of bytes to follow
  2108. my $country_default = $self->{_country};
  2109. my $country_win_ini = $self->{_country};
  2110. my $header = pack("vv", $record, $length);
  2111. my $data = pack("vv", $country_default, $country_win_ini);
  2112. $self->_append($header, $data);
  2113. }
  2114. ###############################################################################
  2115. #
  2116. # _store_hideobj()
  2117. #
  2118. # Stores the HIDEOBJ biff record.
  2119. #
  2120. sub _store_hideobj {
  2121. my $self = shift;
  2122. my $record = 0x008D; # Record identifier
  2123. my $length = 0x0002; # Number of bytes to follow
  2124. my $hide = $self->{_hideobj}; # Option to hide objects
  2125. my $header = pack("vv", $record, $length);
  2126. my $data = pack("v", $hide);
  2127. $self->_append($header, $data);
  2128. }
  2129. ###############################################################################
  2130. ###############################################################################
  2131. ###############################################################################
  2132. ###############################################################################
  2133. #
  2134. # _calculate_extern_sizes()
  2135. #
  2136. # We need to calculate the space required by the SUPBOOK, EXTERNSHEET and NAME
  2137. # records so that it can be added to the BOUNDSHEET offsets.
  2138. #
  2139. sub _calculate_extern_sizes {
  2140. my $self = shift;
  2141. my %ext_refs = $self->{_parser}->get_ext_sheets();
  2142. my $ext_ref_count = scalar keys %ext_refs;
  2143. my $length = 0;
  2144. my $index = 0;
  2145. if (@{$self->{_defined_names}}) {
  2146. my $index = 0;
  2147. my $key = "$index:$index";
  2148. if (not exists $ext_refs{$key}) {
  2149. $ext_refs{$key} = $ext_ref_count++;
  2150. }
  2151. }
  2152. for my $defined_name (@{$self->{_defined_names}}) {
  2153. $length += 19
  2154. + length($defined_name->{name})
  2155. + length($defined_name->{formula});
  2156. }
  2157. foreach my $worksheet (@{$self->{_worksheets}}) {
  2158. my $rowmin = $worksheet->{_title_rowmin};
  2159. my $colmin = $worksheet->{_title_colmin};
  2160. my $filter = $worksheet->{_filter_count};
  2161. my $key = "$index:$index";
  2162. $index++;
  2163. # Add area NAME records
  2164. #
  2165. if (defined $worksheet->{_print_rowmin}) {
  2166. $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
  2167. $length += 31 ;
  2168. }
  2169. # Add title NAME records
  2170. #
  2171. if (defined $rowmin and defined $colmin) {
  2172. $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
  2173. $length += 46;
  2174. }
  2175. elsif (defined $rowmin or defined $colmin) {
  2176. $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
  2177. $length += 31;
  2178. }
  2179. else {
  2180. # TODO, may need this later.
  2181. }
  2182. # Add Autofilter NAME records
  2183. #
  2184. if ($filter) {
  2185. $ext_refs{$key} = $ext_ref_count++ if not exists $ext_refs{$key};
  2186. $length += 31;
  2187. }
  2188. }
  2189. # Update the ref counts.
  2190. $self->{_ext_ref_count} = $ext_ref_count;
  2191. $self->{_ext_refs} = {%ext_refs};
  2192. # If there are no external refs then we don't write, SUPBOOK, EXTERNSHEET
  2193. # and NAME. Therefore the length is 0.
  2194. return $length = 0 if $ext_ref_count == 0;
  2195. # The SUPBOOK record is 8 bytes
  2196. $length += 8;
  2197. # The EXTERNSHEET record is 6 bytes + 6 bytes for each external ref
  2198. $length += 6 * (1 + $ext_ref_count);
  2199. return $length;
  2200. }
  2201. ###############################################################################
  2202. #
  2203. # _calculate_shared_string_sizes()
  2204. #
  2205. # Handling of the SST continue blocks is complicated by the need to include an
  2206. # additional continuation byte depending on whether the string is split between
  2207. # blocks or whether it starts at the beginning of the block. (There are also
  2208. # additional complications that will arise later when/if Rich Strings are
  2209. # supported). As such we cannot use the simple CONTINUE mechanism provided by
  2210. # the _add_continue() method in BIFFwriter.pm. Thus we have to make two passes
  2211. # through the strings data. The first is to calculate the required block sizes
  2212. # and the second, in _store_shared_strings(), is to write the actual strings.
  2213. # The first pass through the data is also used to calculate the size of the SST
  2214. # and CONTINUE records for use in setting the BOUNDSHEET record offsets. The
  2215. # downside of this is that the same algorithm repeated in _store_shared_strings.
  2216. #
  2217. sub _calculate_shared_string_sizes {
  2218. my $self = shift;
  2219. my @strings;
  2220. $#strings = $self->{_str_unique} -1; # Pre-extend array
  2221. while (my $key = each %{$self->{_str_table}}) {
  2222. $strings[$self->{_str_table}->{$key}] = $key;
  2223. }
  2224. # The SST data could be very large, free some memory (maybe).
  2225. $self->{_str_table} = undef;
  2226. $self->{_str_array} = [@strings];
  2227. # Iterate through the strings to calculate the CONTINUE block sizes.
  2228. #
  2229. # The SST blocks requires a specialised CONTINUE block, so we have to
  2230. # ensure that the maximum data block size is less than the limit used by
  2231. # _add_continue() in BIFFwriter.pm. For simplicity we use the same size
  2232. # for the SST and CONTINUE records:
  2233. # 8228 : Maximum Excel97 block size
  2234. # -4 : Length of block header
  2235. # -8 : Length of additional SST header information
  2236. # -8 : Arbitrary number to keep within _add_continue() limit
  2237. # = 8208
  2238. #
  2239. my $continue_limit = 8208;
  2240. my $block_length = 0;
  2241. my $written = 0;
  2242. my @block_sizes;
  2243. my $continue = 0;
  2244. for my $string (@strings) {
  2245. my $string_length = length $string;
  2246. my $encoding = unpack "xx C", $string;
  2247. my $split_string = 0;
  2248. # Block length is the total length of the strings that will be
  2249. # written out in a single SST or CONTINUE block.
  2250. #
  2251. $block_length += $string_length;
  2252. # We can write the string if it doesn't cross a CONTINUE boundary
  2253. if ($block_length < $continue_limit) {
  2254. $written += $string_length;
  2255. next;
  2256. }
  2257. # Deal with the cases where the next string to be written will exceed
  2258. # the CONTINUE boundary. If the string is very long it may need to be
  2259. # written in more than one CONTINUE record.
  2260. #
  2261. while ($block_length >= $continue_limit) {
  2262. # We need to avoid the case where a string is continued in the first
  2263. # n bytes that contain the string header information.
  2264. #
  2265. my $header_length = 3; # Min string + header size -1
  2266. my $space_remaining = $continue_limit -$written -$continue;
  2267. # Unicode data should only be split on char (2 byte) boundaries.
  2268. # Therefore, in some cases we need to reduce the amount of available
  2269. # space by 1 byte to ensure the correct alignment.
  2270. my $align = 0;
  2271. # Only applies to Unicode strings
  2272. if ($encoding == 1) {
  2273. # Min string + header size -1
  2274. $header_length = 4;
  2275. if ($space_remaining > $header_length) {
  2276. # String contains 3 byte header => split on odd boundary
  2277. if (not $split_string and $space_remaining % 2 != 1) {
  2278. $space_remaining--;
  2279. $align = 1;
  2280. }
  2281. # Split section without header => split on even boundary
  2282. elsif ($split_string and $space_remaining % 2 == 1) {
  2283. $space_remaining--;
  2284. $align = 1;
  2285. }
  2286. $split_string = 1;
  2287. }
  2288. }
  2289. if ($space_remaining > $header_length) {
  2290. # Write as much as possible of the string in the current block
  2291. $written += $space_remaining;
  2292. # Reduce the current block length by the amount written
  2293. $block_length -= $continue_limit -$continue -$align;
  2294. # Store the max size for this block
  2295. push @block_sizes, $continue_limit -$align;
  2296. # If the current string was split then the next CONTINUE block
  2297. # should have the string continue flag (grbit) set unless the
  2298. # split string fits exactly into the remaining space.
  2299. #
  2300. if ($block_length > 0) {
  2301. $continue = 1;
  2302. }
  2303. else {
  2304. $continue = 0;
  2305. }
  2306. }
  2307. else {
  2308. # Store the max size for this block
  2309. push @block_sizes, $written +$continue;
  2310. # Not enough space to start the string in the current block
  2311. $block_length -= $continue_limit -$space_remaining -$continue;
  2312. $continue = 0;
  2313. }
  2314. # If the string (or substr) is small enough we can write it in the
  2315. # new CONTINUE block. Else, go through the loop again to write it in
  2316. # one or more CONTINUE blocks
  2317. #
  2318. if ($block_length < $continue_limit) {
  2319. $written = $block_length;
  2320. }
  2321. else {
  2322. $written = 0;
  2323. }
  2324. }
  2325. }
  2326. # Store the max size for the last block unless it is empty
  2327. push @block_sizes, $written +$continue if $written +$continue;
  2328. $self->{_str_block_sizes} = [@block_sizes];
  2329. # Calculate the total length of the SST and associated CONTINUEs (if any).
  2330. # The SST record will have a length even if it contains no strings.
  2331. # This length is required to set the offsets in the BOUNDSHEET records since
  2332. # they must be written before the SST records
  2333. #
  2334. my $length = 12;
  2335. $length += shift @block_sizes if @block_sizes; # SST
  2336. $length += 4 + shift @block_sizes while @block_sizes; # CONTINUEs
  2337. return $length;
  2338. }
  2339. ###############################################################################
  2340. #
  2341. # _store_shared_strings()
  2342. #
  2343. # Write all of the workbooks strings into an indexed array.
  2344. #
  2345. # See the comments in _calculate_shared_string_sizes() for more information.
  2346. #
  2347. # We also use this routine to record the offsets required by the EXTSST table.
  2348. # In order to do this we first identify the first string in an EXTSST bucket
  2349. # and then store its global and local offset within the SST table. The offset
  2350. # occurs wherever the start of the bucket string is written out via append().
  2351. #
  2352. sub _store_shared_strings {
  2353. my $self = shift;
  2354. my @strings = @{$self->{_str_array}};
  2355. my $record = 0x00FC; # Record identifier
  2356. my $length = 0x0008; # Number of bytes to follow
  2357. my $total = 0x0000;
  2358. # Iterate through the strings to calculate the CONTINUE block sizes
  2359. my $continue_limit = 8208;
  2360. my $block_length = 0;
  2361. my $written = 0;
  2362. my $continue = 0;
  2363. # The SST and CONTINUE block sizes have been pre-calculated by
  2364. # _calculate_shared_string_sizes()
  2365. my @block_sizes = @{$self->{_str_block_sizes}};
  2366. # The SST record is required even if it contains no strings. Thus we will
  2367. # always have a length
  2368. #
  2369. if (@block_sizes) {
  2370. $length = 8 + shift @block_sizes;
  2371. }
  2372. else {
  2373. # No strings
  2374. $length = 8;
  2375. }
  2376. # Initialise variables used to track EXTSST bucket offsets.
  2377. my $extsst_str_num = -1;
  2378. my $sst_block_start = $self->{_datasize};
  2379. # Write the SST block header information
  2380. my $header = pack("vv", $record, $length);
  2381. my $data = pack("VV", $self->{_str_total}, $self->{_str_unique});
  2382. $self->_append($header, $data);
  2383. # Iterate through the strings and write them out
  2384. for my $string (@strings) {
  2385. my $string_length = length $string;
  2386. my $encoding = unpack "xx C", $string;
  2387. my $split_string = 0;
  2388. my $bucket_string = 0; # Used to track EXTSST bucket offsets.
  2389. # Check if the string is at the start of a EXTSST bucket.
  2390. if (++$extsst_str_num % $self->{_extsst_bucket_size} == 0) {
  2391. $bucket_string = 1;
  2392. }
  2393. # Block length is the total length of the strings that will be
  2394. # written out in a single SST or CONTINUE block.
  2395. #
  2396. $block_length += $string_length;
  2397. # We can write the string if it doesn't cross a CONTINUE boundary
  2398. if ($block_length < $continue_limit) {
  2399. # Store location of EXTSST bucket string.
  2400. if ($bucket_string) {
  2401. my $global_offset = $self->{_datasize};
  2402. my $local_offset = $self->{_datasize} - $sst_block_start;
  2403. push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  2404. $bucket_string = 0;
  2405. }
  2406. $self->_append($string);
  2407. $written += $string_length;
  2408. next;
  2409. }
  2410. # Deal with the cases where the next string to be written will exceed
  2411. # the CONTINUE boundary. If the string is very long it may need to be
  2412. # written in more than one CONTINUE record.
  2413. #
  2414. while ($block_length >= $continue_limit) {
  2415. # We need to avoid the case where a string is continued in the first
  2416. # n bytes that contain the string header information.
  2417. #
  2418. my $header_length = 3; # Min string + header size -1
  2419. my $space_remaining = $continue_limit -$written -$continue;
  2420. # Unicode data should only be split on char (2 byte) boundaries.
  2421. # Therefore, in some cases we need to reduce the amount of available
  2422. # space by 1 byte to ensure the correct alignment.
  2423. my $align = 0;
  2424. # Only applies to Unicode strings
  2425. if ($encoding == 1) {
  2426. # Min string + header size -1
  2427. $header_length = 4;
  2428. if ($space_remaining > $header_length) {
  2429. # String contains 3 byte header => split on odd boundary
  2430. if (not $split_string and $space_remaining % 2 != 1) {
  2431. $space_remaining--;
  2432. $align = 1;
  2433. }
  2434. # Split section without header => split on even boundary
  2435. elsif ($split_string and $space_remaining % 2 == 1) {
  2436. $space_remaining--;
  2437. $align = 1;
  2438. }
  2439. $split_string = 1;
  2440. }
  2441. }
  2442. if ($space_remaining > $header_length) {
  2443. # Write as much as possible of the string in the current block
  2444. my $tmp = substr $string, 0, $space_remaining;
  2445. # Store location of EXTSST bucket string.
  2446. if ($bucket_string) {
  2447. my $global_offset = $self->{_datasize};
  2448. my $local_offset = $self->{_datasize} - $sst_block_start;
  2449. push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  2450. $bucket_string = 0;
  2451. }
  2452. $self->_append($tmp);
  2453. # The remainder will be written in the next block(s)
  2454. $string = substr $string, $space_remaining;
  2455. # Reduce the current block length by the amount written
  2456. $block_length -= $continue_limit -$continue -$align;
  2457. # If the current string was split then the next CONTINUE block
  2458. # should have the string continue flag (grbit) set unless the
  2459. # split string fits exactly into the remaining space.
  2460. #
  2461. if ($block_length > 0) {
  2462. $continue = 1;
  2463. }
  2464. else {
  2465. $continue = 0;
  2466. }
  2467. }
  2468. else {
  2469. # Not enough space to start the string in the current block
  2470. $block_length -= $continue_limit -$space_remaining -$continue;
  2471. $continue = 0;
  2472. }
  2473. # Write the CONTINUE block header
  2474. if (@block_sizes) {
  2475. $sst_block_start= $self->{_datasize}; # Reset EXTSST offset.
  2476. $record = 0x003C;
  2477. $length = shift @block_sizes;
  2478. $header = pack("vv", $record, $length);
  2479. $header .= pack("C", $encoding) if $continue;
  2480. $self->_append($header);
  2481. }
  2482. # If the string (or substr) is small enough we can write it in the
  2483. # new CONTINUE block. Else, go through the loop again to write it in
  2484. # one or more CONTINUE blocks
  2485. #
  2486. if ($block_length < $continue_limit) {
  2487. # Store location of EXTSST bucket string.
  2488. if ($bucket_string) {
  2489. my $global_offset = $self->{_datasize};
  2490. my $local_offset = $self->{_datasize} - $sst_block_start;
  2491. push @{$self->{_extsst_offsets}}, [$global_offset, $local_offset];
  2492. $bucket_string = 0;
  2493. }
  2494. $self->_append($string);
  2495. $written = $block_length;
  2496. }
  2497. else {
  2498. $written = 0;
  2499. }
  2500. }
  2501. }
  2502. }
  2503. ###############################################################################
  2504. #
  2505. # _calculate_extsst_size
  2506. #
  2507. # The number of buckets used in the EXTSST is between 0 and 128. The number of
  2508. # strings per bucket (bucket size) has a minimum value of 8 and a theoretical
  2509. # maximum of 2^16. For "number of strings" < 1024 there is a constant bucket
  2510. # size of 8. The following algorithm generates the same size/bucket ratio
  2511. # as Excel.
  2512. #
  2513. sub _calculate_extsst_size {
  2514. my $self = shift;
  2515. my $unique_strings = $self->{_str_unique};
  2516. my $bucket_size;
  2517. my $buckets;
  2518. if ($unique_strings < 1024) {
  2519. $bucket_size = 8;
  2520. }
  2521. else {
  2522. $bucket_size = 1 + int($unique_strings / 128);
  2523. }
  2524. $buckets = int(($unique_strings + $bucket_size -1) / $bucket_size);
  2525. $self->{_extsst_buckets} = $buckets ;
  2526. $self->{_extsst_bucket_size} = $bucket_size;
  2527. return 6 + 8 * $buckets;
  2528. }
  2529. ###############################################################################
  2530. #
  2531. # _store_extsst
  2532. #
  2533. # Write EXTSST table using the offsets calculated in _store_shared_strings().
  2534. #
  2535. sub _store_extsst {
  2536. my $self = shift;
  2537. my @offsets = @{$self->{_extsst_offsets}};
  2538. my $bucket_size = $self->{_extsst_bucket_size};
  2539. my $record = 0x00FF; # Record identifier
  2540. my $length = 2 + 8 * @offsets; # Bytes to follow
  2541. my $header = pack 'vv', $record, $length;
  2542. my $data = pack 'v', $bucket_size,;
  2543. for my $offset (@offsets) {
  2544. $data .= pack 'Vvv', $offset->[0], $offset->[1], 0;
  2545. }
  2546. $self->_append($header, $data);
  2547. }
  2548. #
  2549. # Methods related to comments and MSO objects.
  2550. #
  2551. ###############################################################################
  2552. #
  2553. # _add_mso_drawing_group()
  2554. #
  2555. # Write the MSODRAWINGGROUP record that keeps track of the Escher drawing
  2556. # objects in the file such as images, comments and filters.
  2557. #
  2558. sub _add_mso_drawing_group {
  2559. my $self = shift;
  2560. return unless $self->{_mso_size};
  2561. my $record = 0x00EB; # Record identifier
  2562. my $length = 0x0000; # Number of bytes to follow
  2563. my $data = $self->_store_mso_dgg_container();
  2564. $data .= $self->_store_mso_dgg(@{$self->{_mso_clusters}});
  2565. $data .= $self->_store_mso_bstore_container();
  2566. $data .= $self->_store_mso_images(@$_) for @{$self->{_images_data}};
  2567. $data .= $self->_store_mso_opt();
  2568. $data .= $self->_store_mso_split_menu_colors();
  2569. $length = length $data;
  2570. my $header = pack("vv", $record, $length);
  2571. $self->_add_mso_drawing_group_continue($header . $data);
  2572. return $header . $data; # For testing only.
  2573. }
  2574. ###############################################################################
  2575. #
  2576. # _add_mso_drawing_group_continue()
  2577. #
  2578. # See first the Spreadsheet::WriteExcel::BIFFwriter::_add_continue() method.
  2579. #
  2580. # Add specialised CONTINUE headers to large MSODRAWINGGROUP data block.
  2581. # We use the Excel 97 max block size of 8228 - 4 bytes for the header = 8224.
  2582. #
  2583. # The structure depends on the size of the data block:
  2584. #
  2585. # Case 1: <= 8224 bytes 1 MSODRAWINGGROUP
  2586. # Case 2: <= 2*8224 bytes 1 MSODRAWINGGROUP + 1 CONTINUE
  2587. # Case 3: > 2*8224 bytes 2 MSODRAWINGGROUP + n CONTINUE
  2588. #
  2589. sub _add_mso_drawing_group_continue {
  2590. my $self = shift;
  2591. my $data = $_[0];
  2592. my $limit = 8228 -4;
  2593. my $mso_group = 0x00EB; # Record identifier
  2594. my $continue = 0x003C; # Record identifier
  2595. my $block_count = 1;
  2596. my $header;
  2597. my $tmp;
  2598. # Ignore the base class _add_continue() method.
  2599. $self->{_ignore_continue} = 1;
  2600. # Case 1 above. Just return the data as it is.
  2601. if (length $data <= $limit) {
  2602. $self->_append($data);
  2603. return;
  2604. }
  2605. # Change length field of the first MSODRAWINGGROUP block. Case 2 and 3.
  2606. $tmp = substr($data, 0, $limit +4, "");
  2607. substr($tmp, 2, 2, pack("v", $limit));
  2608. $self->_append($tmp);
  2609. # Add MSODRAWINGGROUP and CONTINUE blocks for Case 3 above.
  2610. while (length($data) > $limit) {
  2611. if ($block_count == 1) {
  2612. # Add extra MSODRAWINGGROUP block header.
  2613. $header = pack("vv", $mso_group, $limit);
  2614. $block_count++;
  2615. }
  2616. else {
  2617. # Add normal CONTINUE header.
  2618. $header = pack("vv", $continue, $limit);
  2619. }
  2620. $tmp = substr($data, 0, $limit, "");
  2621. $self->_append($header, $tmp);
  2622. }
  2623. # Last CONTINUE block for remaining data. Case 2 and 3 above.
  2624. $header = pack("vv", $continue, length($data));
  2625. $self->_append($header, $data);
  2626. # Turn the base class _add_continue() method back on.
  2627. $self->{_ignore_continue} = 0;
  2628. }
  2629. ###############################################################################
  2630. #
  2631. # _store_mso_dgg_container()
  2632. #
  2633. # Write the Escher DggContainer record that is part of MSODRAWINGGROUP.
  2634. #
  2635. sub _store_mso_dgg_container {
  2636. my $self = shift;
  2637. my $type = 0xF000;
  2638. my $version = 15;
  2639. my $instance = 0;
  2640. my $data = '';
  2641. my $length = $self->{_mso_size} -12; # -4 (biff header) -8 (for this).
  2642. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2643. }
  2644. ###############################################################################
  2645. #
  2646. # _store_mso_dgg()
  2647. #
  2648. # Write the Escher Dgg record that is part of MSODRAWINGGROUP.
  2649. #
  2650. sub _store_mso_dgg {
  2651. my $self = shift;
  2652. my $type = 0xF006;
  2653. my $version = 0;
  2654. my $instance = 0;
  2655. my $data = '';
  2656. my $length = undef; # Calculate automatically.
  2657. my $max_spid = $_[0];
  2658. my $num_clusters = $_[1];
  2659. my $shapes_saved = $_[2];
  2660. my $drawings_saved = $_[3];
  2661. my $clusters = $_[4];
  2662. $data = pack "VVVV", $max_spid, $num_clusters,
  2663. $shapes_saved, $drawings_saved;
  2664. for my $aref (@$clusters) {
  2665. my $drawing_id = $aref->[0];
  2666. my $shape_ids_used = $aref->[1];
  2667. $data .= pack "VV", $drawing_id, $shape_ids_used;
  2668. }
  2669. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2670. }
  2671. ###############################################################################
  2672. #
  2673. # _store_mso_bstore_container()
  2674. #
  2675. # Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
  2676. #
  2677. sub _store_mso_bstore_container {
  2678. my $self = shift;
  2679. return '' unless $self->{_images_size};
  2680. my $type = 0xF001;
  2681. my $version = 15;
  2682. my $instance = @{$self->{_images_data}}; # Number of images.
  2683. my $data = '';
  2684. my $length = $self->{_images_size} +8 *$instance;
  2685. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2686. }
  2687. ###############################################################################
  2688. #
  2689. # _store_mso_images()
  2690. #
  2691. # Write the Escher BstoreContainer record that is part of MSODRAWINGGROUP.
  2692. #
  2693. sub _store_mso_images {
  2694. my $self = shift;
  2695. my $ref_count = $_[0];
  2696. my $image_type = $_[1];
  2697. my $image = $_[2];
  2698. my $size = $_[3];
  2699. my $checksum1 = $_[4];
  2700. my $checksum2 = $_[5];
  2701. my $blip_store_entry = $self->_store_mso_blip_store_entry($ref_count,
  2702. $image_type,
  2703. $size,
  2704. $checksum1);
  2705. my $blip = $self->_store_mso_blip($image_type,
  2706. $image,
  2707. $size,
  2708. $checksum1,
  2709. $checksum2);
  2710. return $blip_store_entry . $blip;
  2711. }
  2712. ###############################################################################
  2713. #
  2714. # _store_mso_blip_store_entry()
  2715. #
  2716. # Write the Escher BlipStoreEntry record that is part of MSODRAWINGGROUP.
  2717. #
  2718. sub _store_mso_blip_store_entry {
  2719. my $self = shift;
  2720. my $ref_count = $_[0];
  2721. my $image_type = $_[1];
  2722. my $size = $_[2];
  2723. my $checksum1 = $_[3];
  2724. my $type = 0xF007;
  2725. my $version = 2;
  2726. my $instance = $image_type;
  2727. my $length = $size +61;
  2728. my $data = pack('C', $image_type) # Win32
  2729. . pack('C', $image_type) # Mac
  2730. . pack('H*', $checksum1) # Uid checksum
  2731. . pack('v', 0xFF) # Tag
  2732. . pack('V', $size +25) # Next Blip size
  2733. . pack('V', $ref_count) # Image ref count
  2734. . pack('V', 0x00000000) # File offset
  2735. . pack('C', 0x00) # Usage
  2736. . pack('C', 0x00) # Name length
  2737. . pack('C', 0x00) # Unused
  2738. . pack('C', 0x00) # Unused
  2739. ;
  2740. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2741. }
  2742. ###############################################################################
  2743. #
  2744. # _store_mso_blip()
  2745. #
  2746. # Write the Escher Blip record that is part of MSODRAWINGGROUP.
  2747. #
  2748. sub _store_mso_blip {
  2749. my $self = shift;
  2750. my $image_type = $_[0];
  2751. my $image_data = $_[1];
  2752. my $size = $_[2];
  2753. my $checksum1 = $_[3];
  2754. my $checksum2 = $_[4];
  2755. my $instance;
  2756. $instance = 0x046A if $image_type == 5; # JPG
  2757. $instance = 0x06E0 if $image_type == 6; # PNG
  2758. $instance = 0x07A9 if $image_type == 7; # BMP
  2759. # BMPs contain an extra checksum for the stripped data.
  2760. if ( $image_type == 7) {
  2761. $checksum1 = $checksum2 . $checksum1;
  2762. }
  2763. my $type = 0xF018 + $image_type;
  2764. my $version = 0x0000;
  2765. my $length = $size +17;
  2766. my $data = pack('H*', $checksum1) # Uid checksum
  2767. . pack('C', 0xFF) # Tag
  2768. . $image_data # Image
  2769. ;
  2770. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2771. }
  2772. ###############################################################################
  2773. #
  2774. # _store_mso_opt()
  2775. #
  2776. # Write the Escher Opt record that is part of MSODRAWINGGROUP.
  2777. #
  2778. sub _store_mso_opt {
  2779. my $self = shift;
  2780. my $type = 0xF00B;
  2781. my $version = 3;
  2782. my $instance = 3;
  2783. my $data = '';
  2784. my $length = 18;
  2785. $data = pack "H*", 'BF0008000800810109000008C0014000' .
  2786. '0008';
  2787. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2788. }
  2789. ###############################################################################
  2790. #
  2791. # _store_mso_split_menu_colors()
  2792. #
  2793. # Write the Escher SplitMenuColors record that is part of MSODRAWINGGROUP.
  2794. #
  2795. sub _store_mso_split_menu_colors {
  2796. my $self = shift;
  2797. my $type = 0xF11E;
  2798. my $version = 0;
  2799. my $instance = 4;
  2800. my $data = '';
  2801. my $length = 16;
  2802. $data = pack "H*", '0D0000080C00000817000008F7000010';
  2803. return $self->_add_mso_generic($type, $version, $instance, $data, $length);
  2804. }
  2805. 1;
  2806. __END__
  2807. =head1 NAME
  2808. Workbook - A writer class for Excel Workbooks.
  2809. =head1 SYNOPSIS
  2810. See the documentation for Spreadsheet::WriteExcel
  2811. =head1 DESCRIPTION
  2812. This module is used in conjunction with Spreadsheet::WriteExcel.
  2813. =head1 AUTHOR
  2814. John McNamara jmcnamara@cpan.org
  2815. =head1 COPYRIGHT
  2816. © MM-MMX, John McNamara.
  2817. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.