ParseExcel.pm 98 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026
  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. # Current maintainer 0.40+: John McNamara jmcnamara@cpan.org
  20. # Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
  21. # Original author: Kawai Takanori (Hippo2000) kwitknr@cpan.org
  22. # COPYRIGHT
  23. # Copyright (c) 2009-2010 John McNamara
  24. # Copyright (c) 2006-2008 Gabor Szabo
  25. # Copyright (c) 2000-2006 Kawai Takanori
  26. # All rights reserved. This is free software. You may distribute under the terms of
  27. # the Artistic License(full text of the Artistic License http://dev.perl.org/licenses/artistic.html).
  28. package Spreadsheet::ParseExcel;
  29. ##############################################################################
  30. #
  31. # Spreadsheet::ParseExcel - Extract information from an Excel file.
  32. #
  33. # Copyright 2000-2008, Takanori Kawai
  34. #
  35. # perltidy with standard settings.
  36. #
  37. # Documentation after __END__
  38. #
  39. use strict;
  40. use warnings;
  41. use 5.008;
  42. use OLE::Storage_Lite;
  43. use IO::File;
  44. use Config;
  45. our $VERSION = '0.57';
  46. use Spreadsheet::ParseExcel::Workbook;
  47. use Spreadsheet::ParseExcel::Worksheet;
  48. use Spreadsheet::ParseExcel::Font;
  49. use Spreadsheet::ParseExcel::Format;
  50. use Spreadsheet::ParseExcel::Cell;
  51. use Spreadsheet::ParseExcel::FmtDefault;
  52. my @aColor = (
  53. '000000', # 0x00
  54. 'FFFFFF', 'FFFFFF', 'FFFFFF', 'FFFFFF',
  55. 'FFFFFF', 'FFFFFF', 'FFFFFF', 'FFFFFF', # 0x08
  56. 'FFFFFF', 'FF0000', '00FF00', '0000FF',
  57. 'FFFF00', 'FF00FF', '00FFFF', '800000', # 0x10
  58. '008000', '000080', '808000', '800080',
  59. '008080', 'C0C0C0', '808080', '9999FF', # 0x18
  60. '993366', 'FFFFCC', 'CCFFFF', '660066',
  61. 'FF8080', '0066CC', 'CCCCFF', '000080', # 0x20
  62. 'FF00FF', 'FFFF00', '00FFFF', '800080',
  63. '800000', '008080', '0000FF', '00CCFF', # 0x28
  64. 'CCFFFF', 'CCFFCC', 'FFFF99', '99CCFF',
  65. 'FF99CC', 'CC99FF', 'FFCC99', '3366FF', # 0x30
  66. '33CCCC', '99CC00', 'FFCC00', 'FF9900',
  67. 'FF6600', '666699', '969696', '003366', # 0x38
  68. '339966', '003300', '333300', '993300',
  69. '993366', '333399', '333333', 'FFFFFF' # 0x40
  70. );
  71. use constant verExcel95 => 0x500;
  72. use constant verExcel97 => 0x600;
  73. use constant verBIFF2 => 0x00;
  74. use constant verBIFF3 => 0x02;
  75. use constant verBIFF4 => 0x04;
  76. use constant verBIFF5 => 0x08;
  77. use constant verBIFF8 => 0x18;
  78. # Error code for some of the common parsing errors.
  79. use constant ErrorNone => 0;
  80. use constant ErrorNoFile => 1;
  81. use constant ErrorNoExcelData => 2;
  82. use constant ErrorFileEncrypted => 3;
  83. our %error_strings = (
  84. ErrorNone, '', # 0
  85. ErrorNoFile, 'File not found', # 1
  86. ErrorNoExcelData, 'No Excel data found in file', # 2
  87. ErrorFileEncrypted, 'File is encrypted', # 3
  88. );
  89. our %ProcTbl = (
  90. #Develpers' Kit P291
  91. 0x14 => \&_subHeader, # Header
  92. 0x15 => \&_subFooter, # Footer
  93. 0x18 => \&_subName, # NAME(?)
  94. 0x1A => \&_subVPageBreak, # Vertical Page Break
  95. 0x1B => \&_subHPageBreak, # Horizontal Page Break
  96. 0x22 => \&_subFlg1904, # 1904 Flag
  97. 0x26 => \&_subMargin, # Left Margin
  98. 0x27 => \&_subMargin, # Right Margin
  99. 0x28 => \&_subMargin, # Top Margin
  100. 0x29 => \&_subMargin, # Bottom Margin
  101. 0x2A => \&_subPrintHeaders, # Print Headers
  102. 0x2B => \&_subPrintGridlines, # Print Gridlines
  103. 0x3C => \&_subContinue, # Continue
  104. 0x43 => \&_subXF, # XF for Excel < 4.
  105. 0x0443 => \&_subXF, # XF for Excel = 4.
  106. #Develpers' Kit P292
  107. 0x55 => \&_subDefColWidth, # Consider
  108. 0x5C => \&_subWriteAccess, # WRITEACCESS
  109. 0x7D => \&_subColInfo, # Colinfo
  110. 0x7E => \&_subRK, # RK
  111. 0x81 => \&_subWSBOOL, # WSBOOL
  112. 0x83 => \&_subHcenter, # HCENTER
  113. 0x84 => \&_subVcenter, # VCENTER
  114. 0x85 => \&_subBoundSheet, # BoundSheet
  115. 0x92 => \&_subPalette, # Palette, fgp
  116. 0x99 => \&_subStandardWidth, # Standard Col
  117. #Develpers' Kit P293
  118. 0xA1 => \&_subSETUP, # SETUP
  119. 0xBD => \&_subMulRK, # MULRK
  120. 0xBE => \&_subMulBlank, # MULBLANK
  121. 0xD6 => \&_subRString, # RString
  122. #Develpers' Kit P294
  123. 0xE0 => \&_subXF, # ExTended Format
  124. 0xE5 => \&_subMergeArea, # MergeArea (Not Documented)
  125. 0xFC => \&_subSST, # Shared String Table
  126. 0xFD => \&_subLabelSST, # Label SST
  127. #Develpers' Kit P295
  128. 0x201 => \&_subBlank, # Blank
  129. 0x202 => \&_subInteger, # Integer(Not Documented)
  130. 0x203 => \&_subNumber, # Number
  131. 0x204 => \&_subLabel, # Label
  132. 0x205 => \&_subBoolErr, # BoolErr
  133. 0x207 => \&_subString, # STRING
  134. 0x208 => \&_subRow, # RowData
  135. 0x221 => \&_subArray, # Array (Consider)
  136. 0x225 => \&_subDefaultRowHeight, # Consider
  137. 0x31 => \&_subFont, # Font
  138. 0x231 => \&_subFont, # Font
  139. 0x27E => \&_subRK, # RK
  140. 0x41E => \&_subFormat, # Format
  141. 0x06 => \&_subFormula, # Formula
  142. 0x406 => \&_subFormula, # Formula
  143. 0x009 => \&_subBOF, # BOF(BIFF2)
  144. 0x209 => \&_subBOF, # BOF(BIFF3)
  145. 0x409 => \&_subBOF, # BOF(BIFF4)
  146. 0x809 => \&_subBOF, # BOF(BIFF5-8)
  147. );
  148. our $BIGENDIAN;
  149. our $PREFUNC;
  150. our $_CellHandler;
  151. our $_NotSetCell;
  152. our $_Object;
  153. our $_use_perlio;
  154. #------------------------------------------------------------------------------
  155. # Spreadsheet::ParseExcel->new
  156. #------------------------------------------------------------------------------
  157. sub new {
  158. my ( $class, %hParam ) = @_;
  159. if ( not defined $_use_perlio ) {
  160. if ( exists $Config{useperlio}
  161. && defined $Config{useperlio}
  162. && $Config{useperlio} eq "define" )
  163. {
  164. $_use_perlio = 1;
  165. }
  166. else {
  167. $_use_perlio = 0;
  168. require IO::Scalar;
  169. import IO::Scalar;
  170. }
  171. }
  172. # Check ENDIAN(Little: Interl etc. BIG: Sparc etc)
  173. $BIGENDIAN =
  174. ( defined $hParam{Endian} ) ? $hParam{Endian}
  175. : ( unpack( "H08", pack( "L", 2 ) ) eq '02000000' ) ? 0
  176. : 1;
  177. my $self = {};
  178. bless $self, $class;
  179. $self->{GetContent} = \&_subGetContent;
  180. if ( $hParam{EventHandlers} ) {
  181. $self->SetEventHandlers( $hParam{EventHandlers} );
  182. }
  183. else {
  184. $self->SetEventHandlers( \%ProcTbl );
  185. }
  186. if ( $hParam{AddHandlers} ) {
  187. foreach my $sKey ( keys( %{ $hParam{AddHandlers} } ) ) {
  188. $self->SetEventHandler( $sKey, $hParam{AddHandlers}->{$sKey} );
  189. }
  190. }
  191. $_CellHandler = $hParam{CellHandler} if ( $hParam{CellHandler} );
  192. $_NotSetCell = $hParam{NotSetCell};
  193. $_Object = $hParam{Object};
  194. $self->{_error_status} = ErrorNone;
  195. return $self;
  196. }
  197. #------------------------------------------------------------------------------
  198. # Spreadsheet::ParseExcel->SetEventHandler
  199. #------------------------------------------------------------------------------
  200. sub SetEventHandler {
  201. my ( $self, $key, $sub_ref ) = @_;
  202. $self->{FuncTbl}->{$key} = $sub_ref;
  203. }
  204. #------------------------------------------------------------------------------
  205. # Spreadsheet::ParseExcel->SetEventHandlers
  206. #------------------------------------------------------------------------------
  207. sub SetEventHandlers {
  208. my ( $self, $rhTbl ) = @_;
  209. $self->{FuncTbl} = undef;
  210. foreach my $sKey ( keys %$rhTbl ) {
  211. $self->{FuncTbl}->{$sKey} = $rhTbl->{$sKey};
  212. }
  213. }
  214. ###############################################################################
  215. #
  216. # Parse()
  217. #
  218. # Parse the Excel file and convert it into a tree of objects..
  219. #
  220. sub parse {
  221. my ( $self, $source, $formatter ) = @_;
  222. my $workbook = Spreadsheet::ParseExcel::Workbook->new();
  223. $workbook->{SheetCount} = 0;
  224. my ( $biff_data, $data_length ) = $self->_get_content( $source, $workbook );
  225. return undef if not $biff_data;
  226. if ($formatter) {
  227. $workbook->{FmtClass} = $formatter;
  228. }
  229. else {
  230. $workbook->{FmtClass} = Spreadsheet::ParseExcel::FmtDefault->new();
  231. }
  232. # Parse the BIFF data.
  233. my $pos = 0;
  234. my $record_header = substr( $biff_data, $pos, 4 );
  235. $pos += 4;
  236. while ( $pos <= $data_length ) {
  237. my ( $record, $record_length ) = unpack( "v2", $record_header );
  238. if ($record_length) {
  239. $record_header = substr( $biff_data, $pos, $record_length );
  240. $pos += $record_length;
  241. }
  242. # If the file contains a FILEPASS record we assume that it is encrypted
  243. # and cannot be parsed.
  244. if ( $record == 0x002F ) {
  245. $self->{_error_status} = ErrorFileEncrypted;
  246. return undef;
  247. }
  248. # Special case of a formula String with no string.
  249. if ( $workbook->{_PrevPos}
  250. && ( defined $self->{FuncTbl}->{$record} )
  251. && ( $record != 0x207 ) )
  252. {
  253. my $iPos = $workbook->{_PrevPos};
  254. $workbook->{_PrevPos} = undef;
  255. my ( $row, $col, $format_index ) = @$iPos;
  256. _NewCell(
  257. $workbook, $row, $col,
  258. Kind => 'Formula String',
  259. Val => '',
  260. FormatNo => $format_index,
  261. Format => $workbook->{Format}[$format_index],
  262. Numeric => 0,
  263. Code => undef,
  264. Book => $workbook,
  265. );
  266. }
  267. # If the BIFF record matches 0x0*09 then it is a BOF record.
  268. # We reset the _skip_chart flag to ensure we check the sheet type.
  269. if ( ( $record & 0xF0FF ) == 0x09 ) {
  270. $workbook->{_skip_chart} = 0;
  271. }
  272. if ( defined $self->{FuncTbl}->{$record} && !$workbook->{_skip_chart} ) {
  273. $self->{FuncTbl}->{$record}->( $workbook, $record, $record_length, $record_header );
  274. }
  275. $PREFUNC = $record if ( $record != 0x3C ); #Not Continue
  276. if ( ( $pos + 4 ) <= $data_length ) {
  277. $record_header = substr( $biff_data, $pos, 4 );
  278. }
  279. $pos += 4;
  280. return $workbook if defined $workbook->{_ParseAbort};
  281. }
  282. return $workbook;
  283. }
  284. ###############################################################################
  285. #
  286. # _get_content()
  287. #
  288. # Get the Excel BIFF content from the file or filehandle.
  289. #
  290. sub _get_content {
  291. my ( $self, $source, $workbook ) = @_;
  292. my ( $biff_data, $data_length );
  293. # Reset the error status in case method is called more than once.
  294. $self->{_error_status} = ErrorNone;
  295. if ( ref($source) eq "SCALAR" ) {
  296. # Specified by a scalar buffer.
  297. ( $biff_data, $data_length ) = $self->{GetContent}->($source);
  298. }
  299. elsif (( ref($source) =~ /GLOB/ ) || ( ref($source) eq 'Fh' ) ) {
  300. # For CGI.pm (Light FileHandle)
  301. binmode($source);
  302. my $sWk;
  303. my $sBuff = '';
  304. while ( read( $source, $sWk, 4096 ) ) {
  305. $sBuff .= $sWk;
  306. }
  307. ( $biff_data, $data_length ) = $self->{GetContent}->( \$sBuff );
  308. }
  309. elsif ( ref($source) eq 'ARRAY' ) {
  310. # Specified by file content
  311. $workbook->{File} = undef;
  312. my $sData = join( '', @$source );
  313. ( $biff_data, $data_length ) = $self->{GetContent}->( \$sData );
  314. }
  315. else {
  316. # Specified by filename .
  317. $workbook->{File} = $source;
  318. if ( ! -e $source ) {
  319. $self->{_error_status} = ErrorNoFile;
  320. return undef;
  321. }
  322. ( $biff_data, $data_length ) = $self->{GetContent}->($source);
  323. }
  324. # If the read was successful return the data.
  325. if ($data_length) {
  326. return ($biff_data, $data_length );
  327. }
  328. else {
  329. $self->{_error_status} = ErrorNoExcelData;
  330. return undef;
  331. }
  332. }
  333. #------------------------------------------------------------------------------
  334. # _subGetContent (for Spreadsheet::ParseExcel)
  335. #------------------------------------------------------------------------------
  336. sub _subGetContent {
  337. my ($sFile) = @_;
  338. my $oOl = OLE::Storage_Lite->new($sFile);
  339. return ( undef, undef ) unless ($oOl);
  340. my @aRes = $oOl->getPpsSearch(
  341. [
  342. OLE::Storage_Lite::Asc2Ucs('Book'),
  343. OLE::Storage_Lite::Asc2Ucs('Workbook')
  344. ],
  345. 1, 1
  346. );
  347. return ( undef, undef ) if ( $#aRes < 0 );
  348. #Hack from Herbert
  349. if ( $aRes[0]->{Data} ) {
  350. return ( $aRes[0]->{Data}, length( $aRes[0]->{Data} ) );
  351. }
  352. #Same as OLE::Storage_Lite
  353. my $oIo;
  354. #1. $sFile is Ref of scalar
  355. if ( ref($sFile) eq 'SCALAR' ) {
  356. if ($_use_perlio) {
  357. open $oIo, "<", \$sFile;
  358. }
  359. else {
  360. $oIo = IO::Scalar->new;
  361. $oIo->open($sFile);
  362. }
  363. }
  364. #2. $sFile is a IO::Handle object
  365. elsif ( UNIVERSAL::isa( $sFile, 'IO::Handle' ) ) {
  366. $oIo = $sFile;
  367. binmode($oIo);
  368. }
  369. #3. $sFile is a simple filename string
  370. elsif ( !ref($sFile) ) {
  371. $oIo = IO::File->new;
  372. $oIo->open("<$sFile") || return undef;
  373. binmode($oIo);
  374. }
  375. my $sWk;
  376. my $sBuff = '';
  377. while ( $oIo->read( $sWk, 4096 ) ) { #4_096 has no special meanings
  378. $sBuff .= $sWk;
  379. }
  380. $oIo->close();
  381. #Not Excel file (simple method)
  382. return ( undef, undef ) if ( substr( $sBuff, 0, 1 ) ne "\x09" );
  383. return ( $sBuff, length($sBuff) );
  384. }
  385. #------------------------------------------------------------------------------
  386. # _subBOF (for Spreadsheet::ParseExcel) Developers' Kit : P303
  387. #------------------------------------------------------------------------------
  388. sub _subBOF {
  389. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  390. my ( $iVer, $iDt ) = unpack( "v2", $sWk );
  391. #Workbook Global
  392. if ( $iDt == 0x0005 ) {
  393. $oBook->{Version} = unpack( "v", $sWk );
  394. $oBook->{BIFFVersion} =
  395. ( $oBook->{Version} == verExcel95 ) ? verBIFF5 : verBIFF8;
  396. $oBook->{_CurSheet} = undef;
  397. $oBook->{_CurSheet_} = -1;
  398. }
  399. #Worksheet or Dialogsheet
  400. elsif ( $iDt != 0x0020 ) { #if($iDt == 0x0010)
  401. if ( defined $oBook->{_CurSheet_} ) {
  402. $oBook->{_CurSheet} = $oBook->{_CurSheet_} + 1;
  403. $oBook->{_CurSheet_}++;
  404. (
  405. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetVersion},
  406. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{SheetType},
  407. )
  408. = unpack( "v2", $sWk )
  409. if ( length($sWk) > 4 );
  410. }
  411. else {
  412. $oBook->{BIFFVersion} = int( $bOp / 0x100 );
  413. if ( ( $oBook->{BIFFVersion} == verBIFF2 )
  414. || ( $oBook->{BIFFVersion} == verBIFF3 )
  415. || ( $oBook->{BIFFVersion} == verBIFF4 ) )
  416. {
  417. $oBook->{Version} = $oBook->{BIFFVersion};
  418. $oBook->{_CurSheet} = 0;
  419. $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
  420. Spreadsheet::ParseExcel::Worksheet->new(
  421. _Name => '',
  422. Name => '',
  423. _Book => $oBook,
  424. _SheetNo => $oBook->{SheetCount},
  425. );
  426. $oBook->{SheetCount}++;
  427. }
  428. }
  429. }
  430. else {
  431. # Set flag to ignore all chart records until we reach another BOF.
  432. $oBook->{_skip_chart} = 1;
  433. }
  434. }
  435. #------------------------------------------------------------------------------
  436. # _subBlank (for Spreadsheet::ParseExcel) DK:P303
  437. #------------------------------------------------------------------------------
  438. sub _subBlank {
  439. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  440. my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
  441. _NewCell(
  442. $oBook, $iR, $iC,
  443. Kind => 'BLANK',
  444. Val => '',
  445. FormatNo => $iF,
  446. Format => $oBook->{Format}[$iF],
  447. Numeric => 0,
  448. Code => undef,
  449. Book => $oBook,
  450. );
  451. #2.MaxRow, MaxCol, MinRow, MinCol
  452. _SetDimension( $oBook, $iR, $iC, $iC );
  453. }
  454. #------------------------------------------------------------------------------
  455. # _subInteger (for Spreadsheet::ParseExcel) Not in DK
  456. #------------------------------------------------------------------------------
  457. sub _subInteger {
  458. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  459. my ( $iR, $iC, $iF, $sTxt, $sDum );
  460. ( $iR, $iC, $iF, $sDum, $sTxt ) = unpack( "v3cv", $sWk );
  461. _NewCell(
  462. $oBook, $iR, $iC,
  463. Kind => 'INTEGER',
  464. Val => $sTxt,
  465. FormatNo => $iF,
  466. Format => $oBook->{Format}[$iF],
  467. Numeric => 0,
  468. Code => undef,
  469. Book => $oBook,
  470. );
  471. #2.MaxRow, MaxCol, MinRow, MinCol
  472. _SetDimension( $oBook, $iR, $iC, $iC );
  473. }
  474. #------------------------------------------------------------------------------
  475. # _subNumber (for Spreadsheet::ParseExcel) : DK: P354
  476. #------------------------------------------------------------------------------
  477. sub _subNumber {
  478. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  479. my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
  480. my $dVal = _convDval( substr( $sWk, 6, 8 ) );
  481. _NewCell(
  482. $oBook, $iR, $iC,
  483. Kind => 'Number',
  484. Val => $dVal,
  485. FormatNo => $iF,
  486. Format => $oBook->{Format}[$iF],
  487. Numeric => 1,
  488. Code => undef,
  489. Book => $oBook,
  490. );
  491. #2.MaxRow, MaxCol, MinRow, MinCol
  492. _SetDimension( $oBook, $iR, $iC, $iC );
  493. }
  494. #------------------------------------------------------------------------------
  495. # _convDval (for Spreadsheet::ParseExcel)
  496. #------------------------------------------------------------------------------
  497. sub _convDval {
  498. my ($sWk) = @_;
  499. return
  500. unpack( "d",
  501. ($BIGENDIAN) ? pack( "c8", reverse( unpack( "c8", $sWk ) ) ) : $sWk );
  502. }
  503. #------------------------------------------------------------------------------
  504. # _subRString (for Spreadsheet::ParseExcel) DK:P405
  505. #------------------------------------------------------------------------------
  506. sub _subRString {
  507. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  508. my ( $iR, $iC, $iF, $iL, $sTxt );
  509. ( $iR, $iC, $iF, $iL ) = unpack( "v4", $sWk );
  510. $sTxt = substr( $sWk, 8, $iL );
  511. #Has STRUN
  512. if ( length($sWk) > ( 8 + $iL ) ) {
  513. _NewCell(
  514. $oBook, $iR, $iC,
  515. Kind => 'RString',
  516. Val => $sTxt,
  517. FormatNo => $iF,
  518. Format => $oBook->{Format}[$iF],
  519. Numeric => 0,
  520. Code => '_native_', #undef,
  521. Book => $oBook,
  522. Rich => substr( $sWk, ( 8 + $iL ) + 1 ),
  523. );
  524. }
  525. else {
  526. _NewCell(
  527. $oBook, $iR, $iC,
  528. Kind => 'RString',
  529. Val => $sTxt,
  530. FormatNo => $iF,
  531. Format => $oBook->{Format}[$iF],
  532. Numeric => 0,
  533. Code => '_native_',
  534. Book => $oBook,
  535. );
  536. }
  537. #2.MaxRow, MaxCol, MinRow, MinCol
  538. _SetDimension( $oBook, $iR, $iC, $iC );
  539. }
  540. #------------------------------------------------------------------------------
  541. # _subBoolErr (for Spreadsheet::ParseExcel) DK:P306
  542. #------------------------------------------------------------------------------
  543. sub _subBoolErr {
  544. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  545. my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
  546. my ( $iVal, $iFlg ) = unpack( "cc", substr( $sWk, 6, 2 ) );
  547. my $sTxt = DecodeBoolErr( $iVal, $iFlg );
  548. _NewCell(
  549. $oBook, $iR, $iC,
  550. Kind => 'BoolError',
  551. Val => $sTxt,
  552. FormatNo => $iF,
  553. Format => $oBook->{Format}[$iF],
  554. Numeric => 0,
  555. Code => undef,
  556. Book => $oBook,
  557. );
  558. #2.MaxRow, MaxCol, MinRow, MinCol
  559. _SetDimension( $oBook, $iR, $iC, $iC );
  560. }
  561. ###############################################################################
  562. #
  563. # _subRK()
  564. #
  565. # Decode the RK BIFF record.
  566. #
  567. sub _subRK {
  568. my ( $workbook, $biff_number, $length, $data ) = @_;
  569. my ( $row, $col, $format_index, $rk_number ) = unpack( 'vvvV', $data );
  570. my $number = _decode_rk_number($rk_number);
  571. _NewCell(
  572. $workbook, $row, $col,
  573. Kind => 'RK',
  574. Val => $number,
  575. FormatNo => $format_index,
  576. Format => $workbook->{Format}->[$format_index],
  577. Numeric => 1,
  578. Code => undef,
  579. Book => $workbook,
  580. );
  581. # Store the max and min row/col values.
  582. _SetDimension( $workbook, $row, $col, $col );
  583. }
  584. #------------------------------------------------------------------------------
  585. # _subArray (for Spreadsheet::ParseExcel) DK:P297
  586. #------------------------------------------------------------------------------
  587. sub _subArray {
  588. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  589. my ( $iBR, $iER, $iBC, $iEC ) = unpack( "v2c2", $sWk );
  590. }
  591. #------------------------------------------------------------------------------
  592. # _subFormula (for Spreadsheet::ParseExcel) DK:P336
  593. #------------------------------------------------------------------------------
  594. sub _subFormula {
  595. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  596. my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
  597. my ($iFlg) = unpack( "v", substr( $sWk, 12, 2 ) );
  598. if ( $iFlg == 0xFFFF ) {
  599. my ($iKind) = unpack( "c", substr( $sWk, 6, 1 ) );
  600. my ($iVal) = unpack( "c", substr( $sWk, 8, 1 ) );
  601. if ( ( $iKind == 1 ) or ( $iKind == 2 ) ) {
  602. my $sTxt =
  603. ( $iKind == 1 )
  604. ? DecodeBoolErr( $iVal, 0 )
  605. : DecodeBoolErr( $iVal, 1 );
  606. _NewCell(
  607. $oBook, $iR, $iC,
  608. Kind => 'Formula Bool',
  609. Val => $sTxt,
  610. FormatNo => $iF,
  611. Format => $oBook->{Format}[$iF],
  612. Numeric => 0,
  613. Code => undef,
  614. Book => $oBook,
  615. );
  616. }
  617. else { # Result (Reserve Only)
  618. $oBook->{_PrevPos} = [ $iR, $iC, $iF ];
  619. }
  620. }
  621. else {
  622. my $dVal = _convDval( substr( $sWk, 6, 8 ) );
  623. _NewCell(
  624. $oBook, $iR, $iC,
  625. Kind => 'Formula Number',
  626. Val => $dVal,
  627. FormatNo => $iF,
  628. Format => $oBook->{Format}[$iF],
  629. Numeric => 1,
  630. Code => undef,
  631. Book => $oBook,
  632. );
  633. }
  634. #2.MaxRow, MaxCol, MinRow, MinCol
  635. _SetDimension( $oBook, $iR, $iC, $iC );
  636. }
  637. #------------------------------------------------------------------------------
  638. # _subString (for Spreadsheet::ParseExcel) DK:P414
  639. #------------------------------------------------------------------------------
  640. sub _subString {
  641. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  642. #Position (not enough for ARRAY)
  643. my $iPos = $oBook->{_PrevPos};
  644. return undef unless ($iPos);
  645. $oBook->{_PrevPos} = undef;
  646. my ( $iR, $iC, $iF ) = @$iPos;
  647. my ( $iLen, $sTxt, $sCode );
  648. if ( $oBook->{BIFFVersion} == verBIFF8 ) {
  649. my ( $raBuff, $iLen ) = _convBIFF8String( $oBook, $sWk, 1 );
  650. $sTxt = $raBuff->[0];
  651. $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
  652. }
  653. elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
  654. $sCode = '_native_';
  655. $iLen = unpack( "v", $sWk );
  656. $sTxt = substr( $sWk, 2, $iLen );
  657. }
  658. else {
  659. $sCode = '_native_';
  660. $iLen = unpack( "c", $sWk );
  661. $sTxt = substr( $sWk, 1, $iLen );
  662. }
  663. _NewCell(
  664. $oBook, $iR, $iC,
  665. Kind => 'String',
  666. Val => $sTxt,
  667. FormatNo => $iF,
  668. Format => $oBook->{Format}[$iF],
  669. Numeric => 0,
  670. Code => $sCode,
  671. Book => $oBook,
  672. );
  673. #2.MaxRow, MaxCol, MinRow, MinCol
  674. _SetDimension( $oBook, $iR, $iC, $iC );
  675. }
  676. #------------------------------------------------------------------------------
  677. # _subLabel (for Spreadsheet::ParseExcel) DK:P344
  678. #------------------------------------------------------------------------------
  679. sub _subLabel {
  680. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  681. my ( $iR, $iC, $iF ) = unpack( "v3", $sWk );
  682. my ( $sLbl, $sCode );
  683. #BIFF8
  684. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  685. my ( $raBuff, $iLen, $iStPos, $iLenS ) =
  686. _convBIFF8String( $oBook, substr( $sWk, 6 ), 1 );
  687. $sLbl = $raBuff->[0];
  688. $sCode = ( $raBuff->[1] ) ? 'ucs2' : undef;
  689. }
  690. #Before BIFF8
  691. else {
  692. $sLbl = substr( $sWk, 8 );
  693. $sCode = '_native_';
  694. }
  695. _NewCell(
  696. $oBook, $iR, $iC,
  697. Kind => 'Label',
  698. Val => $sLbl,
  699. FormatNo => $iF,
  700. Format => $oBook->{Format}[$iF],
  701. Numeric => 0,
  702. Code => $sCode,
  703. Book => $oBook,
  704. );
  705. #2.MaxRow, MaxCol, MinRow, MinCol
  706. _SetDimension( $oBook, $iR, $iC, $iC );
  707. }
  708. ###############################################################################
  709. #
  710. # _subMulRK()
  711. #
  712. # Decode the Multiple RK BIFF record.
  713. #
  714. sub _subMulRK {
  715. my ( $workbook, $biff_number, $length, $data ) = @_;
  716. # JMN: I don't know why this is here.
  717. return if $workbook->{SheetCount} <= 0;
  718. my ( $row, $first_col ) = unpack( "v2", $data );
  719. my $last_col = unpack( "v", substr( $data, length($data) - 2, 2 ) );
  720. # Iterate over the RK array and decode the data.
  721. my $pos = 4;
  722. for my $col ( $first_col .. $last_col ) {
  723. my $data = substr( $data, $pos, 6 );
  724. my ( $format_index, $rk_number ) = unpack 'vV', $data;
  725. my $number = _decode_rk_number($rk_number);
  726. _NewCell(
  727. $workbook, $row, $col,
  728. Kind => 'MulRK',
  729. Val => $number,
  730. FormatNo => $format_index,
  731. Format => $workbook->{Format}->[$format_index],
  732. Numeric => 1,
  733. Code => undef,
  734. Book => $workbook,
  735. );
  736. $pos += 6;
  737. }
  738. # Store the max and min row/col values.
  739. _SetDimension( $workbook, $row, $first_col, $last_col );
  740. }
  741. #------------------------------------------------------------------------------
  742. # _subMulBlank (for Spreadsheet::ParseExcel) DK:P349
  743. #------------------------------------------------------------------------------
  744. sub _subMulBlank {
  745. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  746. my ( $iR, $iSc ) = unpack( "v2", $sWk );
  747. my $iEc = unpack( "v", substr( $sWk, length($sWk) - 2, 2 ) );
  748. my $iPos = 4;
  749. for ( my $iC = $iSc ; $iC <= $iEc ; $iC++ ) {
  750. my $iF = unpack( 'v', substr( $sWk, $iPos, 2 ) );
  751. _NewCell(
  752. $oBook, $iR, $iC,
  753. Kind => 'MulBlank',
  754. Val => '',
  755. FormatNo => $iF,
  756. Format => $oBook->{Format}[$iF],
  757. Numeric => 0,
  758. Code => undef,
  759. Book => $oBook,
  760. );
  761. $iPos += 2;
  762. }
  763. #2.MaxRow, MaxCol, MinRow, MinCol
  764. _SetDimension( $oBook, $iR, $iSc, $iEc );
  765. }
  766. #------------------------------------------------------------------------------
  767. # _subLabelSST (for Spreadsheet::ParseExcel) DK: P345
  768. #------------------------------------------------------------------------------
  769. sub _subLabelSST {
  770. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  771. my ( $iR, $iC, $iF, $iIdx ) = unpack( 'v3V', $sWk );
  772. _NewCell(
  773. $oBook, $iR, $iC,
  774. Kind => 'PackedIdx',
  775. Val => $oBook->{PkgStr}[$iIdx]->{Text},
  776. FormatNo => $iF,
  777. Format => $oBook->{Format}[$iF],
  778. Numeric => 0,
  779. Code => ( $oBook->{PkgStr}[$iIdx]->{Unicode} ) ? 'ucs2' : undef,
  780. Book => $oBook,
  781. Rich => $oBook->{PkgStr}[$iIdx]->{Rich},
  782. );
  783. #2.MaxRow, MaxCol, MinRow, MinCol
  784. _SetDimension( $oBook, $iR, $iC, $iC );
  785. }
  786. #------------------------------------------------------------------------------
  787. # _subFlg1904 (for Spreadsheet::ParseExcel) DK:P296
  788. #------------------------------------------------------------------------------
  789. sub _subFlg1904 {
  790. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  791. $oBook->{Flg1904} = unpack( "v", $sWk );
  792. }
  793. #------------------------------------------------------------------------------
  794. # _subRow (for Spreadsheet::ParseExcel) DK:P403
  795. #------------------------------------------------------------------------------
  796. sub _subRow {
  797. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  798. return undef unless ( defined $oBook->{_CurSheet} );
  799. #0. Get Worksheet info (MaxRow, MaxCol, MinRow, MinCol)
  800. my ( $iR, $iSc, $iEc, $iHght, $undef1, $undef2, $iGr, $iXf ) =
  801. unpack( "v8", $sWk );
  802. $iEc--;
  803. # TODO. we need to handle hidden rows:
  804. # $iGr & 0x20
  805. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RowHeight}[$iR] = $iHght / 20;
  806. #2.MaxRow, MaxCol, MinRow, MinCol
  807. _SetDimension( $oBook, $iR, $iSc, $iEc );
  808. }
  809. #------------------------------------------------------------------------------
  810. # _SetDimension (for Spreadsheet::ParseExcel)
  811. #------------------------------------------------------------------------------
  812. sub _SetDimension {
  813. my ( $oBook, $iR, $iSc, $iEc ) = @_;
  814. return undef unless ( defined $oBook->{_CurSheet} );
  815. #2.MaxRow, MaxCol, MinRow, MinCol
  816. #2.1 MinRow
  817. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} = $iR
  818. unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} )
  819. and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinRow} <= $iR );
  820. #2.2 MaxRow
  821. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} = $iR
  822. unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} )
  823. and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxRow} > $iR );
  824. #2.3 MinCol
  825. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} = $iSc
  826. unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} )
  827. and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MinCol} <= $iSc );
  828. #2.4 MaxCol
  829. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} = $iEc
  830. unless ( defined $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} )
  831. and ( $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{MaxCol} > $iEc );
  832. }
  833. #------------------------------------------------------------------------------
  834. # _subDefaultRowHeight (for Spreadsheet::ParseExcel) DK: P318
  835. #------------------------------------------------------------------------------
  836. sub _subDefaultRowHeight {
  837. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  838. return undef unless ( defined $oBook->{_CurSheet} );
  839. #1. RowHeight
  840. my ( $iDum, $iHght ) = unpack( "v2", $sWk );
  841. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{DefRowHeight} = $iHght / 20;
  842. }
  843. #------------------------------------------------------------------------------
  844. # _subStandardWidth(for Spreadsheet::ParseExcel) DK:P413
  845. #------------------------------------------------------------------------------
  846. sub _subStandardWidth {
  847. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  848. my $iW = unpack( "v", $sWk );
  849. $oBook->{StandardWidth} = _convert_col_width( $oBook, $iW );
  850. }
  851. ###############################################################################
  852. #
  853. # _subDefColWidth()
  854. #
  855. # Read the DEFCOLWIDTH Biff record. This gives the width in terms of chars
  856. # and is different from the width in the COLINFO record.
  857. #
  858. sub _subDefColWidth {
  859. my ( $self, $record, $length, $data ) = @_;
  860. my $width = unpack 'v', $data;
  861. # Adjustment for default Arial 10 width.
  862. $width = 8.43 if $width == 8;
  863. $self->{Worksheet}->[ $self->{_CurSheet} ]->{DefColWidth} = $width;
  864. }
  865. ###############################################################################
  866. #
  867. # _convert_col_width()
  868. #
  869. # Converts from the internal Excel column width units to user units seen in the
  870. # interface. It is first necessary to convert the internal width to pixels and
  871. # then to user units. The conversion is specific to a default font of Arial 10.
  872. # TODO, the conversion should be extended to other fonts and sizes.
  873. #
  874. sub _convert_col_width {
  875. my $self = shift;
  876. my $excel_width = shift;
  877. # Convert from Excel units to pixels (rounded up).
  878. my $pixels = int( 0.5 + $excel_width * 7 / 256 );
  879. # Convert from pixels to user units.
  880. # The conversion is different for columns <= 1 user unit (12 pixels).
  881. my $user_width;
  882. if ( $pixels <= 12 ) {
  883. $user_width = $pixels / 12;
  884. }
  885. else {
  886. $user_width = ( $pixels - 5 ) / 7;
  887. }
  888. # Round up to 2 decimal places.
  889. $user_width = int( $user_width * 100 + 0.5 ) / 100;
  890. return $user_width;
  891. }
  892. #------------------------------------------------------------------------------
  893. # _subColInfo (for Spreadsheet::ParseExcel) DK:P309
  894. #------------------------------------------------------------------------------
  895. sub _subColInfo {
  896. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  897. return undef unless defined $oBook->{_CurSheet};
  898. my ( $iSc, $iEc, $iW, $iXF, $iGr ) = unpack( "v5", $sWk );
  899. for ( my $i = $iSc ; $i <= $iEc ; $i++ ) {
  900. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColWidth}[$i] =
  901. _convert_col_width( $oBook, $iW );
  902. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{ColFmtNo}[$i] = $iXF;
  903. # TODO. we need to handle hidden cols: $iGr & 0x01.
  904. }
  905. }
  906. #------------------------------------------------------------------------------
  907. # _subSST (for Spreadsheet::ParseExcel) DK:P413
  908. #------------------------------------------------------------------------------
  909. sub _subSST {
  910. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  911. _subStrWk( $oBook, substr( $sWk, 8 ) );
  912. }
  913. #------------------------------------------------------------------------------
  914. # _subContinue (for Spreadsheet::ParseExcel) DK:P311
  915. #------------------------------------------------------------------------------
  916. sub _subContinue {
  917. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  918. #if(defined $self->{FuncTbl}->{$bOp}) {
  919. # $self->{FuncTbl}->{$PREFUNC}->($oBook, $bOp, $bLen, $sWk);
  920. #}
  921. _subStrWk( $oBook, $sWk, 1 ) if ( $PREFUNC == 0xFC );
  922. }
  923. #------------------------------------------------------------------------------
  924. # _subWriteAccess (for Spreadsheet::ParseExcel) DK:P451
  925. #------------------------------------------------------------------------------
  926. sub _subWriteAccess {
  927. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  928. return if ( defined $oBook->{_Author} );
  929. #BIFF8
  930. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  931. $oBook->{Author} = _convBIFF8String( $oBook, $sWk );
  932. }
  933. #Before BIFF8
  934. else {
  935. my ($iLen) = unpack( "c", $sWk );
  936. $oBook->{Author} =
  937. $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
  938. }
  939. }
  940. #------------------------------------------------------------------------------
  941. # _convBIFF8String (for Spreadsheet::ParseExcel)
  942. #------------------------------------------------------------------------------
  943. sub _convBIFF8String {
  944. my ( $oBook, $sWk, $iCnvFlg ) = @_;
  945. my ( $iLen, $iFlg ) = unpack( "vc", $sWk );
  946. my ( $iHigh, $iExt, $iRich ) = ( $iFlg & 0x01, $iFlg & 0x04, $iFlg & 0x08 );
  947. my ( $iStPos, $iExtCnt, $iRichCnt, $sStr );
  948. #2. Rich and Ext
  949. if ( $iRich && $iExt ) {
  950. $iStPos = 9;
  951. ( $iRichCnt, $iExtCnt ) = unpack( 'vV', substr( $sWk, 3, 6 ) );
  952. }
  953. elsif ($iRich) { #Only Rich
  954. $iStPos = 5;
  955. $iRichCnt = unpack( 'v', substr( $sWk, 3, 2 ) );
  956. $iExtCnt = 0;
  957. }
  958. elsif ($iExt) { #Only Ext
  959. $iStPos = 7;
  960. $iRichCnt = 0;
  961. $iExtCnt = unpack( 'V', substr( $sWk, 3, 4 ) );
  962. }
  963. else { #Nothing Special
  964. $iStPos = 3;
  965. $iExtCnt = 0;
  966. $iRichCnt = 0;
  967. }
  968. #3.Get String
  969. if ($iHigh) { #Compressed
  970. $iLen *= 2;
  971. $sStr = substr( $sWk, $iStPos, $iLen );
  972. _SwapForUnicode( \$sStr );
  973. $sStr = $oBook->{FmtClass}->TextFmt( $sStr, 'ucs2' ) unless ($iCnvFlg);
  974. }
  975. else { #Not Compressed
  976. $sStr = substr( $sWk, $iStPos, $iLen );
  977. $sStr = $oBook->{FmtClass}->TextFmt( $sStr, undef ) unless ($iCnvFlg);
  978. }
  979. #4. return
  980. if (wantarray) {
  981. #4.1 Get Rich and Ext
  982. if ( length($sWk) < $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt ) {
  983. return (
  984. [ undef, $iHigh, undef, undef ],
  985. $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
  986. $iStPos, $iLen
  987. );
  988. }
  989. else {
  990. return (
  991. [
  992. $sStr,
  993. $iHigh,
  994. substr( $sWk, $iStPos + $iLen, $iRichCnt * 4 ),
  995. substr( $sWk, $iStPos + $iLen + $iRichCnt * 4, $iExtCnt )
  996. ],
  997. $iStPos + $iLen + $iRichCnt * 4 + $iExtCnt,
  998. $iStPos, $iLen
  999. );
  1000. }
  1001. }
  1002. else {
  1003. return $sStr;
  1004. }
  1005. }
  1006. #------------------------------------------------------------------------------
  1007. # _subXF (for Spreadsheet::ParseExcel) DK:P453
  1008. #------------------------------------------------------------------------------
  1009. sub _subXF {
  1010. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1011. my ( $iFnt, $iIdx );
  1012. my (
  1013. $iLock, $iHidden, $iStyle, $i123, $iAlH, $iWrap,
  1014. $iAlV, $iJustL, $iRotate, $iInd, $iShrink, $iMerge,
  1015. $iReadDir, $iBdrD, $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB,
  1016. $iBdrSD, $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB, $iBdrCD,
  1017. $iFillP, $iFillCF, $iFillCB
  1018. );
  1019. if ( $oBook->{BIFFVersion} == verBIFF4 ) {
  1020. # Minimal support for Excel 4. We just get the font and format indices
  1021. # so that the cell data value can be formatted.
  1022. ( $iFnt, $iIdx,) = unpack( "CC", $sWk );
  1023. }
  1024. elsif ( $oBook->{BIFFVersion} == verBIFF8 ) {
  1025. my ( $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn );
  1026. ( $iFnt, $iIdx, $iGen, $iAlign, $iGen2, $iBdr1, $iBdr2, $iBdr3, $iPtn )
  1027. = unpack( "v7Vv", $sWk );
  1028. $iLock = ( $iGen & 0x01 ) ? 1 : 0;
  1029. $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
  1030. $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
  1031. $i123 = ( $iGen & 0x08 ) ? 1 : 0;
  1032. $iAlH = ( $iAlign & 0x07 );
  1033. $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
  1034. $iAlV = ( $iAlign & 0x70 ) / 0x10;
  1035. $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
  1036. $iRotate = ( ( $iAlign & 0xFF00 ) / 0x100 ) & 0x00FF;
  1037. $iRotate = 90 if ( $iRotate == 255 );
  1038. $iRotate = 90 - $iRotate if ( $iRotate > 90 );
  1039. $iInd = ( $iGen2 & 0x0F );
  1040. $iShrink = ( $iGen2 & 0x10 ) ? 1 : 0;
  1041. $iMerge = ( $iGen2 & 0x20 ) ? 1 : 0;
  1042. $iReadDir = ( ( $iGen2 & 0xC0 ) / 0x40 ) & 0x03;
  1043. $iBdrSL = $iBdr1 & 0x0F;
  1044. $iBdrSR = ( ( $iBdr1 & 0xF0 ) / 0x10 ) & 0x0F;
  1045. $iBdrST = ( ( $iBdr1 & 0xF00 ) / 0x100 ) & 0x0F;
  1046. $iBdrSB = ( ( $iBdr1 & 0xF000 ) / 0x1000 ) & 0x0F;
  1047. $iBdrCL = ( ( $iBdr2 & 0x7F ) ) & 0x7F;
  1048. $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
  1049. $iBdrD = ( ( $iBdr2 & 0xC000 ) / 0x4000 ) & 0x3;
  1050. $iBdrCT = ( ( $iBdr3 & 0x7F ) ) & 0x7F;
  1051. $iBdrCB = ( ( $iBdr3 & 0x3F80 ) / 0x80 ) & 0x7F;
  1052. $iBdrCD = ( ( $iBdr3 & 0x1FC000 ) / 0x4000 ) & 0x7F;
  1053. $iBdrSD = ( ( $iBdr3 & 0x1E00000 ) / 0x200000 ) & 0xF;
  1054. $iFillP = ( ( $iBdr3 & 0xFC000000 ) / 0x4000000 ) & 0x3F;
  1055. $iFillCF = ( $iPtn & 0x7F );
  1056. $iFillCB = ( ( $iPtn & 0x3F80 ) / 0x80 ) & 0x7F;
  1057. }
  1058. else {
  1059. my ( $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 );
  1060. ( $iFnt, $iIdx, $iGen, $iAlign, $iPtn, $iPtn2, $iBdr1, $iBdr2 ) =
  1061. unpack( "v8", $sWk );
  1062. $iLock = ( $iGen & 0x01 ) ? 1 : 0;
  1063. $iHidden = ( $iGen & 0x02 ) ? 1 : 0;
  1064. $iStyle = ( $iGen & 0x04 ) ? 1 : 0;
  1065. $i123 = ( $iGen & 0x08 ) ? 1 : 0;
  1066. $iAlH = ( $iAlign & 0x07 );
  1067. $iWrap = ( $iAlign & 0x08 ) ? 1 : 0;
  1068. $iAlV = ( $iAlign & 0x70 ) / 0x10;
  1069. $iJustL = ( $iAlign & 0x80 ) ? 1 : 0;
  1070. $iRotate = ( ( $iAlign & 0x300 ) / 0x100 ) & 0x3;
  1071. $iFillCF = ( $iPtn & 0x7F );
  1072. $iFillCB = ( ( $iPtn & 0x1F80 ) / 0x80 ) & 0x7F;
  1073. $iFillP = ( $iPtn2 & 0x3F );
  1074. $iBdrSB = ( ( $iPtn2 & 0x1C0 ) / 0x40 ) & 0x7;
  1075. $iBdrCB = ( ( $iPtn2 & 0xFE00 ) / 0x200 ) & 0x7F;
  1076. $iBdrST = ( $iBdr1 & 0x07 );
  1077. $iBdrSL = ( ( $iBdr1 & 0x38 ) / 0x8 ) & 0x07;
  1078. $iBdrSR = ( ( $iBdr1 & 0x1C0 ) / 0x40 ) & 0x07;
  1079. $iBdrCT = ( ( $iBdr1 & 0xFE00 ) / 0x200 ) & 0x7F;
  1080. $iBdrCL = ( $iBdr2 & 0x7F ) & 0x7F;
  1081. $iBdrCR = ( ( $iBdr2 & 0x3F80 ) / 0x80 ) & 0x7F;
  1082. }
  1083. push @{ $oBook->{Format} }, Spreadsheet::ParseExcel::Format->new(
  1084. FontNo => $iFnt,
  1085. Font => $oBook->{Font}[$iFnt],
  1086. FmtIdx => $iIdx,
  1087. Lock => $iLock,
  1088. Hidden => $iHidden,
  1089. Style => $iStyle,
  1090. Key123 => $i123,
  1091. AlignH => $iAlH,
  1092. Wrap => $iWrap,
  1093. AlignV => $iAlV,
  1094. JustLast => $iJustL,
  1095. Rotate => $iRotate,
  1096. Indent => $iInd,
  1097. Shrink => $iShrink,
  1098. Merge => $iMerge,
  1099. ReadDir => $iReadDir,
  1100. BdrStyle => [ $iBdrSL, $iBdrSR, $iBdrST, $iBdrSB ],
  1101. BdrColor => [ $iBdrCL, $iBdrCR, $iBdrCT, $iBdrCB ],
  1102. BdrDiag => [ $iBdrD, $iBdrSD, $iBdrCD ],
  1103. Fill => [ $iFillP, $iFillCF, $iFillCB ],
  1104. );
  1105. }
  1106. #------------------------------------------------------------------------------
  1107. # _subFormat (for Spreadsheet::ParseExcel) DK: P336
  1108. #------------------------------------------------------------------------------
  1109. sub _subFormat {
  1110. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1111. my $sFmt;
  1112. if ( $oBook->{BIFFVersion} <= verBIFF5 ) {
  1113. $sFmt = substr( $sWk, 3, unpack( 'c', substr( $sWk, 2, 1 ) ) );
  1114. $sFmt = $oBook->{FmtClass}->TextFmt( $sFmt, '_native_' );
  1115. }
  1116. else {
  1117. $sFmt = _convBIFF8String( $oBook, substr( $sWk, 2 ) );
  1118. }
  1119. my $format_index = unpack( 'v', substr( $sWk, 0, 2 ) );
  1120. # Excel 4 and earlier used an index of 0 to indicate that a built-in format
  1121. # that was stored implicitly.
  1122. if ( $oBook->{BIFFVersion} <= verBIFF4 && $format_index == 0 ) {
  1123. $format_index = keys %{ $oBook->{FormatStr} };
  1124. }
  1125. $oBook->{FormatStr}->{$format_index} = $sFmt;
  1126. }
  1127. #------------------------------------------------------------------------------
  1128. # _subPalette (for Spreadsheet::ParseExcel) DK: P393
  1129. #------------------------------------------------------------------------------
  1130. sub _subPalette {
  1131. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1132. for ( my $i = 0 ; $i < unpack( 'v', $sWk ) ; $i++ ) {
  1133. # push @aColor, unpack('H6', substr($sWk, $i*4+2));
  1134. $aColor[ $i + 8 ] = unpack( 'H6', substr( $sWk, $i * 4 + 2 ) );
  1135. }
  1136. }
  1137. #------------------------------------------------------------------------------
  1138. # _subFont (for Spreadsheet::ParseExcel) DK:P333
  1139. #------------------------------------------------------------------------------
  1140. sub _subFont {
  1141. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1142. my ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline, $sFntName );
  1143. my ( $bBold, $bItalic, $bUnderline, $bStrikeout );
  1144. if ( $oBook->{BIFFVersion} == verBIFF8 ) {
  1145. ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
  1146. unpack( "v5c", $sWk );
  1147. my ( $iSize, $iHigh ) = unpack( 'cc', substr( $sWk, 14, 2 ) );
  1148. if ($iHigh) {
  1149. $sFntName = substr( $sWk, 16, $iSize * 2 );
  1150. _SwapForUnicode( \$sFntName );
  1151. $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, 'ucs2' );
  1152. }
  1153. else {
  1154. $sFntName = substr( $sWk, 16, $iSize );
  1155. $sFntName = $oBook->{FmtClass}->TextFmt( $sFntName, '_native_' );
  1156. }
  1157. $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
  1158. $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
  1159. $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
  1160. $bUnderline = ($iUnderline) ? 1 : 0;
  1161. }
  1162. elsif ( $oBook->{BIFFVersion} == verBIFF5 ) {
  1163. ( $iHeight, $iAttr, $iCIdx, $iBold, $iSuper, $iUnderline ) =
  1164. unpack( "v5c", $sWk );
  1165. $sFntName =
  1166. $oBook->{FmtClass}
  1167. ->TextFmt( substr( $sWk, 15, unpack( "c", substr( $sWk, 14, 1 ) ) ),
  1168. '_native_' );
  1169. $bBold = ( $iBold >= 0x2BC ) ? 1 : 0;
  1170. $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
  1171. $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
  1172. $bUnderline = ($iUnderline) ? 1 : 0;
  1173. }
  1174. else {
  1175. ( $iHeight, $iAttr ) = unpack( "v2", $sWk );
  1176. $iCIdx = undef;
  1177. $iSuper = 0;
  1178. $bBold = ( $iAttr & 0x01 ) ? 1 : 0;
  1179. $bItalic = ( $iAttr & 0x02 ) ? 1 : 0;
  1180. $bUnderline = ( $iAttr & 0x04 ) ? 1 : 0;
  1181. $bStrikeout = ( $iAttr & 0x08 ) ? 1 : 0;
  1182. $sFntName = substr( $sWk, 5, unpack( "c", substr( $sWk, 4, 1 ) ) );
  1183. }
  1184. push @{ $oBook->{Font} }, Spreadsheet::ParseExcel::Font->new(
  1185. Height => $iHeight / 20.0,
  1186. Attr => $iAttr,
  1187. Color => $iCIdx,
  1188. Super => $iSuper,
  1189. UnderlineStyle => $iUnderline,
  1190. Name => $sFntName,
  1191. Bold => $bBold,
  1192. Italic => $bItalic,
  1193. Underline => $bUnderline,
  1194. Strikeout => $bStrikeout,
  1195. );
  1196. #Skip Font[4]
  1197. push @{ $oBook->{Font} }, {} if ( scalar( @{ $oBook->{Font} } ) == 4 );
  1198. }
  1199. #------------------------------------------------------------------------------
  1200. # _subBoundSheet (for Spreadsheet::ParseExcel): DK: P307
  1201. #------------------------------------------------------------------------------
  1202. sub _subBoundSheet {
  1203. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1204. my ( $iPos, $iGr, $iKind ) = unpack( "Lc2", $sWk );
  1205. $iKind &= 0x0F;
  1206. return if ( ( $iKind != 0x00 ) && ( $iKind != 0x01 ) );
  1207. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1208. my ( $iSize, $iUni ) = unpack( "cc", substr( $sWk, 6, 2 ) );
  1209. my $sWsName = substr( $sWk, 8 );
  1210. if ( $iUni & 0x01 ) {
  1211. _SwapForUnicode( \$sWsName );
  1212. $sWsName = $oBook->{FmtClass}->TextFmt( $sWsName, 'ucs2' );
  1213. }
  1214. $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
  1215. Spreadsheet::ParseExcel::Worksheet->new(
  1216. Name => $sWsName,
  1217. Kind => $iKind,
  1218. _Pos => $iPos,
  1219. _Book => $oBook,
  1220. _SheetNo => $oBook->{SheetCount},
  1221. );
  1222. }
  1223. else {
  1224. $oBook->{Worksheet}[ $oBook->{SheetCount} ] =
  1225. Spreadsheet::ParseExcel::Worksheet->new(
  1226. Name =>
  1227. $oBook->{FmtClass}->TextFmt( substr( $sWk, 7 ), '_native_' ),
  1228. Kind => $iKind,
  1229. _Pos => $iPos,
  1230. _Book => $oBook,
  1231. _SheetNo => $oBook->{SheetCount},
  1232. );
  1233. }
  1234. $oBook->{SheetCount}++;
  1235. }
  1236. #------------------------------------------------------------------------------
  1237. # _subHeader (for Spreadsheet::ParseExcel) DK: P340
  1238. #------------------------------------------------------------------------------
  1239. sub _subHeader {
  1240. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1241. return undef unless ( defined $oBook->{_CurSheet} );
  1242. my $sW;
  1243. #BIFF8
  1244. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1245. $sW = _convBIFF8String( $oBook, $sWk );
  1246. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
  1247. ( $sW eq "\x00" ) ? undef : $sW;
  1248. }
  1249. #Before BIFF8
  1250. else {
  1251. my ($iLen) = unpack( "c", $sWk );
  1252. $sW =
  1253. $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
  1254. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Header} =
  1255. ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
  1256. }
  1257. }
  1258. #------------------------------------------------------------------------------
  1259. # _subFooter (for Spreadsheet::ParseExcel) DK: P335
  1260. #------------------------------------------------------------------------------
  1261. sub _subFooter {
  1262. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1263. return undef unless ( defined $oBook->{_CurSheet} );
  1264. my $sW;
  1265. #BIFF8
  1266. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1267. $sW = _convBIFF8String( $oBook, $sWk );
  1268. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
  1269. ( $sW eq "\x00" ) ? undef : $sW;
  1270. }
  1271. #Before BIFF8
  1272. else {
  1273. my ($iLen) = unpack( "c", $sWk );
  1274. $sW =
  1275. $oBook->{FmtClass}->TextFmt( substr( $sWk, 1, $iLen ), '_native_' );
  1276. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Footer} =
  1277. ( $sW eq "\x00\x00\x00" ) ? undef : $sW;
  1278. }
  1279. }
  1280. #------------------------------------------------------------------------------
  1281. # _subHPageBreak (for Spreadsheet::ParseExcel) DK: P341
  1282. #------------------------------------------------------------------------------
  1283. sub _subHPageBreak {
  1284. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1285. my @aBreak;
  1286. my $iCnt = unpack( "v", $sWk );
  1287. return undef unless ( defined $oBook->{_CurSheet} );
  1288. #BIFF8
  1289. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1290. for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
  1291. my ( $iRow, $iColB, $iColE ) =
  1292. unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
  1293. # push @aBreak, [$iRow, $iColB, $iColE];
  1294. push @aBreak, $iRow;
  1295. }
  1296. }
  1297. #Before BIFF8
  1298. else {
  1299. for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
  1300. my ($iRow) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
  1301. push @aBreak, $iRow;
  1302. # push @aBreak, [$iRow, 0, 255];
  1303. }
  1304. }
  1305. @aBreak = sort { $a <=> $b } @aBreak;
  1306. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HPageBreak} = \@aBreak;
  1307. }
  1308. #------------------------------------------------------------------------------
  1309. # _subVPageBreak (for Spreadsheet::ParseExcel) DK: P447
  1310. #------------------------------------------------------------------------------
  1311. sub _subVPageBreak {
  1312. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1313. return undef unless ( defined $oBook->{_CurSheet} );
  1314. my @aBreak;
  1315. my $iCnt = unpack( "v", $sWk );
  1316. #BIFF8
  1317. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1318. for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
  1319. my ( $iCol, $iRowB, $iRowE ) =
  1320. unpack( 'v3', substr( $sWk, 2 + $i * 6, 6 ) );
  1321. push @aBreak, $iCol;
  1322. # push @aBreak, [$iCol, $iRowB, $iRowE];
  1323. }
  1324. }
  1325. #Before BIFF8
  1326. else {
  1327. for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
  1328. my ($iCol) = unpack( 'v', substr( $sWk, 2 + $i * 2, 2 ) );
  1329. push @aBreak, $iCol;
  1330. # push @aBreak, [$iCol, 0, 65535];
  1331. }
  1332. }
  1333. @aBreak = sort { $a <=> $b } @aBreak;
  1334. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VPageBreak} = \@aBreak;
  1335. }
  1336. #------------------------------------------------------------------------------
  1337. # _subMargin (for Spreadsheet::ParseExcel) DK: P306, 345, 400, 440
  1338. #------------------------------------------------------------------------------
  1339. sub _subMargin {
  1340. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1341. return undef unless ( defined $oBook->{_CurSheet} );
  1342. # The "Mergin" options are a workaround for a backward compatible typo.
  1343. my $dWk = _convDval( substr( $sWk, 0, 8 ) );
  1344. if ( $bOp == 0x26 ) {
  1345. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMergin} = $dWk;
  1346. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{LeftMargin} = $dWk;
  1347. }
  1348. elsif ( $bOp == 0x27 ) {
  1349. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMergin} = $dWk;
  1350. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{RightMargin} = $dWk;
  1351. }
  1352. elsif ( $bOp == 0x28 ) {
  1353. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMergin} = $dWk;
  1354. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{TopMargin} = $dWk;
  1355. }
  1356. elsif ( $bOp == 0x29 ) {
  1357. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMergin} = $dWk;
  1358. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{BottomMargin} = $dWk;
  1359. }
  1360. }
  1361. #------------------------------------------------------------------------------
  1362. # _subHcenter (for Spreadsheet::ParseExcel) DK: P340
  1363. #------------------------------------------------------------------------------
  1364. sub _subHcenter {
  1365. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1366. return undef unless ( defined $oBook->{_CurSheet} );
  1367. my $iWk = unpack( "v", $sWk );
  1368. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{HCenter} = $iWk;
  1369. }
  1370. #------------------------------------------------------------------------------
  1371. # _subVcenter (for Spreadsheet::ParseExcel) DK: P447
  1372. #------------------------------------------------------------------------------
  1373. sub _subVcenter {
  1374. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1375. return undef unless ( defined $oBook->{_CurSheet} );
  1376. my $iWk = unpack( "v", $sWk );
  1377. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{VCenter} = $iWk;
  1378. }
  1379. #------------------------------------------------------------------------------
  1380. # _subPrintGridlines (for Spreadsheet::ParseExcel) DK: P397
  1381. #------------------------------------------------------------------------------
  1382. sub _subPrintGridlines {
  1383. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1384. return undef unless ( defined $oBook->{_CurSheet} );
  1385. my $iWk = unpack( "v", $sWk );
  1386. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintGrid} = $iWk;
  1387. }
  1388. #------------------------------------------------------------------------------
  1389. # _subPrintHeaders (for Spreadsheet::ParseExcel) DK: P397
  1390. #------------------------------------------------------------------------------
  1391. sub _subPrintHeaders {
  1392. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1393. return undef unless ( defined $oBook->{_CurSheet} );
  1394. my $iWk = unpack( "v", $sWk );
  1395. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PrintHeaders} = $iWk;
  1396. }
  1397. #------------------------------------------------------------------------------
  1398. # _subSETUP (for Spreadsheet::ParseExcel) DK: P409
  1399. #------------------------------------------------------------------------------
  1400. sub _subSETUP {
  1401. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1402. return undef unless ( defined $oBook->{_CurSheet} );
  1403. my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
  1404. my $iGrBit;
  1405. (
  1406. $oWkS->{PaperSize}, $oWkS->{Scale}, $oWkS->{PageStart},
  1407. $oWkS->{FitWidth}, $oWkS->{FitHeight}, $iGrBit,
  1408. $oWkS->{Res}, $oWkS->{VRes},
  1409. ) = unpack( 'v8', $sWk );
  1410. $oWkS->{HeaderMargin} = _convDval( substr( $sWk, 16, 8 ) );
  1411. $oWkS->{FooterMargin} = _convDval( substr( $sWk, 24, 8 ) );
  1412. $oWkS->{Copis} = unpack( 'v2', substr( $sWk, 32, 2 ) );
  1413. $oWkS->{LeftToRight} = ( ( $iGrBit & 0x01 ) ? 1 : 0 );
  1414. $oWkS->{Landscape} = ( ( $iGrBit & 0x02 ) ? 1 : 0 );
  1415. $oWkS->{NoPls} = ( ( $iGrBit & 0x04 ) ? 1 : 0 );
  1416. $oWkS->{NoColor} = ( ( $iGrBit & 0x08 ) ? 1 : 0 );
  1417. $oWkS->{Draft} = ( ( $iGrBit & 0x10 ) ? 1 : 0 );
  1418. $oWkS->{Notes} = ( ( $iGrBit & 0x20 ) ? 1 : 0 );
  1419. $oWkS->{NoOrient} = ( ( $iGrBit & 0x40 ) ? 1 : 0 );
  1420. $oWkS->{UsePage} = ( ( $iGrBit & 0x80 ) ? 1 : 0 );
  1421. # The NoPls flag indicates that the values have not been taken from an
  1422. # actual printer and thus may not be accurate.
  1423. # Set default scale if NoPls otherwise it may be an invalid value of 0XFF.
  1424. $oWkS->{Scale} = 100 if $oWkS->{NoPls};
  1425. # Workaround for a backward compatible typo.
  1426. $oWkS->{HeaderMergin} = $oWkS->{HeaderMargin};
  1427. $oWkS->{FooterMergin} = $oWkS->{FooterMargin};
  1428. }
  1429. #------------------------------------------------------------------------------
  1430. # _subName (for Spreadsheet::ParseExcel) DK: P350
  1431. #------------------------------------------------------------------------------
  1432. sub _subName {
  1433. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1434. my (
  1435. $iGrBit, $cKey, $cCh, $iCce, $ixAls,
  1436. $iTab, $cchCust, $cchDsc, $cchHep, $cchStatus
  1437. ) = unpack( 'vc2v3c4', $sWk );
  1438. #Builtin Name + Length == 1
  1439. if ( ( $iGrBit & 0x20 ) && ( $cCh == 1 ) ) {
  1440. #BIFF8
  1441. if ( $oBook->{BIFFVersion} >= verBIFF8 ) {
  1442. my $iName = unpack( 'n', substr( $sWk, 14 ) );
  1443. my $iSheet = unpack( 'v', substr( $sWk, 8 ) ) - 1;
  1444. # Workaround for mal-formed Excel workbooks where Print_Title is
  1445. # set as Global (i.e. itab = 0). Note, this will have to be
  1446. # treated differently when we get around to handling global names.
  1447. return undef if $iSheet == -1;
  1448. if ( $iName == 6 ) { #PrintArea
  1449. my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
  1450. $oBook->{PrintArea}[$iSheet] = $raArea;
  1451. }
  1452. elsif ( $iName == 7 ) { #Title
  1453. my ( $iSheetW, $raArea ) = _ParseNameArea( substr( $sWk, 16 ) );
  1454. my @aTtlR = ();
  1455. my @aTtlC = ();
  1456. foreach my $raI (@$raArea) {
  1457. if ( $raI->[3] == 0xFF ) { #Row Title
  1458. push @aTtlR, [ $raI->[0], $raI->[2] ];
  1459. }
  1460. else { #Col Title
  1461. push @aTtlC, [ $raI->[1], $raI->[3] ];
  1462. }
  1463. }
  1464. $oBook->{PrintTitle}[$iSheet] =
  1465. { Row => \@aTtlR, Column => \@aTtlC };
  1466. }
  1467. }
  1468. else {
  1469. my $iName = unpack( 'c', substr( $sWk, 14 ) );
  1470. if ( $iName == 6 ) { #PrintArea
  1471. my ( $iSheet, $raArea ) =
  1472. _ParseNameArea95( substr( $sWk, 15 ) );
  1473. $oBook->{PrintArea}[$iSheet] = $raArea;
  1474. }
  1475. elsif ( $iName == 7 ) { #Title
  1476. my ( $iSheet, $raArea ) =
  1477. _ParseNameArea95( substr( $sWk, 15 ) );
  1478. my @aTtlR = ();
  1479. my @aTtlC = ();
  1480. foreach my $raI (@$raArea) {
  1481. if ( $raI->[3] == 0xFF ) { #Row Title
  1482. push @aTtlR, [ $raI->[0], $raI->[2] ];
  1483. }
  1484. else { #Col Title
  1485. push @aTtlC, [ $raI->[1], $raI->[3] ];
  1486. }
  1487. }
  1488. $oBook->{PrintTitle}[$iSheet] =
  1489. { Row => \@aTtlR, Column => \@aTtlC };
  1490. }
  1491. }
  1492. }
  1493. }
  1494. #------------------------------------------------------------------------------
  1495. # ParseNameArea (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
  1496. #------------------------------------------------------------------------------
  1497. sub _ParseNameArea {
  1498. my ($sObj) = @_;
  1499. my ($iOp);
  1500. my @aRes = ();
  1501. $iOp = unpack( 'C', $sObj );
  1502. my $iSheet;
  1503. if ( $iOp == 0x3b ) {
  1504. my ( $iWkS, $iRs, $iRe, $iCs, $iCe ) =
  1505. unpack( 'v5', substr( $sObj, 1 ) );
  1506. $iSheet = $iWkS;
  1507. push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
  1508. }
  1509. elsif ( $iOp == 0x29 ) {
  1510. my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
  1511. my $iSt = 0;
  1512. while ( $iSt < $iLen ) {
  1513. my ( $iOpW, $iWkS, $iRs, $iRe, $iCs, $iCe ) =
  1514. unpack( 'cv5', substr( $sObj, $iSt + 3, 11 ) );
  1515. if ( $iOpW == 0x3b ) {
  1516. $iSheet = $iWkS;
  1517. push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
  1518. }
  1519. if ( $iSt == 0 ) {
  1520. $iSt += 11;
  1521. }
  1522. else {
  1523. $iSt += 12; #Skip 1 byte;
  1524. }
  1525. }
  1526. }
  1527. return ( $iSheet, \@aRes );
  1528. }
  1529. #------------------------------------------------------------------------------
  1530. # ParseNameArea95 (for Spreadsheet::ParseExcel) DK: 494 (ptgAread3d)
  1531. #------------------------------------------------------------------------------
  1532. sub _ParseNameArea95 {
  1533. my ($sObj) = @_;
  1534. my ($iOp);
  1535. my @aRes = ();
  1536. $iOp = unpack( 'C', $sObj );
  1537. my $iSheet;
  1538. if ( $iOp == 0x3b ) {
  1539. $iSheet = unpack( 'v', substr( $sObj, 11, 2 ) );
  1540. my ( $iRs, $iRe, $iCs, $iCe ) =
  1541. unpack( 'v2C2', substr( $sObj, 15, 6 ) );
  1542. push @aRes, [ $iRs, $iCs, $iRe, $iCe ];
  1543. }
  1544. elsif ( $iOp == 0x29 ) {
  1545. my $iLen = unpack( 'v', substr( $sObj, 1, 2 ) );
  1546. my $iSt = 0;
  1547. while ( $iSt < $iLen ) {
  1548. my $iOpW = unpack( 'c', substr( $sObj, $iSt + 3, 6 ) );
  1549. $iSheet = unpack( 'v', substr( $sObj, $iSt + 14, 2 ) );
  1550. my ( $iRs, $iRe, $iCs, $iCe ) =
  1551. unpack( 'v2C2', substr( $sObj, $iSt + 18, 6 ) );
  1552. push @aRes, [ $iRs, $iCs, $iRe, $iCe ] if ( $iOpW == 0x3b );
  1553. if ( $iSt == 0 ) {
  1554. $iSt += 21;
  1555. }
  1556. else {
  1557. $iSt += 22; #Skip 1 byte;
  1558. }
  1559. }
  1560. }
  1561. return ( $iSheet, \@aRes );
  1562. }
  1563. #------------------------------------------------------------------------------
  1564. # _subBOOL (for Spreadsheet::ParseExcel) DK: P452
  1565. #------------------------------------------------------------------------------
  1566. sub _subWSBOOL {
  1567. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1568. return undef unless ( defined $oBook->{_CurSheet} );
  1569. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{PageFit} =
  1570. ( ( unpack( 'v', $sWk ) & 0x100 ) ? 1 : 0 );
  1571. }
  1572. #------------------------------------------------------------------------------
  1573. # _subMergeArea (for Spreadsheet::ParseExcel) DK: (Not)
  1574. #------------------------------------------------------------------------------
  1575. sub _subMergeArea {
  1576. my ( $oBook, $bOp, $bLen, $sWk ) = @_;
  1577. return undef unless ( defined $oBook->{_CurSheet} );
  1578. my $iCnt = unpack( "v", $sWk );
  1579. my $oWkS = $oBook->{Worksheet}[ $oBook->{_CurSheet} ];
  1580. $oWkS->{MergedArea} = [] unless ( defined $oWkS->{MergedArea} );
  1581. for ( my $i = 0 ; $i < $iCnt ; $i++ ) {
  1582. my ( $iRs, $iRe, $iCs, $iCe ) =
  1583. unpack( 'v4', substr( $sWk, $i * 8 + 2, 8 ) );
  1584. for ( my $iR = $iRs ; $iR <= $iRe ; $iR++ ) {
  1585. for ( my $iC = $iCs ; $iC <= $iCe ; $iC++ ) {
  1586. $oWkS->{Cells}[$iR][$iC]->{Merged} = 1
  1587. if ( defined $oWkS->{Cells}[$iR][$iC] );
  1588. }
  1589. }
  1590. push @{ $oWkS->{MergedArea} }, [ $iRs, $iCs, $iRe, $iCe ];
  1591. }
  1592. }
  1593. #------------------------------------------------------------------------------
  1594. # DecodeBoolErr (for Spreadsheet::ParseExcel) DK: P306
  1595. #------------------------------------------------------------------------------
  1596. sub DecodeBoolErr {
  1597. my ( $iVal, $iFlg ) = @_;
  1598. if ($iFlg) { # ERROR
  1599. if ( $iVal == 0x00 ) {
  1600. return "#NULL!";
  1601. }
  1602. elsif ( $iVal == 0x07 ) {
  1603. return "#DIV/0!";
  1604. }
  1605. elsif ( $iVal == 0x0F ) {
  1606. return "#VALUE!";
  1607. }
  1608. elsif ( $iVal == 0x17 ) {
  1609. return "#REF!";
  1610. }
  1611. elsif ( $iVal == 0x1D ) {
  1612. return "#NAME?";
  1613. }
  1614. elsif ( $iVal == 0x24 ) {
  1615. return "#NUM!";
  1616. }
  1617. elsif ( $iVal == 0x2A ) {
  1618. return "#N/A!";
  1619. }
  1620. else {
  1621. return "#ERR";
  1622. }
  1623. }
  1624. else {
  1625. return ($iVal) ? "TRUE" : "FALSE";
  1626. }
  1627. }
  1628. ###############################################################################
  1629. #
  1630. # _decode_rk_number()
  1631. #
  1632. # Convert an encoded RK number into a real number. The RK encoding is
  1633. # explained in some detail in the MS docs. It is a way of storing applicable
  1634. # ints and doubles in 32bits (30 data + 2 info bits) in order to save space.
  1635. #
  1636. sub _decode_rk_number {
  1637. my $rk_number = shift;
  1638. my $number;
  1639. # Check the main RK type.
  1640. if ( $rk_number & 0x02 ) {
  1641. # RK Type 2 and 4, a packed integer.
  1642. # Shift off the info bits.
  1643. $number = $rk_number >> 2;
  1644. # Convert from unsigned to signed if required.
  1645. $number -= 0x40000000 if $number & 0x20000000;
  1646. }
  1647. else {
  1648. # RK Type 1 and 3, a truncated IEEE Double.
  1649. # Pack the RK number into the high 30 bits of an IEEE double.
  1650. $number = pack "VV", 0x0000, $rk_number & 0xFFFFFFFC;
  1651. # Reverse the packed IEEE double on big-endian machines.
  1652. $number = reverse $number if $BIGENDIAN;
  1653. # Unpack the number.
  1654. $number = unpack "d", $number;
  1655. }
  1656. # RK Types 3 and 4 were multiplied by 100 prior to encoding.
  1657. $number /= 100 if $rk_number & 0x01;
  1658. return $number;
  1659. }
  1660. ###############################################################################
  1661. #
  1662. # _subStrWk()
  1663. #
  1664. # Extract the workbook strings from the SST (Shared String Table) record and
  1665. # any following CONTINUE records.
  1666. #
  1667. # The workbook strings are initially contained in the SST block but may also
  1668. # occupy one or more CONTINUE blocks. Reading the CONTINUE blocks is made a
  1669. # little tricky by the fact that they can contain an additional initial byte
  1670. # if a string is continued from a previous block.
  1671. #
  1672. # Parsing is further complicated by the fact that the continued section of the
  1673. # string may have a different encoding (ASCII or UTF-8) from the previous
  1674. # section. Excel does this to save space.
  1675. #
  1676. sub _subStrWk {
  1677. my ( $self, $biff_data, $is_continue ) = @_;
  1678. if ($is_continue) {
  1679. # We are reading a CONTINUE record.
  1680. if ( $self->{_buffer} eq '' ) {
  1681. # A CONTINUE block with no previous SST.
  1682. $self->{_buffer} .= $biff_data;
  1683. }
  1684. elsif ( !defined $self->{_string_continued} ) {
  1685. # The CONTINUE block starts with a new (non-continued) string.
  1686. # Strip the Grbit byte and store the string data.
  1687. $self->{_buffer} .= substr $biff_data, 1;
  1688. }
  1689. else {
  1690. # A CONTINUE block that starts with a continued string.
  1691. # The first byte (Grbit) of the CONTINUE record indicates if (0)
  1692. # the continued string section is single bytes or (1) double bytes.
  1693. my $grbit = ord $biff_data;
  1694. my ( $str_position, $str_length ) = @{ $self->{_previous_info} };
  1695. my $buff_length = length $self->{_buffer};
  1696. if ( $buff_length >= ( $str_position + $str_length ) ) {
  1697. # Not in a string.
  1698. $self->{_buffer} .= $biff_data;
  1699. }
  1700. elsif ( ( $self->{_string_continued} & 0x01 ) == ( $grbit & 0x01 ) )
  1701. {
  1702. # Same encoding as the previous block of the string.
  1703. $self->{_buffer} .= substr( $biff_data, 1 );
  1704. }
  1705. else {
  1706. # Different encoding to the previous block of the string.
  1707. if ( $grbit & 0x01 ) {
  1708. # Current block is UTF-16, previous was ASCII.
  1709. my ( undef, $cch ) = unpack 'vc', $self->{_buffer};
  1710. substr( $self->{_buffer}, 2, 1 ) = pack( 'C', $cch | 0x01 );
  1711. # Convert the previous ASCII, single character, portion of
  1712. # the string into a double character UTF-16 string by
  1713. # inserting zero bytes.
  1714. for (
  1715. my $i = ( $buff_length - $str_position ) ;
  1716. $i >= 1 ;
  1717. $i--
  1718. )
  1719. {
  1720. substr( $self->{_buffer}, $str_position + $i, 0 ) =
  1721. "\x00";
  1722. }
  1723. }
  1724. else {
  1725. # Current block is ASCII, previous was UTF-16.
  1726. # Convert the current ASCII, single character, portion of
  1727. # the string into a double character UTF-16 string by
  1728. # inserting null bytes.
  1729. my $change_length =
  1730. ( $str_position + $str_length ) - $buff_length;
  1731. # Length of the current CONTINUE record data.
  1732. my $biff_length = length $biff_data;
  1733. # Restrict the portion to be changed to the current block
  1734. # if the string extends over more than one block.
  1735. if ( $change_length > ( $biff_length - 1 ) * 2 ) {
  1736. $change_length = ( $biff_length - 1 ) * 2;
  1737. }
  1738. # Insert the null bytes.
  1739. for ( my $i = ( $change_length / 2 ) ; $i >= 1 ; $i-- ) {
  1740. substr( $biff_data, $i + 1, 0 ) = "\x00";
  1741. }
  1742. }
  1743. # Strip the Grbit byte and store the string data.
  1744. $self->{_buffer} .= substr $biff_data, 1;
  1745. }
  1746. }
  1747. }
  1748. else {
  1749. # Not a CONTINUE block therefore an SST block.
  1750. $self->{_buffer} .= $biff_data;
  1751. }
  1752. # Reset the state variables.
  1753. $self->{_string_continued} = undef;
  1754. $self->{_previous_info} = undef;
  1755. # Extract out any full strings from the current buffer leaving behind a
  1756. # partial string that is continued into the next block, or an empty
  1757. # buffer is no string is continued.
  1758. while ( length $self->{_buffer} >= 4 ) {
  1759. my ( $str_info, $length, $str_position, $str_length ) =
  1760. _convBIFF8String( $self, $self->{_buffer}, 1 );
  1761. if ( defined $str_info->[0] ) {
  1762. push @{ $self->{PkgStr} },
  1763. {
  1764. Text => $str_info->[0],
  1765. Unicode => $str_info->[1],
  1766. Rich => $str_info->[2],
  1767. Ext => $str_info->[3],
  1768. };
  1769. $self->{_buffer} = substr( $self->{_buffer}, $length );
  1770. }
  1771. else {
  1772. $self->{_string_continued} = $str_info->[1];
  1773. $self->{_previous_info} = [ $str_position, $str_length ];
  1774. last;
  1775. }
  1776. }
  1777. }
  1778. #------------------------------------------------------------------------------
  1779. # _SwapForUnicode (for Spreadsheet::ParseExcel)
  1780. #------------------------------------------------------------------------------
  1781. sub _SwapForUnicode {
  1782. my ($sObj) = @_;
  1783. # for(my $i = 0; $i<length($$sObj); $i+=2){
  1784. for ( my $i = 0 ; $i < ( int( length($$sObj) / 2 ) * 2 ) ; $i += 2 ) {
  1785. my $sIt = substr( $$sObj, $i, 1 );
  1786. substr( $$sObj, $i, 1 ) = substr( $$sObj, $i + 1, 1 );
  1787. substr( $$sObj, $i + 1, 1 ) = $sIt;
  1788. }
  1789. }
  1790. #------------------------------------------------------------------------------
  1791. # _NewCell (for Spreadsheet::ParseExcel)
  1792. #------------------------------------------------------------------------------
  1793. sub _NewCell {
  1794. my ( $oBook, $iR, $iC, %rhKey ) = @_;
  1795. my ( $sWk, $iLen );
  1796. return undef unless ( defined $oBook->{_CurSheet} );
  1797. my $FmtClass = $oBook->{FmtClass};
  1798. $rhKey{Type} =
  1799. $FmtClass->ChkType( $rhKey{Numeric}, $rhKey{Format}{FmtIdx} );
  1800. my $FmtStr = $oBook->{FormatStr}{ $rhKey{Format}{FmtIdx} };
  1801. # Set "Date" type if required for numbers in a MulRK BIFF block.
  1802. if ( defined $FmtStr && $rhKey{Type} eq "Numeric" ) {
  1803. # Match a range of possible date formats. Note: this isn't important
  1804. # except for reporting. The number will still be converted to a date
  1805. # by ExcelFmt() even if 'Type' isn't set to 'Date'.
  1806. if ( $FmtStr =~ m{^[dmy][-\\/dmy]*$}i ) {
  1807. $rhKey{Type} = "Date";
  1808. }
  1809. }
  1810. my $oCell = Spreadsheet::ParseExcel::Cell->new(
  1811. Val => $rhKey{Val},
  1812. FormatNo => $rhKey{FormatNo},
  1813. Format => $rhKey{Format},
  1814. Code => $rhKey{Code},
  1815. Type => $rhKey{Type},
  1816. );
  1817. $oCell->{_Kind} = $rhKey{Kind};
  1818. $oCell->{_Value} = $FmtClass->ValFmt( $oCell, $oBook );
  1819. if ( $rhKey{Rich} ) {
  1820. my @aRich = ();
  1821. my $sRich = $rhKey{Rich};
  1822. for ( my $iWk = 0 ; $iWk < length($sRich) ; $iWk += 4 ) {
  1823. my ( $iPos, $iFnt ) = unpack( 'v2', substr( $sRich, $iWk ) );
  1824. push @aRich, [ $iPos, $oBook->{Font}[$iFnt] ];
  1825. }
  1826. $oCell->{Rich} = \@aRich;
  1827. }
  1828. if ( defined $_CellHandler ) {
  1829. if ( defined $_Object ) {
  1830. no strict;
  1831. ref($_CellHandler) eq "CODE"
  1832. ? $_CellHandler->(
  1833. $_Object, $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell
  1834. )
  1835. : $_CellHandler->callback( $_Object, $oBook, $oBook->{_CurSheet},
  1836. $iR, $iC, $oCell );
  1837. }
  1838. else {
  1839. $_CellHandler->( $oBook, $oBook->{_CurSheet}, $iR, $iC, $oCell );
  1840. }
  1841. }
  1842. unless ($_NotSetCell) {
  1843. $oBook->{Worksheet}[ $oBook->{_CurSheet} ]->{Cells}[$iR][$iC] = $oCell;
  1844. }
  1845. return $oCell;
  1846. }
  1847. #------------------------------------------------------------------------------
  1848. # ColorIdxToRGB (for Spreadsheet::ParseExcel)
  1849. #
  1850. # TODO JMN Make this a Workbook method and re-document.
  1851. #
  1852. #------------------------------------------------------------------------------
  1853. sub ColorIdxToRGB {
  1854. my ( $sPkg, $iIdx ) = @_;
  1855. return ( ( defined $aColor[$iIdx] ) ? $aColor[$iIdx] : $aColor[0] );
  1856. }
  1857. ###############################################################################
  1858. #
  1859. # error().
  1860. #
  1861. # Return an error string for a failed parse().
  1862. #
  1863. sub error {
  1864. my $self = shift;
  1865. my $parse_error = $self->{_error_status};
  1866. if (exists $error_strings{$parse_error}) {
  1867. return $error_strings{$parse_error};
  1868. }
  1869. else {
  1870. return 'Unknown parse error';
  1871. }
  1872. }
  1873. ###############################################################################
  1874. #
  1875. # error_code().
  1876. #
  1877. # Return an error code for a failed parse().
  1878. #
  1879. sub error_code {
  1880. my $self = shift;
  1881. return $self->{_error_status};
  1882. }
  1883. ###############################################################################
  1884. #
  1885. # Mapping between legacy method names and new names.
  1886. #
  1887. {
  1888. no warnings; # Ignore warnings about variables used only once.
  1889. *Parse = *parse;
  1890. }
  1891. 1;
  1892. __END__
  1893. =head1 NAME
  1894. Spreadsheet::ParseExcel - Read information from an Excel file.
  1895. =head1 SYNOPSIS
  1896. #!/usr/bin/perl -w
  1897. use strict;
  1898. use Spreadsheet::ParseExcel;
  1899. my $parser = Spreadsheet::ParseExcel->new();
  1900. my $workbook = $parser->parse('Book1.xls');
  1901. if ( !defined $workbook ) {
  1902. die $parser->error(), ".\n";
  1903. }
  1904. for my $worksheet ( $workbook->worksheets() ) {
  1905. my ( $row_min, $row_max ) = $worksheet->row_range();
  1906. my ( $col_min, $col_max ) = $worksheet->col_range();
  1907. for my $row ( $row_min .. $row_max ) {
  1908. for my $col ( $col_min .. $col_max ) {
  1909. my $cell = $worksheet->get_cell( $row, $col );
  1910. next unless $cell;
  1911. print "Row, Col = ($row, $col)\n";
  1912. print "Value = ", $cell->value(), "\n";
  1913. print "Unformatted = ", $cell->unformatted(), "\n";
  1914. print "\n";
  1915. }
  1916. }
  1917. }
  1918. =head1 DESCRIPTION
  1919. The Spreadsheet::ParseExcel module can be used to read information from Excel 95-2003 binary files.
  1920. The module cannot read files in the Excel 2007 Open XML XLSX format. See the L<Spreadsheet::XLSX> module instead.
  1921. =head1 Parser
  1922. =head2 new()
  1923. The C<new()> method is used to create a new C<Spreadsheet::ParseExcel> parser object.
  1924. my $parser = Spreadsheet::ParseExcel->new();
  1925. As an advanced feature it is also possible to pass a call-back handler to the parser to control the parsing of the spreadsheet.
  1926. $parser = Spreadsheet::ParseExcel->new(
  1927. [
  1928. CellHandler => \&cell_handler,
  1929. NotSetCell => 1,
  1930. ]);
  1931. The call-back can be used to ignore certain cells or to reduce memory usage. See the section L<Reducing the memory usage of Spreadsheet::ParseExcel> for more information.
  1932. =head2 parse($filename, [$formatter])
  1933. The Parser C<parse()> method return a L</Workbook> object.
  1934. my $parser = Spreadsheet::ParseExcel->new();
  1935. my $workbook = $parser->parse('Book1.xls');
  1936. If an error occurs C<parse()> returns C<undef>. In general programs should contain a test for failed parsing as follows:
  1937. my $parser = Spreadsheet::ParseExcel->new();
  1938. my $workbook = $parser->parse('Book1.xls');
  1939. if ( !defined $workbook ) {
  1940. die $parser->error(), ".\n";
  1941. }
  1942. The C<$filename> parameter is generally the file to be parsed. However, it can also be a filehandle or a scalar reference.
  1943. The optional C<$formatter> array ref can be an reference to a L</Formatter Class> to format the value of cells.
  1944. Note: Versions of Spreadsheet::ParseExcel prior to 0.50 also documented a Workbook C<parse()> method as a syntactic shortcut for the above C<new()> and C<parse()> combination. This is now deprecated since it breaks error handling.
  1945. =head2 error()
  1946. The Parser C<error()> method returns an error string if a C<parse()> fails:
  1947. my $parser = Spreadsheet::ParseExcel->new();
  1948. my $workbook = $parser->parse('Book1.xls');
  1949. if ( !defined $workbook ) {
  1950. die $parser->error(), ".\n";
  1951. }
  1952. If you wish to generate you own error string you can use the C<error_code()> method instead (see below). The C<error()> and C<error_code()> values are as follows:
  1953. error() error_code()
  1954. ======= ============
  1955. '' 0
  1956. 'File not found' 1
  1957. 'No Excel data found in file' 2
  1958. 'File is encrypted' 3
  1959. Spreadsheet::ParseExcel doesn't try to decrypt an encrypted Excel file. That is beyond the current scope of the module.
  1960. The C<error_code()> method is explained below.
  1961. =head2 error_code()
  1962. The Parser C<error_code()> method returns an error code if a C<parse()> fails:
  1963. my $parser = Spreadsheet::ParseExcel->new();
  1964. my $workbook = $parser->parse('Book1.xls');
  1965. if ( !defined $workbook ) {
  1966. die "Got error code ", $parser->error_code, ".\n";
  1967. }
  1968. This can be useful if you wish to employ you own error strings or error handling methods.
  1969. =head1 Workbook
  1970. A C<Spreadsheet::ParseExcel::Workbook> is created via the C<Spreadsheet::ParseExcel> C<parse()> method:
  1971. my $parser = Spreadsheet::ParseExcel->new();
  1972. my $workbook = $parser->parse('Book1.xls');
  1973. The main methods of the Workbook class are:
  1974. $workbook->worksheets()
  1975. $workbook->worksheet()
  1976. $workbook->worksheet_count()
  1977. $workbook->get_filename()
  1978. These more commonly used methods of the Workbook class are outlined below. The other, less commonly used, methods are documented in L<Spreadsheet::ParseExcel::Worksheet>.
  1979. =head2 worksheets()
  1980. Returns an array of L</Worksheet> objects. This was most commonly used to iterate over the worksheets in a workbook:
  1981. for my $worksheet ( $workbook->worksheets() ) {
  1982. ...
  1983. }
  1984. =head2 worksheet()
  1985. The C<worksheet()> method returns a single C<Worksheet> object using either its name or index:
  1986. $worksheet = $workbook->worksheet('Sheet1');
  1987. $worksheet = $workbook->worksheet(0);
  1988. Returns C<undef> if the sheet name or index doesn't exist.
  1989. =head2 worksheet_count()
  1990. The C<worksheet_count()> method returns the number of Worksheet objects in the Workbook.
  1991. my $worksheet_count = $workbook->worksheet_count();
  1992. =head2 get_filename()
  1993. The C<get_filename()> method returns the name of the Excel file of C<undef> if the data was read from a filehandle rather than a file.
  1994. my $filename = $workbook->get_filename();
  1995. =head2 Other Workbook Methods
  1996. For full documentation of the methods available via a Workbook object see L<Spreadsheet::ParseExcel::Workbook>.
  1997. =head1 Worksheet
  1998. The C<Spreadsheet::ParseExcel::Worksheet> class encapsulates the properties of an Excel worksheet.
  1999. A Worksheet object is obtained via the L</worksheets()> or L</worksheet()> methods.
  2000. for my $worksheet ( $workbook->worksheets() ) {
  2001. ...
  2002. }
  2003. # Or:
  2004. $worksheet = $workbook->worksheet('Sheet1');
  2005. $worksheet = $workbook->worksheet(0);
  2006. The most commonly used methods of the Worksheet class are:
  2007. $worksheet->get_cell()
  2008. $worksheet->row_range()
  2009. $worksheet->col_range()
  2010. $worksheet->get_name()
  2011. The Spreadsheet::ParseExcel::Worksheet class exposes a lot of methods but in general very few are required unless you are writing an advanced filter.
  2012. The most commonly used methods are detailed below. The others are documented in L<Spreadsheet::ParseExcel::Worksheet>.
  2013. =head2 get_cell($row, $col)
  2014. Return the L</Cell> object at row C<$row> and column C<$col> if it is defined. Otherwise returns undef.
  2015. my $cell = $worksheet->get_cell($row, $col);
  2016. =head2 row_range()
  2017. Returns a two-element list C<($min, $max)> containing the minimum and maximum defined rows in the worksheet. If there is no row defined C<$max> is smaller than C<$min>.
  2018. my ( $row_min, $row_max ) = $worksheet->row_range();
  2019. =head2 col_range()
  2020. Returns a two-element list C<($min, $max)> containing the minimum and maximum of defined columns in the worksheet. If there is no column defined C<$max> is smaller than C<$min>.
  2021. my ( $col_min, $col_max ) = $worksheet->col_range();
  2022. =head2 get_name()
  2023. The C<get_name()> method returns the name of the worksheet, such as 'Sheet1'.
  2024. my $name = $worksheet->get_name();
  2025. =head2 Other Worksheet Methods
  2026. For other, less commonly used, Worksheet methods see L<Spreadsheet::ParseExcel::Worksheet>.
  2027. =head1 Cell
  2028. The C<Spreadsheet::ParseExcel::Cell> class has the following main methods.
  2029. $cell->value()
  2030. $cell->unformatted()
  2031. =head2 value()
  2032. The C<value()> method returns the formatted value of the cell.
  2033. my $value = $cell->value();
  2034. Formatted in this sense refers to the numeric format of the cell value. For example a number such as 40177 might be formatted as 40,117, 40117.000 or even as the date 2009/12/30.
  2035. If the cell doesn't contain a numeric format then the formatted and unformatted cell values are the same, see the C<unformatted()> method below.
  2036. For a defined C<$cell> the C<value()> method will always return a value.
  2037. In the case of a cell with formatting but no numeric or string contents the method will return the empty string C<''>.
  2038. =head2 unformatted()
  2039. The C<unformatted()> method returns the unformatted value of the cell.
  2040. my $unformatted = $cell->unformatted();
  2041. Returns the cell value without a numeric format. See the C<value()> method above.
  2042. =head2 Other Cell Methods
  2043. For other, less commonly used, Worksheet methods see L<Spreadsheet::ParseExcel::Cell>.
  2044. =head1 Format
  2045. The C<Spreadsheet::ParseExcel::Format> class has the following properties:
  2046. =head2 Format properties
  2047. $format->{Font}
  2048. $format->{AlignH}
  2049. $format->{AlignV}
  2050. $format->{Indent}
  2051. $format->{Wrap}
  2052. $format->{Shrink}
  2053. $format->{Rotate}
  2054. $format->{JustLast}
  2055. $format->{ReadDir}
  2056. $format->{BdrStyle}
  2057. $format->{BdrColor}
  2058. $format->{BdrDiag}
  2059. $format->{Fill}
  2060. $format->{Lock}
  2061. $format->{Hidden}
  2062. $format->{Style}
  2063. These properties are generally only of interest to advanced users. Casual users can skip this section.
  2064. =head2 $format->{Font}
  2065. Returns the L</Font> object for the Format.
  2066. =head2 $format->{AlignH}
  2067. Returns the horizontal alignment of the format where the value has the following meaning:
  2068. 0 => No alignment
  2069. 1 => Left
  2070. 2 => Center
  2071. 3 => Right
  2072. 4 => Fill
  2073. 5 => Justify
  2074. 6 => Center across
  2075. 7 => Distributed/Equal spaced
  2076. =head2 $format->{AlignV}
  2077. Returns the vertical alignment of the format where the value has the following meaning:
  2078. 0 => Top
  2079. 1 => Center
  2080. 2 => Bottom
  2081. 3 => Justify
  2082. 4 => Distributed/Equal spaced
  2083. =head2 $format->{Indent}
  2084. Returns the indent level of the C<Left> horizontal alignment.
  2085. =head2 $format->{Wrap}
  2086. Returns true if textwrap is on.
  2087. =head2 $format->{Shrink}
  2088. Returns true if "Shrink to fit" is set for the format.
  2089. =head2 $format->{Rotate}
  2090. Returns the text rotation. In Excel97+, it returns the angle in degrees of the text rotation.
  2091. In Excel95 or earlier it returns a value as follows:
  2092. 0 => No rotation
  2093. 1 => Top down
  2094. 2 => 90 degrees anti-clockwise,
  2095. 3 => 90 clockwise
  2096. =head2 $format->{JustLast}
  2097. Return true if the "justify last" property is set for the format.
  2098. =head2 $format->{ReadDir}
  2099. Returns the direction that the text is read from.
  2100. =head2 $format->{BdrStyle}
  2101. Returns an array ref of border styles as follows:
  2102. [ $left, $right, $top, $bottom ]
  2103. =head2 $format->{BdrColor}
  2104. Returns an array ref of border color indexes as follows:
  2105. [ $left, $right, $top, $bottom ]
  2106. =head2 $format->{BdrDiag}
  2107. Returns an array ref of diagonal border kind, style and color index as follows:
  2108. [$kind, $style, $color ]
  2109. Where kind is:
  2110. 0 => None
  2111. 1 => Right-Down
  2112. 2 => Right-Up
  2113. 3 => Both
  2114. =head2 $format->{Fill}
  2115. Returns an array ref of fill pattern and color indexes as follows:
  2116. [ $pattern, $front_color, $back_color ]
  2117. =head2 $format->{Lock}
  2118. Returns true if the cell is locked.
  2119. =head2 $format->{Hidden}
  2120. Returns true if the cell is Hidden.
  2121. =head2 $format->{Style}
  2122. Returns true if the format is a Style format.
  2123. =head1 Font
  2124. I<Spreadsheet::ParseExcel::Font>
  2125. Format class has these properties:
  2126. =head1 Font Properties
  2127. $font->{Name}
  2128. $font->{Bold}
  2129. $font->{Italic}
  2130. $font->{Height}
  2131. $font->{Underline}
  2132. $font->{UnderlineStyle}
  2133. $font->{Color}
  2134. $font->{Strikeout}
  2135. $font->{Super}
  2136. =head2 $font->{Name}
  2137. Returns the name of the font, for example 'Arial'.
  2138. =head2 $font->{Bold}
  2139. Returns true if the font is bold.
  2140. =head2 $font->{Italic}
  2141. Returns true if the font is italic.
  2142. =head2 $font->{Height}
  2143. Returns the size (height) of the font.
  2144. =head2 $font->{Underline}
  2145. Returns true if the font in underlined.
  2146. =head2 $font->{UnderlineStyle}
  2147. Returns the style of an underlined font where the value has the following meaning:
  2148. 0 => None
  2149. 1 => Single
  2150. 2 => Double
  2151. 33 => Single accounting
  2152. 34 => Double accounting
  2153. =head2 $font->{Color}
  2154. Returns the color index for the font. The index can be converted to a RGB string using the C<ColorIdxToRGB()> Parser method.
  2155. =head2 $font->{Strikeout}
  2156. Returns true if the font has the strikeout property set.
  2157. =head2 $font->{Super}
  2158. Returns one of the following values if the superscript or subscript property of the font is set:
  2159. 0 => None
  2160. 1 => Superscript
  2161. 2 => Subscript
  2162. =head1 Formatter class
  2163. I<Spreadsheet::ParseExcel::Fmt*>
  2164. Formatter class will convert cell data.
  2165. Spreadsheet::ParseExcel includes 2 formatter classes. C<FmtDefault> and C<FmtJapanese>. It is also possible to create a user defined formatting class.
  2166. The formatter class C<Spreadsheet::ParseExcel::Fmt*> should provide the following functions:
  2167. =head2 ChkType($self, $is_numeric, $format_index)
  2168. Method to check the type of data in the cell. Should return C<Date>, C<Numeric> or C<Text>. It is passed the following parameters:
  2169. =over
  2170. =item $self
  2171. A scalar reference to the Formatter object.
  2172. =item $is_numeric
  2173. If true, the value seems to be number.
  2174. =item $format_index
  2175. The index number for the cell Format object.
  2176. =back
  2177. =head2 TextFmt($self, $string_data, $string_encoding)
  2178. Converts the string data in the cell into the correct encoding. It is passed the following parameters:
  2179. =over
  2180. =item $self
  2181. A scalar reference to the Formatter object.
  2182. =item $string_data
  2183. The original string/text data.
  2184. =item $string_encoding
  2185. The character encoding of original string/text.
  2186. =back
  2187. =head2 ValFmt($self, $cell, $workbook)
  2188. Convert the original unformatted cell value into the appropriate formatted value. For instance turn a number into a formatted date. It is passed the following parameters:
  2189. =over
  2190. =item $self
  2191. A scalar reference to the Formatter object.
  2192. =item $cell
  2193. A scalar reference to the Cell object.
  2194. =item $workbook
  2195. A scalar reference to the Workbook object.
  2196. =back
  2197. =head2 FmtString($self, $cell, $workbook)
  2198. Get the format string for the Cell. It is passed the following parameters:
  2199. =over
  2200. =item $self
  2201. A scalar reference to the Formatter object.
  2202. =item $cell
  2203. A scalar reference to the Cell object.
  2204. =item $workbook
  2205. A scalar reference to the Workbook object.
  2206. =back
  2207. =head1 Reducing the memory usage of Spreadsheet::ParseExcel
  2208. In some cases a C<Spreadsheet::ParseExcel> application may consume a lot of memory when processing a large Excel file and, as a result, may fail to complete. The following explains why this can occur and how to resolve it.
  2209. C<Spreadsheet::ParseExcel> processes an Excel file in two stages. In the first stage it extracts the Excel binary stream from the OLE container file using C<OLE::Storage_Lite>. In the second stage it parses the binary stream to read workbook, worksheet and cell data which it then stores in memory. The majority of the memory usage is required for storing cell data.
  2210. The reason for this is that as the Excel file is parsed and each cell is encountered a cell handling function creates a relatively large nested cell object that contains the cell value and all of the data that relates to the cell formatting. For large files (a 10MB Excel file on a 256MB system) this overhead can cause the system to grind to a halt.
  2211. However, in a lot of cases when an Excel file is being processed the only information that is required are the cell values. In these cases it is possible to avoid most of the memory overhead by specifying your own cell handling function and by telling Spreadsheet::ParseExcel not to store the parsed cell data. This is achieved by passing a cell handler function to C<new()> when creating the parse object. Here is an example.
  2212. #!/usr/bin/perl -w
  2213. use strict;
  2214. use Spreadsheet::ParseExcel;
  2215. my $parser = Spreadsheet::ParseExcel->new(
  2216. CellHandler => \&cell_handler,
  2217. NotSetCell => 1
  2218. );
  2219. my $workbook = $parser->parse('file.xls');
  2220. sub cell_handler {
  2221. my $workbook = $_[0];
  2222. my $sheet_index = $_[1];
  2223. my $row = $_[2];
  2224. my $col = $_[3];
  2225. my $cell = $_[4];
  2226. # Do something useful with the formatted cell value
  2227. print $cell->value(), "\n";
  2228. }
  2229. The user specified cell handler is passed as a code reference to C<new()> along with the parameter C<NotSetCell> which tells Spreadsheet::ParseExcel not to store the parsed cell. Note, you don't have to iterate over the rows and columns, this happens automatically as part of the parsing.
  2230. The cell handler is passed 5 arguments. The first, C<$workbook>, is a reference to the C<Spreadsheet::ParseExcel::Workbook> object that represent the parsed workbook. This can be used to access any of the C<Spreadsheet::ParseExcel::Workbook> methods, see L</Workbook>. The second C<$sheet_index> is the zero-based index of the worksheet being parsed. The third and fourth, C<$row> and C<$col>, are the zero-based row and column number of the cell. The fifth, C<$cell>, is a reference to the C<Spreadsheet::ParseExcel::Cell> object. This is used to extract the data from the cell. See L</Cell> for more information.
  2231. This technique can be useful if you are writing an Excel to database filter since you can put your DB calls in the cell handler.
  2232. If you don't want all of the data in the spreadsheet you can add some control logic to the cell handler. For example we can extend the previous example so that it only prints the first 10 rows of the first two worksheets in the parsed workbook by adding some C<if()> statements to the cell handler:
  2233. #!/usr/bin/perl -w
  2234. use strict;
  2235. use Spreadsheet::ParseExcel;
  2236. my $parser = Spreadsheet::ParseExcel->new(
  2237. CellHandler => \&cell_handler,
  2238. NotSetCell => 1
  2239. );
  2240. my $workbook = $parser->parse('file.xls');
  2241. sub cell_handler {
  2242. my $workbook = $_[0];
  2243. my $sheet_index = $_[1];
  2244. my $row = $_[2];
  2245. my $col = $_[3];
  2246. my $cell = $_[4];
  2247. # Skip some worksheets and rows (inefficiently).
  2248. return if $sheet_index >= 3;
  2249. return if $row >= 10;
  2250. # Do something with the formatted cell value
  2251. print $cell->value(), "\n";
  2252. }
  2253. However, this still processes the entire workbook. If you wish to save some additional processing time you can abort the parsing after you have read the data that you want, using the workbook C<ParseAbort> method:
  2254. #!/usr/bin/perl -w
  2255. use strict;
  2256. use Spreadsheet::ParseExcel;
  2257. my $parser = Spreadsheet::ParseExcel->new(
  2258. CellHandler => \&cell_handler,
  2259. NotSetCell => 1
  2260. );
  2261. my $workbook = $parser->parse('file.xls');
  2262. sub cell_handler {
  2263. my $workbook = $_[0];
  2264. my $sheet_index = $_[1];
  2265. my $row = $_[2];
  2266. my $col = $_[3];
  2267. my $cell = $_[4];
  2268. # Skip some worksheets and rows (more efficiently).
  2269. if ( $sheet_index >= 1 and $row >= 10 ) {
  2270. $workbook->ParseAbort(1);
  2271. return;
  2272. }
  2273. # Do something with the formatted cell value
  2274. print $cell->value(), "\n";
  2275. }
  2276. =head1 KNOWN PROBLEMS
  2277. =over
  2278. =item * Issues reported by users: http://rt.cpan.org/Public/Dist/Display.html?Name=Spreadsheet-ParseExcel
  2279. =item * This module cannot read the values of formulas from files created with Spreadsheet::WriteExcel unless the user specified the values when creating the file (which is generally not the case). The reason for this is that Spreadsheet::WriteExcel writes the formula but not the formula result since it isn't in a position to calculate arbitrary Excel formulas without access to Excel's formula engine.
  2280. =item * If Excel has date fields where the specified format is equal to the system-default for the short-date locale, Excel does not store the format, but defaults to an internal format which is system dependent. In these cases ParseExcel uses the date format 'yyyy-mm-dd'.
  2281. =back
  2282. =head1 REPORTING A BUG
  2283. Bugs can be reported via rt.cpan.org. See the following for instructions on bug reporting for Spreadsheet::ParseExcel
  2284. http://rt.cpan.org/Public/Dist/Display.html?Name=Spreadsheet-ParseExcel
  2285. =head1 SEE ALSO
  2286. =over
  2287. =item * xls2csv by Ken Prows (http://search.cpan.org/~ken/xls2csv-1.06/script/xls2csv).
  2288. =item * xls2csv and xlscat by H.Merijn Brand (these utilities are part of Spreadsheet::Read, see below).
  2289. =item * excel2txt by Ken Youens-Clark, (http://search.cpan.org/~kclark/excel2txt/excel2txt). This is an excellent example of an Excel filter using Spreadsheet::ParseExcel. It can produce CSV, Tab delimited, Html, XML and Yaml.
  2290. =item * XLSperl by Jon Allen (http://search.cpan.org/~jonallen/XLSperl/bin/XLSperl). This application allows you to use Perl "one-liners" with Microsoft Excel files.
  2291. =item * Spreadsheet::XLSX (http://search.cpan.org/~dmow/Spreadsheet-XLSX/lib/Spreadsheet/XLSX.pm) by Dmitry Ovsyanko. A module with a similar interface to Spreadsheet::ParseExcel for parsing Excel 2007 XLSX OpenXML files.
  2292. =item * Spreadsheet::Read (http://search.cpan.org/~hmbrand/Spreadsheet-Read/Read.pm) by H.Merijn Brand. A single interface for reading several different spreadsheet formats.
  2293. =item * Spreadsheet::WriteExcel (http://search.cpan.org/~jmcnamara/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm). A perl module for creating new Excel files.
  2294. =item * Spreadsheet::ParseExcel::SaveParser (http://search.cpan.org/~jmcnamara/Spreadsheet-ParseExcel/lib/Spreadsheet/ParseExcel/SaveParser.pm). This is a combination of Spreadsheet::ParseExcel and Spreadsheet::WriteExcel and it allows you to "rewrite" an Excel file. See the following example (http://search.cpan.org/~jmcnamara/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm#MODIFYING_AND_REWRITING_EXCEL_FILES). It is part of the Spreadsheet::ParseExcel distro.
  2295. =item * Text::CSV_XS (http://search.cpan.org/~hmbrand/Text-CSV_XS/CSV_XS.pm) by H.Merijn Brand. A fast and rigorous module for reading and writing CSV data. Don't consider rolling your own CSV handling, use this module instead.
  2296. =back
  2297. =head1 MAILING LIST
  2298. There is a Google group for discussing and asking questions about Spreadsheet::ParseExcel. This is a good place to search to see if your question has been asked before: http://groups-beta.google.com/group/spreadsheet-parseexcel/
  2299. =head1 DONATIONS
  2300. If you'd care to donate to the Spreadsheet::ParseExcel project, you can do so via PayPal: http://tinyurl.com/7ayes
  2301. =head1 TODO
  2302. =over
  2303. =item * The current maintenance work is directed towards making the documentation more useful, improving and simplifying the API, and improving the maintainability of the code base. After that new features will be added.
  2304. =item * Fix open bugs and documentation for SaveParser.
  2305. =item * Add Formula support, Hyperlink support, Named Range support.
  2306. =item * Improve Spreadsheet::ParseExcel::SaveParser compatibility with Spreadsheet::WriteExcel.
  2307. =item * Improve Unicode and other encoding support. This will probably require dropping support for perls prior to 5.8+.
  2308. =back
  2309. =head1 ACKNOWLEDGEMENTS
  2310. From Kawai Takanori:
  2311. First of all, I would like to acknowledge the following valuable programs and modules:
  2312. XHTML, OLE::Storage and Spreadsheet::WriteExcel.
  2313. In no particular order: Yamaji Haruna, Simamoto Takesi, Noguchi Harumi, Ikezawa Kazuhiro, Suwazono Shugo, Hirofumi Morisada, Michael Edwards, Kim Namusk, Slaven Rezic, Grant Stevens, H.Merijn Brand and many many people + Kawai Mikako.
  2314. =head1 DISCLAIMER OF WARRANTY
  2315. Because this software is licensed free of charge, there is no warranty for the software, to the extent permitted by applicable law. Except when otherwise stated in writing the copyright holders and/or other parties provide the software "as is" without warranty of any kind, either expressed or implied, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose. The entire risk as to the quality and performance of the software is with you. Should the software prove defective, you assume the cost of all necessary servicing, repair, or correction.
  2316. In no event unless required by applicable law or agreed to in writing will any copyright holder, or any other party who may modify and/or redistribute the software as permitted by the above licence, be liable to you for damages, including any general, special, incidental, or consequential damages arising out of the use or inability to use the software (including but not limited to loss of data or data being rendered inaccurate or losses sustained by you or third parties or a failure of the software to operate with any other software), even if such holder or other party has been advised of the possibility of such damages.
  2317. =head1 LICENSE
  2318. Either the Perl Artistic Licence http://dev.perl.org/licenses/artistic.html or the GPL http://www.opensource.org/licenses/gpl-license.php
  2319. =head1 AUTHOR
  2320. Current maintainer 0.40+: John McNamara jmcnamara@cpan.org
  2321. Maintainer 0.27-0.33: Gabor Szabo szabgab@cpan.org
  2322. Original author: Kawai Takanori (Hippo2000) kwitknr@cpan.org
  2323. =head1 COPYRIGHT
  2324. Copyright (c) 2009-2010 John McNamara
  2325. Copyright (c) 2006-2008 Gabor Szabo
  2326. Copyright (c) 2000-2006 Kawai Takanori
  2327. All rights reserved. This is free software. You may distribute under the terms of either the GNU General Public License or the Artistic License.
  2328. =cut