package provide Tcl2ExXML 2.0 namespace eval Tcl2ExXML:: { ################################################## ## ♦ DESCRIPTION: CREATE NAMESPACE VARIABLES ## • VARIABLE: WBCounter - COUNT OF ACTIVE WORKBOOKS ## • ARRAY/VARIABLE: WorkBooksArray :KEY = (WB ) :VALUE = WORKBOOK NAME ## • ARRAY/VARIABLE: RowCounter :KEY = (WB.WS ) :VALUE = COUNT OF ACTIVE ROWS ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: ColCounter :KEY = (WB.WS ) :VALUE = COUNT OF ACTIVE COLUMN ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: StylesCounter :KEY = (WB.WS ) :VALUE = COUNT OF STYLES ON GIVEN WORKBOOK ## • ARRAY/VARIABLE: StylesArray :KEY = (WB.S. ) :VALUE = ## • ARRAY/VARIABLE: ColStyle :KEY = (WB.WS.CIXD._n ) :VALUE = STYLES FOR GIVEN COLUMN ON GIVEN WORKSHEET ## • ARRAY/VARIABLE: RowStyle :KEY = (WB.WS.RIDX ) :VALUE = STYLES FOR GIVEN ROW ON GIVEN WORKSHEET ## • ARRAY/VARIABLE: WorkSheets :KEY = (WB.WS ) :VALUE = COUNT OF ACTIVE WORKSHEETS PER WORKBOOK ## • ARRAY/VARIABLE: WorkSheetsArray :KEY = (WB.WS ) :VALUE = WORKSHEET NAME ## • VARIABLE: ColumnDefault - DEFAULT MAPPING OF COLUMN COUNT (A 1, B 2, C 3,.....) ## • LIST: ColumnIndex - COLUMN INDEX MAPPING (A 1, B 2, C 3,.....) ## • ARRAY/VARIABLE: Data :KEY = (WB.WSRNCN ) :VALUE = CELL DATA. ################################################## variable WBCounter variable WorkBooksArray variable RowCounter variable ColCounter variable StylesCounter variable ColStyle variable RowStyle variable WorkSheets variable WorkSheetsArray variable StylesArray variable ColumnDefault 500 variable ColumnIndex variable Data } ## <== END OF namespace eval ################################################## ## ♦ DESCRIPTION: CREATE A COLUMN MAPPING INDEX ## ◘ RETURN: LIST, INDEX FOR COLUMN NAMES TO CORRESPONDING LETTER ################################################## proc Tcl2ExXML::_CreateColIdx {{ColIxdWdth 500}} { variable ColumnIndex; set alphabetList [list A B C D E F G H I J K L M N O P Q R S T U V W X Y Z]; set ColIxdWdth 500; set idxCounter 1; set CLI0 -1; set LetterIdxInt 0; set LetterIdxStng {[lindex $alphabetList $CLI0]${letter}} set IncrementCmd "incr CLI0;" for {set i 1} {$i < [expr {[expr {$ColIxdWdth/26}]+2}]} {incr i} { if {![expr {$idxCounter%703}]} { incr LetterIdxInt; set LetterIdxStng "\[lindex \$alphabetList \$CLI0\]\[lindex \$alphabetList \$CLI$LetterIdxInt\]\${letter}" set CLI0 0; set CLI$LetterIdxInt 0; set IncrementCmd "incr CLI$LetterIdxInt;" } foreach letter $alphabetList { lappend ColumnIndex [list [subst ${LetterIdxStng}] $idxCounter] incr idxCounter; if {$ColIxdWdth < $idxCounter} { return; } } eval $IncrementCmd; } unset -nocomplain -- alphabetList idxCounter CLI0 LetterIdxInt IncrementCmd } ## <== END OF Tcl2ExXML::_CreateColIdx ################################################## ## ♦ DESCRIPTION: CREATE A NEW WORKBOOK; ## • INPUT: WORKBOOK NAME; ## ◘ RETURN: POINTER TO THE WOORKBOOK WB; ################################################## proc Tcl2ExXML::CreateWorkbook {WBName} { incr Tcl2ExXML::WBCounter set workbookId WB$Tcl2ExXML::WBCounter set Tcl2ExXML::WorkBooksArray($workbookId) $WBName return $workbookId } ## <== END OF Tcl2ExXML::CreateWorkbook ################################################## ## ♦ DESCRIPTION: DELETE A WORKBOOK; ## • INPUT: WORKBOOK ID TO DELETE; ## ◘ RETURN: 0 ON SUCCESS 1 ON ERROR; ################################################## proc Tcl2ExXML::DeleteWorkbook {workbookId} { variable WorkBooksArray variable WBCounter variable WorkSheets variable WorkSheetsArray variable RowCounter variable ColCounter variable StylesCounter variable StylesArray variable ColStyle variable RowStyle variable Data if {[array exists WorkBooksArray($workbookId)]} { incr WBCounter -1 array unset WorkBooksArray ${workbookId}* array unset WorkSheetsArray ${workbookId}* array unset WorkSheets ${workbookId}* array unset RowCounter ${workbookId}* array unset ColCounter ${workbookId}* array unset StylesCounter ${workbookId}* array unset StylesArray ${workbookId}* array unset ColStyle ${workbookId}* array unset RowStyle ${workbookId}* array unset Data ${workbookId}* return 0 } else { return 1 } } ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY WORKBOOK EXIST; ## • PARAMETERS: WORKBOOK ID; ## ◘ RETURN: ERROR IF WORKBOOK DOES NOT EXIST; NULL OTHERWISE; ################################################## proc Tcl2ExXML::_WorkBookExist {workbookId} { variable WorkBooksArray return [info exists WorkBooksArray($workbookId)]; } ## <== END OF Tcl2ExXML::_WorkBookExist ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY WORKSHEET EXIST; ## • INPUT: WORKBOOK ID; ## ◘ RETURN: BOOL ################################################## proc Tcl2ExXML::_WorkSheetExist {workSheet} { variable WorkSheetsArray return [info exists WorkSheetsArray($workSheet)]; } ## <== END OF Tcl2ExXML::_WorkSheetExist ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO VERIFY STYLE EXIST; ## • INPUT: WORKBOOK ID; ## ◘ RETURN: BOOL ################################################## proc Tcl2ExXML::_StyleExist {styleName} { variable StylesCounter lassign [split $styleName .] WorkSheet Style if {[info exist StylesCounter($WorkSheet)]} { set StyleInt [string map -nocase {s ""} $Style] if {[string is integer -strict $StyleInt]} { if {$StyleInt <= $StylesCounter($WorkSheet)} { return 1; } else { error "The provided style does not exist: $StyleInt" } } else { error "Invalid style provided while validating if style exist: Value $styleName" } } else { error "No styles found in Worksheet: $WorkSheet" } } ## <== END OF Tcl2ExXML::_StyleExist ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: INTERNAL PROCEDURE TO OBTAIN THE COLUMN NUMBER GIVEN A LETTER SEQ ## • INPUT: COLUMN LETTER SEQUENCE ## ◘ RETURN: INT, ABORTS ON ERROR. ################################################## proc Tcl2ExXML::_ColIdx {ColLetSeq} { variable ColumnIndex; set idx [lsearch -nocase -index 0 $Tcl2ExXML::ColumnIndex $ColLetSeq]; if {$idx == -1} { error "Letter Sequence $ColLetSeq is not defined. Expand the Sequencing with command Tcl2ExXML::CreateColIdx " } return [lindex $ColumnIndex $idx 1] } ## <== END OF Tcl2ExXML::_ColIdx ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE A WORKSHEET FOR A WOOKBOOK, WORKBOOK MUST EXIST, ABORT ON ERROR; ## • INPUT: WORKBOOKID, NAME OF WORKSEET; ## ◘ RETURN: WORKSHEET ID, ABORT ON ERROR; ################################################## proc Tcl2ExXML::CreateWorkSheet {workbookId WSName} { variable WorkSheets variable WorkSheetsArray variable RowCounter variable ColCounter #VERIFY THAT WE HAVE A VALID WORKBOOK if {![_WorkBookExist $workbookId]} { error "WorkBook $workbookId does not exist. Workbook must be valid."; } #INCREMENT THE COUNT IF WORKSHEETS EXIST IN THE WORKBOOK; if {![info exists WorkSheets($workbookId)]} { #IF THIS IS THE FIRST WS FOR THE WB INITIALIZE THE ELEMENT; set WorkSheets($workbookId) 1 } else { #NOW THAT WE KNOW THE WORKBOOK IS VALID, LET'S VERIFY THAT THE WORKBOOK NAME DOES NOT ALEADY EXIST- #GET THE KEYS FOR THE WORKSHEET ARRAY; #WORKSHEET NAME CAN NOT BE LONGER THAN 31 CHARS if {[string length $WSName] >= 32} { set WSName [string range 0 28]... puts stderr "WorkSheet Name Length greater than 31 characters.\nWorkseet Name truncated to: $WSName" } foreach {Key Name} [array get WorkSheetsArray ${workbookId}*] { if {$Name == $WSName} { error "Workbook $workbookId already contans a WorkSheet with the name of $WSName." } } incr WorkSheets($workbookId) } set WSID ${workbookId}.WS$Tcl2ExXML::WorkSheets($workbookId) set WorkSheetsArray($WSID) $WSName set RowCounter($WSID) 0 set ColCounter($WSID) 0 return $WSID } ## <== END OF Tcl2ExXML::CreateWorkSheet ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE A STYLE FOR A WORKBOOK, WORKBOOK MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKBOOKID, STYLE OPTIONS ; ## ◘ RETURN: WORKSHEET ID, ABORT ON ERROR; ################################################## proc Tcl2ExXML::CreateStyle {workbook args} { variable StylesArray variable StylesCounter #VERIFY THAT THE WORKBOOK EXIST; if {[Tcl2ExXML::_WorkBookExist $workbook]} { #VERIFY THAT WE HAVE AT LEAST ONE NAMED PAIR OF VALUES TO SET; if {[llength $args] < 2} { error "Minimum of one style option is required." } #VERIFY IF ANY STYLES EXIST; INCR IF DOES, CREATE IF NOT; if {[info exists Tcl2ExXML::StylesCounter($workbook)]} { incr StylesCounter($workbook) } else { set StylesCounter($workbook) 2 } set styleName ${workbook}.S$Tcl2ExXML::StylesCounter($workbook) foreach {name value} $args { #VERIFY THAT WE HAVE BEEN GIVEN PROPER SWITCHES; if {[lsearch -nocase "-algnmt -rotate -vertxt -wrap -mergh -mergv -font -border -interior -datafmt" $name] == -1} { error "Style option $name option is not supported" } switch -nocase -- $name { -algnmt { foreach {algnmtOpt algnmtvalue} $value { #VERIFY THE PROPER CHILD VALUES WERE INCLUDED. if {[lsearch "-v -h" $algnmtOpt] == -1} { error "Style option $algnmtOpt is not supported for object class '-algnmt'" } #VALIDATE THAT WE HAVE BEEN GIVEN PROPER VALUES ONCE AGAIN, IF WE HAVE CREATE THE ITEM IN THE DATA ARRAY; switch $algnmtOpt { -v { if {[lsearch -nocase "automatic top center bottom" $algnmtvalue] == -1} { error "Invlaid option provided for object class '-algnmt' inherited class '-v'. Value: $algnmtvalue\n Should be one of: 'Top, Center, Bottom'" } set StylesArray(${styleName}.${name}.${algnmtOpt}) [string tolower $algnmtvalue]; } -h { if {[lsearch -nocase "automatic left center right" $algnmtvalue] == -1} { error "Invlaid option provided for object class '-algnmt' inherited class '-h'. Value: $algnmtvalue\n Should be one of: 'Right, Center, Left'" } set StylesArray(${styleName}.${name}.${algnmtOpt}) [string tolower $algnmtvalue]; } } } } -rotate { #VERT TEXT AND ROTATE ARE MUTUALLY EXCLUSIVE, CHECK THAT THE OTHER DOES NOT EXIST; if {[info exist StylesArray(${styleName}.-vertxt)]} { error "\"Vertical Text\" and \"Rotate Text\" are mutually exclusive and can not be used at the same time."; } #TEST IF THE VALUE GIVEN IS A PROPER INTAGER; set testInt $value if {[catch {incr testInt} err]} { error "Invalid option for object class '-rotate': $err" } #NOW WE NEED TO VALIDATE THAT THE VALUE IS BETWEEN -90 AND 90 if {$value < -90 || $value > 90} { error "Invalid integer provided for class '-rotate'. Value MUST be between -90 and 90." } set StylesArray(${styleName}.${name}) $value } -vertxt { #VERT TEXT AND ROTATE ARE MUTUALLY EXCLUSIVE, CHECK THAT THE OTHER DOES NOT EXIST; if {[info exist StylesArray(${styleName}.-rotate)]} { error "\"Vertical Text\" and \"Rotate Text\" are mutually exclusive and can not be used at the same time."; } #VERIFY THAT WE HAVE BEEN GIVEN A BOOL VALUE; if {[string is boolean -strict $value] == 0} { error "Expected boolean value for object class '-vertxt'. Got $value instead." } if {[string tolower $value] in {1 true yes on}} { set StylesArray(${styleName}.${name}) 1 } else { set StylesArray(${styleName}.${name}) 0 } } -wrap { #VERIFY THAT WE HAVE BEEN GIVEN A BOOL VALUE; if {[string is boolean -strict $value] == 0} { error "Expected boolean value for object class '-wrap'. Got $value instead." } if {[string tolower $value] in {1 true yes on}} { set StylesArray(${styleName}.${name}) 1 } else { set StylesArray(${styleName}.${name}) 0 } } -mergh { #MERGE CELLS TO THE RIGHT - #TEST IF THE VALUE GIVEN IS A PROPER INTAGER; set testInt $value if {[catch {incr testInt} err]} { error "Invalid option for object class '-mergh': $err" } set StylesArray(${styleName}.${name}) $value } -mergv { #MERGE CELLS DOWN FROM CURRENT - #TEST IF THE VALUE GIVEN IS A PROPER INTAGER; set testInt $value if {[catch {incr testInt} err]} { error "Invalid option for object class '-mergv': $err" } set StylesArray(${styleName}.${name}) $value } -font { foreach {fontOpt fontValue} $value { #VERIFY THEH PROPER CHILD VALUES WERE INCLUDED. if {[lsearch {-nm -ff -sz -fc -b -i -u} $fontOpt] == -1 } { error "Style option '$fontOpt' is not supported for object class '-font'" } switch $fontOpt { -nm { #TODO: FIND A WAY TO VALIDATE PROPER FONT NAMES set StylesArray(${styleName}.${name}.${fontOpt}) [string tolower $fontValue]; } -ff { #TODO: FIND A WAY TO VALIDATE THE FAMILY ASSOCIATED TO THE FONT. set StylesArray(${styleName}.${name}.${fontOpt}) [string tolower $fontValue]; } -sz { set testInt $fontValue if {[catch {incr testInt} err]} { error "Invalid option for object class '-font' inherited class '-sz': $err" } set StylesArray(${styleName}.${name}.${fontOpt}) $fontValue } -fc { if {[string is xdigit -strict [string map {"#" ""} $fontValue]] == 0} { error "Expected hexadecimal value for object class '-font' inherited class '-fc'. Got $fontValue instead." } set StylesArray(${styleName}.${name}.${fontOpt}) $fontValue } -b { if {[string is boolean -strict $fontValue] == 0} { error "Expected boolean value for object class '-font' inherited class '-b'. Got $fontValue instead." } if {[lsearch -nocase "0 false no off" $fontValue] == 0} { set StylesArray(${styleName}.${name}.$fontOpt) 0 } else { set StylesArray(${styleName}.${name}.${fontOpt}) 1 } } -u { if {[string is boolean -strict $fontValue] == 0} { error "Expected boolean value for object class '-font' inherited class '-u'. Got $fontValue instead." } if {[lsearch -nocase "0 false no off" $fontValue] == -1} { set StylesArray(${styleName}.${name}.${fontOpt}) 0 } else { set StylesArray(${styleName}.${name}.$fontOpt) 1 } } -i { if {[string is boolean -strict $fontValue] == 0} { error "Expected boolean value for object class '-font' inherited class '-i'. Got $fontValue instead." } if {[lsearch -nocase "0 false no off" $fontValue] == -1} { set StylesArray(${styleName}.${name}.${fontOpt}) 0 } else { set StylesArray(${styleName}.${name}.${fontOpt}) 1 } } } } } -border { set ParamFound 0; for {set count 0} {$count <[llength $value]} {incr count;} { set opt [lindex $value $count]; if {[regexp {^-[A-Za-z]{1,2}} $opt]} { if {$opt == "-bp"} { set BdrPos [lindex $value [expr {$count+1}]]; set BdrSid [llength $BdrPos]; #VERIFY IF WE WERE GIVEN A LIST, IF WE HAVE VALIDATE EACH OF THE ITEMS; if {$BdrSid > 1} { if {$BdrSid > 4} { error "'$BdrPos' count exceeds the maxumum sides." } #VERIFY THAT WE HAVE BEEN GIVEN THE PROPER VALUES. foreach side $BdrPos { if {[lsearch -nocase "right left top bottom" $side] == -1} { error "Invalid value provided for object class '-border' subclass '-bp'. Got $side instead." } } } else { if {[lsearch -nocase "right left top bottom" $BdrPos] == -1} { error "Invalid value provided for object class '-border' subclass '-bp'. Got $BdrPos instead." } } #CHECK TO SEE IF WE ARE GIVEN ADDITIONAL STYLE PARAMS, IF WE ARE NOT WE WILL USE THE DEFAULT; set adjParam [lindex $value [expr {$count+2}]]; switch $adjParam { -ls { #WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT; set LineStyle [string tolower [lindex $value [expr {$count+3}]]]; if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} { error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle" } set ParamFound 1; } -lw { set LineWeight [lindex $value [expr {$count+3}]]; set IntTest $LineWeight; if {[catch {incr $IntTest} err]} { error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead." } set ParamFound 3; } -lc { set LineColor [lindex $value [expr {$count+3}]]; if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} { error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead." } set ParamFound 6; } } #IF WE FOUND ONE PARAMETER, LET'S SEE IF WE CAN FIND THE OTHER? AGAIN IF WE DON'T FIND IT WE WILL USE A DEFAULT; set nextAdjParam [lindex $value [expr {$count+4}]]; switch $nextAdjParam { -ls { #WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT; set LineStyle [string tolower [lindex $value [expr {$count+5}]]]; if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} { error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle" } set ParamFound [expr {$ParamFound+1}]; } -lw { set LineWeight [lindex $value [expr {$count+5}]]; set IntTest $LineWeight; if {[catch {incr $IntTest} err]} { error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead."; } set ParamFound [expr {$ParamFound+3}]; } -lc { set LineColor [lindex $value [expr {$count+5}]]; if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} { error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead." } set ParamFound [expr {$ParamFound+6}]; } } #IF WE FOUND A SECOND PARAMETER, LET'S SEE IF WE CAN FIND THE OTHER? AGAIN IF WE DON'T FIND IT WE WILL USE A DEFAULT; set nextnextAdjParam [lindex $value [expr {$count+6}]]; switch $nextnextAdjParam { -ls { #WE HAVE FOUND AN ADDITIONAL PARAM, GET IT'S VALUE, VERIFY IT IS CORRECT AND SET THE OBJECT; set LineStyle [string tolower [lindex $value [expr {$count+7}]]]; if {[lsearch "continuous dot dashdot dashdotdot dash double slantdashdot" $LineStyle] == -1} { error "Invalid linetype given for '-border' subcommand '-ls'; Value $LineStyle" } set ParamFound [expr {$ParamFound+1}]; } -lw { set LineWeight [lindex $value [expr {$count+7}]]; set IntTest $LineWeight; if {[catch {incr $IntTest} err]} { error "Expected an integer for object class '-border' inherited class '-wt'. Got $LineWeight instead."; } set ParamFound [expr {$ParamFound+3}]; } -lc { set LineColor [lindex $value [expr {$count+7}]]; if {[string is xdigit -strict [string map {"#" ""} $LineColor]] == 0} { error "Expected hexadecimal value for object class '-border' inherited class '-lc'. Got $LineColor instead." } set ParamFound [expr {$ParamFound+6}]; } } #NOW WE **SHOULD** HAVE ALL OF THE INFORMATION THAT WE NEED TO GENERATE THE OBJECT NOW; for {set t 0} {$t < $BdrSid} {incr t} { switch $ParamFound { 0 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous 1"; } 1 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] 1"; } 3 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous $LineWeight"; } 4 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] [string tolower $LineWeight]"; } 6 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous 1 $LineColor"; } 7 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] 1 $LineColor"; } 9 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "continuous $LineWeight $LineColor"; } 10 { set StylesArray(${styleName}.${name}.[lindex $BdrPos $t]) "[string tolower $LineStyle] $LineWeight $LineColor"; } } } } } } } -interior { foreach {interiorOpt interiorValue} $value { if {[lsearch "-ic -ip -ipc" $interiorOpt] ==-1} { error "Style option $interiorOpt option is not supported for class '-interior'"; } switch $interiorValue { -ic { if {[string is xdigit -strict [string map {"#" ""} $interiorValue]] == 0} { error "Expected hexadecimal value for object class '-interior' inherited class '-ic'. Got $interiorValue instead."; } set StylesArray(${styleName}.${name}.${interiorOpt}) $interiorValue } -ip { if {[lsearch -nocase "thindiagcross thinhorzcross thindiagstripe thinreversediagstripe thinvertstripe thinhorzstripe thickdiagcross diagcross diagstripe reversediagstripe vertstripe horzstripe gray0625 gray125 gray75 gray50 gray25" $interiorValue ==-1]} { error "Invalid interior Pattern given for class '-interior' subclass '-ip'; Value $interiorValue"; } set StylesArray(${styleName}.${name}.${interiorOpt} $interiorValue; } -ipc { set StylesArray(${styleName}.${name}.${interiorOpt}) $interiorValue; } } } } -datafmt { if {[lsearch -nocase "sdate mdate ldate ymd t24 t12 curr nbr pct 0" $value] == -1} { error "Unsuported data format given for -datafmt argument; Value $value"; } switch $value { sdate { set StylesArray(${styleName}.${name}) {m/d/yy;@} } mdate { set StylesArray(${styleName}.${name}) {[ENG][$-409]d\-mmm\-yy;@} } ldate { set StylesArray(${styleName}.${name}) {[ENG][$-409]mmmm\ d\,\ yyyy;@} } ymd { set StylesArray(${styleName}.${name}) {yyyy\-mm\-dd} } t24 { set StylesArray(${styleName}.${name}) {h:mm;@} } t12 { set StylesArray(${styleName}.${name}) {[$-409]h:mm\ AM/PM;@} } curr { set StylesArray(${styleName}.${name}) {"$"#,##0.00} } nbr { set StylesArray(${styleName}.${name}) {Number} } pct { set StylesArray(${styleName}.${name}) {Percent} } str { set StylesArray(${styleName}.${name}) {String} } 0 { set StylesArray(${styleName}.${name}) {0} } } } } } return $styleName } else { error "Workbook: $workbook not valid. Please indicate a valid workbook."; } } ## <== END OF Tcl2ExXML::createStyle ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: CREATE COLUMN ATTABUTES, WORKBOOK MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKSHEETID, STYLE OPTIONS ; ## ◘ RETURN: NULL STRING, ABORT ON ERROR; ################################################## proc Tcl2ExXML::setColumnAttributes {workSheet columnIndex args} { variable ColStyle; #VALIDATE THAT THE WORKBOOK/WORKSHEET EXIST; if {[_WorkSheetExist $workSheet]} { #WORKSHEET IS VALID, LET'S CHECK IF THE COLUMN IS VALID AS WELL - #CHECK IF WE WERE GIVEN A COLUMN NUMBER OR A NAME; if {[regexp {\d{1,3}} $columnIndex]} { set ColIdxNbr $columnIndex; } elseif {[regexp -nocase {[a-z]{1,3}} $columnIndex]} { set ColIdxNbr [_ColIdx $columnIndex]; } else { error "Unable to determine Column index for given value: $columnIndex"; } #VERIFY THAT WE HAVE AT LEAST ONE NAMED PAIR OF VALUES TO SET; if {[llength $args] < 2} { error "Minimum of one column attribute option is required." } foreach {name value} $args { switch -nocase -- $name { -w { #SET COLUMN WIDTH - #VERIFY THAT WE HAVE BEEN GIVEN AN INTEGER; set testInt $value if {[catch {incr testInt} err]} { error "Invalid option for Column Attributes object class '-w': $err"; } set ColStyle(${workSheet}.${ColIdxNbr}.${name}) $value } -afw { #AUTO FIT WIDTH, ONLY BOOL TRUE WILL BE EVALUATED; if {[string is boolean -strict $value] == 0} { error "Expected boolean value for object class '-afw'. Got $value instead." } if {[lsearch -nocase "1 true yes on" $value] != -1} { set ColStyle(${workSheet}.${ColIdxNbr}.${name}) 1 } } -h { #INDICATE IF THE COLUMN SHOULD BE HIDDEN; if {[string is boolean -strict $value] == 0} { error "Expected boolean value for object class '-h'. Got $value instead." } if {[lsearch -nocase "1 true yes on" $value] != -1} { set ColStyle(${workSheet}.${ColIdxNbr}.${name}) 1 } } -s { #VERIFY FIRST THAT THE STYLE ARRAY EXIST FOR THE GIVEN WORKSHEET; if {[_StyleExist $value]} { set ColStyle(${workSheet}.${ColIdxNbr}.${name}) $value } } } } } else { error "Worksheet: $workSheet not valid!"; } }; ## <====END OF Tcl2ExXML::setColumnAttributes ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: ADD ROW TO WORKSHEET, WORKSHEET MUST EXIST, ABORTS OTHERWISE; ## • INPUT: WORKSHEETID - ## • INPUT: ?ROW NUMBER (IF ROWS HAVE BEEN SKIPPED)? - ## • INPUT: LIST OF DATA, EACH LIST ITEM REPRESENTS THE NEXT ADJACENT COLUMN, IF DATA STARTS WITH '-c' - ## FOLLOWING LIST ITEM REPRESENTS THE COLUMN TO START THE DATA TO BE INSERTED INTO VALUE CAN BE AN INT OR COLUMN NAME; ## ◘ RETURN: INT , ABORT ON ERROR; ################################################## proc Tcl2ExXML::addRow {workSheet args} { variable RowCounter variable ColCounter variable ColStyle variable Data #SET INTERNAL VARIABLE; set CN 1; #ENSURE THAT THE WORKBOOK EXIST, ABORT IF IT DOES NOT; if {[Tcl2ExXML::_WorkSheetExist $workSheet]} { #CHECK IF A ROW HAS BEEN SPECIFIED; if {[lindex $args 0] == "-r"} { #A ROW HAS BEEN SPECIFIED, VALIDATE THAT IT IS A PROPER INTEGER; set RN [lindex $args 1]; set testInt [lindex $args 1]; if {[catch {incr testInt} err]} { error "Invalid Row Number provided: $err"; } #DO SOME CHECKING TO ENSURE NO DATA COLLISIONS OCCUR - #IS THIS ROW GREATER THAN PREVIOUS ROWS? IF IT IS WE CAN SKIP DATA VALIDATIONS; if {$RN < $RowCounter($workSheet)} { #THIS ROW IS NOT A "NEW" ROW, WE NEED TO VALIDATE NO DATA COLLISIONS OCCUR; for {set i 2} {$i < [llength $args]} {incr i} { #IF A PARTICUALR COL IS SPECIFIED; if {[lindex $args $i] == "-c"} { #CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME; if {[regexp {^\d{1,3}} [lindex $args [expr {$i+1}]] CN ]} { #COL GIVEN IN INT FORM; incr i 2; } elseif {[regexp -nocase {^[a-z]{1,3}} [lindex $args [expr {$i+1}]]]} { #COL NAME GIVEN, GET INTIGER VALUE FOR THE COL; set CN [_ColIdx [lindex $args [expr {$i+1}]]] incr i 2; } else { #UNABLE TO DETERMINE COLUMN, THOW AN ERROR; error "Invalid column specified, must be an integer (1-999) or column name."; } } #CHECK IF A STYLE IS SPECIFIED; if {[lindex $args $i] == "-s"} { #VALIDATE THAT THE STYLE EXIST; if {[_StyleExist [lindex $args [expr {$i+1}]]]} { set Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]]; incr i 2; } } #VERIFY THAT DATA DOES NOT ALREADY EXIST FOR THE GIVEN INDEX; if {[info exist Data($workSheet.$RN.$CN)]} { error "Data collision ROW: $RN & COL: $CN]"; } #DATA DOES NOT EXIST, WRITE THE INFORMATION TO THE ARRAY; set Data($workSheet.$RN.$CN) [lindex $args $i]; #CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY; if {$CN > $ColCounter($workSheet)} { #IT DOES, WRITE THE NEW VALUE TO THE ARRAY; set ColCounter($workSheet) $CN } incr CN; } } else { #THIS IS A NEW ROW, WE DO NOT NEED TO VALIDATE set RowCounter($workSheet) $RN; for {set i 0} {$i < [llength $args]} {incr i} { #CHECK IF A PARTICUALR COL IS SPECIFIED; if {[lindex $args $i] == "-c"} { #CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME; if {[regexp {^\d{1,3}} [lindex $args [expr {$i+1}]] CN ]} { #COL GIVEN IN INT FORM; incr i 2; } elseif {[regexp -nocase {^[a-z]{1,3}} [lindex $args [expr {$i+1}]]]} { #COL NAME GIVEN, GET INTIGER VALUE FOR THE COL; set CN [Tcl2ExXML::_ColIdx [lindex $args [expr {$i+1}]]] incr i 2; } else { #UNABLE TO DETERMINE COLUMN, THOW AN ERROR; error ""; } } #CHECK IF A STYLE IS SPECIFIED; if {[lindex $args $i] == "-s"} { #VALIDATE THAT THE STYLE EXIST; if {[_StyleExist [lindex $args [expr {$i+1}]]]} { set Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]]; incr i 2; } } #WRITE THE DATA TO THE ARRAY; set Data($workSheet.$RN.$CN) [lindex $args $i]; #CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY; if {$CN > $ColCounter($workSheet)} { #IT DOES, WRITE THE NEW VALUE; set ColCounter($workSheet) $CN } incr CN; } } } else { #NO ROW SPECIFIED, SET THE VALUE TO THE NEXT ROW IN THE SHEET; incr RowCounter($workSheet); set RN $RowCounter($workSheet); for {set i 0} {$i < [llength $args]} {incr i} { #IF A PARTICUALR COL IS SPECIFIED; if {[lindex $args $i] == "-c"} { #CHECK THAT THE COLUMN IS VALID, MUST BE EITHER AN INTEGER OR COLUMN NAME; if {[regexp {^(\d{1,3})} [lindex $args [expr {$i+1}]]]} { #COL GIVEN IN INT FORM; set CN [lindex $args [expr {$i+1}]]; incr i 2; } elseif {[regexp -nocase {^([a-z]{1,3})} [lindex $args [expr {$i+1}]]]} { #COL NAME GIVEN, GET INTIGER VALUE FOR THE COL; set CN [_ColIdx [lindex $args [expr {$i+1}]]] incr i 2; } else { #UNABLE TO DETERMINE COLUMN, THOW AN ERROR; error "Unable to determine the column provided."; } } #CHECK IF A STYLE IS SPECIFIED; if {[lindex $args $i] == "-s"} { #VALIDATE THAT THE STYLE EXIST; if {[_StyleExist [lindex $args [expr {$i+1}]]]} { set Tcl2ExXML::Data($workSheet.$RN.$CN.-s) [lindex $args [expr {$i+1}]]; incr i 2; } } #WRITE THE DATA TO THE ARRAY; set Data($workSheet.$RN.$CN) [lindex $args $i]; #CHECK IF THIS ROW HAS EXPANDED THE ACTIVE COLUMN BOUNDRY; if {$CN > $ColCounter($workSheet)} { #IT DOES, WRITE THE NEW VALUE; set Tcl2ExXML::ColCounter($workSheet) $CN } incr CN; } } return $RowCounter($workSheet); } else { error "WorkSheet $workSheet does not exist." } } ## <====END OF Tcl2ExXML::addRow ################################################## ## ♦ CREATED: FRIDAY, 04/28/17 11:44 AM; ## ♦ CREATOR: CHAD A KIMMELL; ## ♦ DESCRIPTION: RETURN ALL DATA IN EXCEL XML 2003 WORKBOOK FORMAT ## • INPUT: WORKBOKID ## ◘ RETURN: XML STRING, ABORTS ON ERROR. ################################################## proc Tcl2ExXML::outputXML {workbook} { variable Data variable ColStyle variable ColCounter variable WorkSheets variable ColCounter variable RowCounter variable StylesArray variable StylesCounter variable WorkSheetsArray #GET TCL ENVIRNMENTAL VARIABLES upvar #0 env(USERNAME) User upvar #0 env(USERDOMAIN) Company if {[_WorkBookExist $workbook]} { #START THE XML STRING; set xml "\n" append xml " \n" append xml " \n" append xml " \n" append xml " $User\n" append xml " [clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%S}]\n" append xml " $Company\n" append xml " 15.00\n" append xml " \n" append xml " \n" append xml " \n" append xml " \n" append xml " \n" append xml " 100\n" append xml " 100\n" append xml " 30\n" append xml " 30\n" append xml " 1\n" append xml " False\n" append xml " False\n" append xml " \n" append xml " \n" append xml " \n" #DETERMINE IF THERE ARE ANY STYLES THAT EXSIT FOR THE WORKBOOK; if {[info exists StylesCounter($workbook)]} { #STYLE(S) HAVE BEEN FOUND, NOW WE NEED TO GENERATE THE APPRORIATE XML TAGS; for {set WbSc 2} {$WbSc <= $StylesCounter($workbook)} {incr WbSc} { set WbSn $workbook.S$WbSc set StyleName S$WbSc #CHECK THAT THE STYLES ARRAY EXIST FIRST; if {[array exists StylesArray]} { #BEGIN GENERATING THE DYNAMIC STYLE CONTENT; append xml " \n" } } append xml " \n" #BEGIN TO ADD THE DATA FOR EACH WORKSHEET IN THE WORKBOOK; for {set WS 1} {$WS <= $WorkSheets($workbook)} {incr WS} { append xml " \n"; #SET THE WORKSHEET PARAMETERS; append xml " \n"; #VERIFY IF THERE ARE ANY COLUMN ATTRIBUTES IN THE ARRAY THAT WE NEED TO SET; set ColumnStyleKeys [array names ColStyle ${workbook}.WS${WS}*]; if {[llength $ColumnStyleKeys]} { set ColString "" #COLUMN STYLES EXIST, PROCESS THEM; foreach Key $ColumnStyleKeys { set cidx [lindex [split $Key .] 2]; switch $Key [list \ "${workbook}.WS${WS}.$cidx.-w" { append ColString " ss:Width=\"$ColStyle($Key)\"" } \ "${workbook}.WS${WS}.$cidx.-afw" { append ColString " ss:AutoFitWidth=\"$ColStyle($Key)\""} \ "${workbook}.WS${WS}.$cidx.-h" { append ColString " ss:Hidden=\"$ColStyle($Key)\"" } \ ] } if {$ColString != ""} { append xml " \n" } } set SkippedRowFlag 0; set SkippedColFlag 0; for {set R 1} {$R <= $RowCounter($workbook.WS${WS})} {incr R} { #CHECK IF DATA EXIST IN THIS ROW; set RowCount [array names Data ${workbook}.WS${WS}.$R.*]; if {[llength $RowCount] > 0} { #IF ROWS HAVE BEEN SKIPPED INDICATE THE ROW INDEX; if {$SkippedRowFlag} { append xml " \n" #RESET THE FLAG; set SkippedRowFlag 0; } else { append xml " \n" } #COLUMN LOOP; set DataTypeFlag 0; for {set C 1} {$C <= $ColCounter($workbook.WS${WS})} {incr C} { #CHECK IF DATA EXIST FOR THE ROW & COL IDX; if {[info exist Data(${workbook}.WS${WS}.$R.$C)]} { set DataValue $Data(${workbook}.WS${WS}.$R.$C) #CHECK THAT THERE IS ACTUALLY DATA AND IT IS NOT JUST BLANK, #IF IT IS BLANK (ONLY HAS A SPACE) IT CAN BE SKIPPED; if {[string map {" " ""} $DataValue] eq ""} { set SkippedColFlag 1; continue; } #IF A COLUMN HAS BEEN SKIPPED INDICATE IT ON THE COL INDEX; if {$SkippedColFlag} { append xml " " #DETERMINE THE FORMAT OF THE DATA POSSIBLE VALUES ARE: DateTime Number String switch -regexp -matchvar DataList -- $DataValue { ^(0?[1-9]|[12][0-9]|3[01])[-[:space:]\\/\.](0?[1-9]|1[012])[-[:space:]\\/\.]((?:19|20)?[0-9]{2})$ { #DMY lassign $DataList Full Day Month Year if {[string length $Year] == 2} { if {$Year <= 20} { #ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY; set Year "20$Year" } else { #ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY; set Year "19$Year" } } set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}] append xml "[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]\n" } ^(0?[1-9]|1[012])[-[:space:]\\/\.](0?[1-9]|[12][0-9]|3[01])[-[:space:]\\/\.]((?:19|20)?[0-9]{2})$ { #MDY puts $DataList lassign $DataList Full Month Day Year if {[string length $Year] == 2} { if {$Year <= 20} { #ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY; set Year "20$Year" } else { #ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY; set Year "19$Year" } } set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}] append xml "[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]\n" } ^((?:19|20)[0-9]{2})[-[:space:]\\/\.](0?[1-9]|1[012])[-[:space:]\\/\.](0?[1-9]|[12][0-9]|3[01])$ { #YMD lassign $DataList Full Year Month Day if {[string length $Year] == 2} { if {$Year <= 20} { #ASSUME THAT WE ARE REFERENCING THE 21ST CENTURY; set Year "20$Year" } else { #ASSUME THAT THE USER IS REFERENCING THE 20TH CENTURY; set Year "19$Year" } } set NomalizedDate [clock scan $Month/$Day/$Year -format {%m/%d/%Y}] append xml "[clock format $NomalizedDate -format {%Y-%m-%dT00:00:00.000}]\n" } ^[-]?[0-9]*\.?[0-9]+$ { append xml "$DataValue\n"; } default { append xml "[string map {\" " ' ' < < > > & &} $DataValue]\n"; } } #END THE SWITCH STATEMENT FOR STING TYPE; } else { #NO DATA EXIST IN THIS COLUMN, SKIP IT AND SET FLAG; set SkippedColFlag 1; set PrevNumber $C } } #END COLUMN LOOP; append xml " \n" } else { set SkippedRowFlag 1 } } #END ROW LOOP; append xml "
\n" append xml "
\n" } #END WORKSHEET LOOP; append xml " \n" append xml " \n" append xml "
\n" append xml "