/* Extract data from an excel xlsx file                                      */
/* Sahananda    April 2026                                                   */
/* This is demonstration code - no warantee of operability exists            */
/* feel free to learn from, use, develop, amend or ignore it as you see fit  */

/* ========================================================================= */
::requires "BSF.CLS"                    -- for gui and allow bsf formats
::requires "json.cls"                   -- to prepare data for passing
/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::class xlSheetXMLParser                                              public
/* ========================== class  methods =============================== */
::Attribute sheetsinFile get                                          class --
use arg file

   xml  = extractXMLFromWorkBook(file,'xl/workbook.xml')
   parse value xml~content with . '<sheets>'sheetsXML'</sheets>' .

   sheets = .array~new
   do while sheetsXML \= ''
      parse var sheetsXML .'name="'sheetTitle'"'."/>" sheetsXML
      sheets~append(sheetTitle)
   end /* DO */

RETURN sheets
/* ========================= instance methods ============================== */
::attribute columnsByTitle              -- column objects by title
::attribute columnsByReference          -- column objects by reference
::attribute rows                        -- an array of directories (rows)
::attribute continue_after_empty_rows?  -- stop looking for data on empty row?
::attribute sheetsTable                 -- proxy for xml table
::attribute relationshipsTable          -- proxy for xml table
::attribute sharedStrings               -- proxy for xml table (array)
::attribute json     GET
expose rows

   if \rows~isA(.array) then self~processRows

   if arg(1,'e')
   then if arg(1)~datatype('W'), rows~hasIndex(arg(1))
        then RETURN .json~new~toJson(rows[arg(1)])   -- return a single row
        else RETURN .nil                             -- nothing to return
   else      RETURN .json~new~toJson(rows)           -- return all rows

::attribute tableTxt GET
expose rows columnsByTitle columnsByReference
use arg col_separator = '|', row_separator = '-'

   if \rows~isA(.array) then self~processRows

   allColsRefs = columnsByReference~allIndexes~sort
   out        = .array~new(rows~items + 1)
   headers    = .array~new(allColsRefs~items)
   underline  = .mutableBuffer~new
   do ref over allColsRefs
      header  = columnsByReference~at(ref)
      width   = header~width
      headers~append(header~title)
      underline~append(row_separator~copies(width)||col_separator)
   end /* DO */
   out~append(headers~makestring('l',col_separator))
   out~append(underline~delete(underline~length,1))

   do row over rows
      rowArr = .array~new(allColsRefs~items)
      do ref over allColsRefs
         header  = columnsByReference~at(ref)
         width   = header~width
         title   = header~title
         if header~alignment = 'r'
         then rowArr~append(row[title~strip]~right(width))
         else rowArr~append(row[title~strip]~strip~left(width))
      end /* DO */
      out~append(rowArr~makestring('l',col_separator))
   end /* DO */
RETURN out~makestring('l',.endofline)

/* ------------------------------------------------------------------------- */
::method init
expose  rows rowsXML relationshipsTable sheetsTable sharedStrings             -
        continue_after_empty_rows? columnsByTitle columnsByReference
use arg worksheetFile, sheettitle, continue_after_empty_rows? = .false

   sheetsTable        = self~initSheetsTable(worksheetFile)
   RelationshipsTable = self~initRelationshipsTable(worksheetFile)
   sharedStrings      = self~initSharedStrings(worksheetFile)
   columnsByTitle     = .stringTable~new
   columnsByReference = .stringTable~new

   sheetfile = relationshipsTable~at(sheetsTable~at(sheetTitle))
   if sheetFile = .nil
   then RAISE syntax 88.900 Array                                             -
        ('Sheet' SheetTitle 'not found in' WorkSheetFile)

   workSheetXML = extractXMLFromWorkbook(worksheetFile, sheetfile)~content

   if \abbrev(workSheetXML,'<worksheet ')
   then RAISE SYNTAX 40.900 array('tar did not return a sheet - is '          -
                                  '['worksheetFile'] a valid excel worksheet?')

   parse var workSheetXML . '<sheetData>' sheetDataXML '</sheetData>' .
   parse var sheetDataXML . '<row' . '>' headerXML '</row>' rowsXML

   self~initHeaders(headerXML) -- prepare headers
   rows = .nil             -- rows becomes array when processrows method is run

/* ------------------------------------------------------------------------- */
::method initSheetsTable                                             private
use arg worksheetFile

   xml = extractXMLFromWorkBook(WorkSheetFile,'xl/workbook.xml')
   parse value xml~content with . '<sheets>'tableXML'</sheets>' .

   sheetsTable = .stringTable~new

   do while tableXML \= ''
      parse var tableXML .'name="'name'"'.'r:id="'rel'"'."/>" tableXML
      sheetsTable~put(rel,name)
   end /* DO */

RETURN sheetsTable

/* ------------------------------------------------------------------------- */
::method initRelationshipsTable                                      private
use arg worksheetFile

   xml = extractXMLFromWorkBook(WorkSheetFile,'xl/_rels/workbook.xml.rels')
   parse value xml~content                                                    -
         with . '<Relationships'.'>'tableXML'</Relationships>' .

   relationshipsTable = .relation~new

   do while tableXML \= ''
      parse var tableXML .'<' . 'Id="'id'"' . 'Target="'file'"'.'/>' tableXML
      relationshipsTable~put('xl/'||file,id)
   end /* DO */

RETURN relationshipsTable

/* ------------------------------------------------------------------------- */
::method initSharedStrings
expose sharedStrings
use arg worksheetFile, nilsAsBlank? = .true

   xml = extractXMLFromWorkBook(WorkSheetFile,'xl/sharedStrings.xml')
   parse value xml~content                                          -
         with . '<sst'.'uniqueCount="'count'"'.'>'StringlistXML'</sst>'

   if \count~datatype('w') then RETURN .array~new  -- None exist
   sharedStrings = .array~new(count)

   do while stringlistXML \= ''
      parse var stringlistXML .'<si>'txt'</si>' stringlistXML
      if txt = '<t/>'
      then sharedstrings~append(nilsAsBlank?~?('',.nil))
      else do
         parse var txt .'<t'attributes'>'string'</t>'
         string = string~changeStr(.endofline,' ')
         if attributes~caselesspos('xml:space="preserve"') = 0
         then string = string~strip
         sharedStrings~append(XML_Unescape(string))
      end /* DO */
   end /* DO */

RETURN sharedStrings

/* ------------------------------------------------------------------------- */
::method initHeaders
expose sharedStrings columnsByTitle columnsByReference
use arg headsXML


   headIterator = .xmlTableIterator~new(headsXML)
   do while headIterator~more?                    -- for each cell in row
      parse value headIterator~next('c') with . '<v>'title'</v>' .
      parse value headIterator~attributes                               -
            with .'r="'cellRef'"'. 0 . 't="'cellType'"' .

      if cellType == 's' then title = sharedStrings[title+1]   -- 0 indexed
      reference = self~cellRef2colRef(cellRef)                 -- ie: A1 => A
      if headIterator~isNull? then title = 'column_'||reference
      if title = ''           then title = 'column_'||reference
      title  = title~changeStr('0a'x,' ')~space

      column = .xlSheetParser_Column~new(reference, title)
      columnsByTitle~put(    column, title    )
      columnsByReference~put(column, reference)
   end /* DO */

RETURN 0

/* ------------------------------------------------------------------------- */
::method processRows
/* processRows is separated from init to allow filters to be added           */
expose rowsXML rows columnsByTitle sharedStrings columnsByReference

   rows = .array~new

   rowIterator = .xmlTableIterator~new(rowsXML~copy)
   do while rowIterator~more?                         -- for each row in sheet
      rowXML = rowIterator~next('row')                -- next <row>

      if rowIterator~isNull? then ITERATE             -- null (empty) row  --^|

      row = .directory~new
      cellIterator = .xmlTableIterator~new(rowXML)
      do while cellIterator~more?                    -- for each cell in row
         parse value cellIterator~next('c') with . '<v>'value'</v>' .
         parse value cellIterator~attributes                                  -
               with .'r="'cellRef'"'. 0 . 't="'cellType'"' .

         select
            when cellIterator~isNull? then value = ''  -- null cell
            when celltype = ''     then nop         -- value is number
                                     -- value is 0 index -> to stringtable
            when celltype = 's'    then value = sharedStrings[value+1]
                                                       -- inline string
            when celltype = 'inlineStr' then value = XML_UnEscape(value)
                                                       -- Boolean
            when celltype = 'b'    then value = value~?('true','false')
                                                       -- days since 1900
            when celltype = 'd'    then value = .datetime                     -
                                            ~fromstandarddate('19000101')     -
                                            ~addDays(value)~isoDate~left(19)
            when celltype = 'n'    then nop            -- value is number
            otherwise                      -- e=Error, str=Formula string
                RAISE Syntax 23.900 array ('Unhandled cell type ('cellType')' -
                                           ' in cell' cellRef)
         end /* select */

         col     = self~cellRef2colRef(cellRef)   -- get the col letter
         column  = columnsByReference~at(col)     -- fetch header object

         do formatter over column~formatter       -- apply format(s) if any
            if hasMethod(formatter,'format')
            then value = formatter~format(value)
         end /* DO */

         title = column~title(value) -- swap value,txt so maintain length
         if \value~datatype('n') then column~alignment = 'l'

         row~put(value,title)          -- pop it in row indexed by title

      end /* DO */

   -- put null string in any null or omitted columns
      do head over self~columnsByTitle~allIndexes~difference(row~allIndexes)
         row~put('',head)
      end /* DO */

      rows~append(row)
   end /* DO */

RETURN 0

/* ------------------------------------------------------------------------- */
::method addFormat
/* addFormat allows for values to be formatted during parsing                */
/* a formatter can be any class that implements a method called 'format'     */
/* that accepts a single string argument and returns the formatted form of   */
/* that argument.                                                            */
expose columnsByTitle
use arg title, formatters
   -- allow for many formats on one column
   if \formatters~isA(.array) then formatters = .array~of(formatters)

   do formatter over formatters
      if \hasMethod(formatter,'format') | formatter~isA(.string)
      then RAISE Syntax 88.900 array -
            ('Formatter must present format method, found' formatter)
   end /* DO */

   column = columnsByTitle~at(Title)
   if column~isNil
   then do
      msg = 'formatter(s) could not be added to' title '- column not found!'
      if .bsf.dialog~dialogBox(msg,,                        -
                               "Error adding Format",,,     -
                               .list~of("Ignore", "Abort"), -
                               "Ignore"                     )
      then RAISE syntax 88.900 array (msg)
      else RETURN                                                          -->|
   end

   -- add the format
   do formatter over formatters
      column~formatter~append(formatter)
   end /* DO */

/* ------------------------------------------------------------------------- */
::method cellRef2colRef                                              Private
/* Return the alphabetic part of an excel cell reference ie: A1 => A         */
use arg cell
RETURN cell~translate('','0123456789')~strip

/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::class xlSheetParser_Column                                        Private
/* ========================================================================= */
::Attribute alignment set
expose alignment alignment_is_locked?
use arg align, lock? = .true
    select
       when alignment~left(1)~lower = 'l', alignment_is_locked? = .false
          then alignment = 'l'
       when alignment~left(1)~lower = 'r', alignment_is_locked? = .false
          then alignment = 'r'
       otherwise nop
    end /* select */
    if lock? = .true then alignment_is_locked? = .true

::Attribute alignment get
expose alignment
RETURN alignment
::Attribute alignment_is_locked?
::Attribute formatter
::Attribute reference
::Attribute title get
/*    whilst fetching header text we maintain the column width and alignment */
expose title width alignment alignment_is_locked?
   if arg(1,'e')
   then do
      width = max(width,length(arg(1)))
      if alignment_is_locked? = .false, arg(1)~datatype('n') = .false
      then alignment = 'l'
      ret = title
   end /* DO */
   else if alignment = 'l'   -- if no arg passed return title aligned in width
        then ret = title~left(width)
        else ret = title~right(width)

RETURN ret


::Attribute width
/* ------------------------------------------------------------------------- */
::method init
/* ------------------------------------------------------------------------- */
 expose reference  title width alignment alignment_is_locked? formatter
use arg reference, title

   width = title~length
   alignment = 'r'                   -- any non-numeric value will flip this
   alignment_is_locked? = .false     -- will lock if set explicitly
   formatter = .array~new

/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::routine extractXMLfromWorkbook                                      public
use arg worksheetname, target

   parse source os .
   if os~abbrev('Windows')
   then cmd = 'tar -x -O -f"'||worksheetname||'" "'||target||'"'
   else cmd = 'unzip -p "'worksheetname'"' '"'target'"'

-- address default system with output to array (contents)
   dataArray = .array~new
   address system cmd  with output using (dataArray)

-- sharedstrings need not exist.  RC=1 ok on linux,mac but  not on Windows
   if RC > (1 - os~abbrev('Windows')), target~caselesspos('sharedstrings')=0
   then RAISE syntax 48.900 array ('WLBCDonaImport: Could not extract' target -
                                   'from' worksheetname'. Return Code =' RC)

RETURN .xmlContent~new(dataArray) -- splits data into header and lines strings

/* ========================================================================= */
   -------------------------------------------------------------------------
    -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::Routine XML_UnEscape                                               private
/* ------------------------------------------------------------------------- */
/* translate XML predefined entities                                         */
use arg xml
RETURN xml~changestr("&apos;","'")~changeStr("&amp;",'&')                     -
          ~changeStr("&lt;",'<')~changeStr("&gt;",'>')                        -
          ~changeStr("&quot;",'"')
/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::class xmlContent
/* ========================================================================= */
::attribute header
::attribute content
/* ------------------------------------------------------------------------- */
::method init
/* ------------------------------------------------------------------------- */
expose  header content
use arg dataArray

header  = dataArray[1]
content = dataArray~section(2)~makestring('l',.endofline)

/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::routine hasMethod
/* as formatter may be a BSF proxy - enhance object class hasMethod method   */
use arg obj, method

   if obj~isA(.bsf)
   then do
      clz        = obj~getClass
      clzMethods = clz~getMethods
      do clzMethod over clzMethods
         if method~caselessEquals(clzMethod~getName)
         then RETURN .true                                                 -->|
      end /* DO */
      RETURN         .false                                                -->|
   end /* DO */
   else RETURN       obj~hasMethod(method)                                 -->|

/* ========================================================================= */
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
/* ========================================================================= */
::class xmlTableIterator                                              public
/* ========================================================================= */
::Attribute attributes
::Attribute value
::Attribute isNull?
::Attribute more? GET
expose xml
RETURN (xml \= '')

/* ------------------------------------------------------------------------- */
::method init
/* ------------------------------------------------------------------------- */
expose xml
use arg xml

/* ------------------------------------------------------------------------- */
::method next
/* ------------------------------------------------------------------------- */
expose attributes value xml isnull?
use arg tag

    isNull? = .false
    parse var xml '<'(tag) attributes '>' xml
    if attributes~right(1) = '/'
    then do
       isNull? = .true
       value = ''
       RETURN value
    end /* DO */

    endTag = '</'||tag||'>'
    parse var xml value (endtag) xml

RETURN value

