[Sintaxis] Uso de XML como fichero de configuración

[Kuk]

Otro bonito ejemplo de Eslopes:

XML files are widely used by Java / .Net applications. OO Cobol too. The following class provides a method called GetKey to retrieve key values in an XML file. The default XML file name is app.config, but you can override this by defining an environment variable XML_CONFIGFILE.

 CLASS-ID. XmlConfiguration as "CoolThings.Commons.XmlConfiguration".
     
     environment division.
         configuration section.
             repository.
                 class  SystemException               as "System.Exception"
                 class  SystemString                  as "System.String"
                 class  SystemXmlDocument             as "System.Xml.XmlDocument"
                 class  SystemXmlNode                 as "System.Xml.XmlNode"
                  class  SystemIOFileNotFoundException as "System.IO.FileNotFoundException"
                  class  SystemNullReferenceException  as "System.NullReferenceException"
                  class  SystemEnvironment             as "System.Environment"
                  class  SystemInt32                   as "System.Int32"
                  
                  *> object properties
                  property  InnerText                 as "InnerText"
                  property  StringValue               as "StringValue"
                  property  StringEmpty               as "Empty".
          
      static.
          data division.
             working-storage section.
             01 instance    usage object reference XmlConfiguration      is private.
          
          procedure division.
              method-id. GetInstance AS "GetInstance".
                  data division.
                      linkage section.
                      01 localSingleton usage object reference XmlConfiguration.
                      
                  procedure division returning localSingleton.
                      if (instance equal null) then
                            invoke XmlConfiguration "NEW" returning localSingleton
                            set    instance  to localSingleton
                      else
                            set    localSingleton    to instance
                      end-if
                      
              end method GetInstance.
      end static.
      
      *> Instance's data and methods       
      object.
          environment division.
              data division.
                  working-storage section.
                  
                  01 xmlDocument usage object reference SystemXmlDocument is private.
                  01 xmlNode     usage object reference SystemXmlNode     is private.
                  01 envName     usage object reference SystemString      is private.
                  01 emptyString usage object reference SystemString      is private.
                  
                  01 nullReferenceException usage object reference SystemNullReferenceException.
                  01 sysException           usage object reference SystemException.
                  01 fileNotFoundException  usage object reference SystemIOFileNotFoundException.
          
          procedure division.
            
              method-id. NEW is private.
                  data division.
                      working-storage section.
                          01 environmentVariable      usage object reference SystemEnvironment.
                  procedure division.
                      *> Retrieve file name from environment variable "XML_CONFIGFILE"
                      *> If XML_CONFIGFILE is not set then the default would be "application.config"
                      
                      invoke SystemEnvironment "GetEnvironmentVariable" using "XML_CONFIGFILE" returning envName
                      
                      if  (SystemString::"Equals"(NULL, envName)= b"1") then
                          set  envName           to  "app.config"    
                      end-if
                      
                      *> Load the xml document
                      invoke SystemXmlDocument "NEW" returning xmlDocument
                      try
                           invoke xmlDocument "Load" using envName
                      
                      catch fileNotFoundException
                           display "File not found" *> TODO: to replace with a logger
                          
                      end-try.
                          
              end method NEW.
              
              method-id. GetKey as "GetKey".
                  data division.
                      working-storage section.
                      linkage section.
                          01 aKey     usage object reference SystemString.
                          01 keyValue usage object reference SystemString.
                          
                  procedure division using aKey returning keyValue.
                      
                      try
                          invoke self "ValidateKey" using aKey
                          
                          set  aKey      to  SystemString::"Concat"(n"/", aKey)
                          
                          invoke xmlDocument "SelectSingleNode" using aKey returning xmlNode
                           
                           set  keyValue        to InnerText OF xmlNode
                           
                       catch SysException
                           set  keyValue        to  SystemString::"Concat"(n"@@Invalid key:", aKey)
                           
                       end-try
                   
               end method GetKey.
               
               method-id. ValidateKey as "ValidateKey" is private.
                   data division.
                       working-storage section.
                           01 valueZeros     USAGE BINARY-LONG SIGNED value zeros.
                           01 valueMinusOne  USAGE BINARY-LONG SIGNED value -1.
                           
                       linkage section.
                           01 aKey     usage object reference SystemString.
                   
                   procedure division using aKey raising SystemException.
                       set valueMinusOne     to  aKey::"IndexOf"("//")
                       set valueZeros        to  aKey::"IndexOf"("/")
                     
                       if valueMinusOne not = -1  or valueZeros not equal zeros then
                          invoke SystemException "NEW" returning sysException
                          exit method raising SysException
                       end-if
               end method ValidateKey.
               
       end object.        
   END CLASS XmlConfiguration.

The XML file must be a valid XML file, for example:

<?xml version="1.0" encoding="utf-8" ?>
<configuration>
  <checkout>
    <currentSupplier>/configuration/checkout/suppliers/fujitsu</currentSupplier>
    <suppliers>
      <fujitsu>
        <currentSet>/configuration/checkout/suppliers/fujitsu/sets/TeamPos500</currentSet>
        <sets>
          <TeamPos500>
             <cashDrawer>TeamPos1054258002</cashDrawer>
             <receiptPrinter>TeamPoSFD21</receiptPrinter>
           </TeamPos500>
           <TeamPos1000>
             <cashDrawer>TeamPos10PB60014</cashDrawer>
             <receiptPrinter>TeamPoSFD22</receiptPrinter>
           </TeamPos1000>
         </sets>
      </fujitsu>
      <hp>
         <currentSet>/configuration/checkout/suppliers/hp/sets/HPPOS4SmallBusiness</currentSet>
         <sets>
           <HPPOS4SmallBusiness>
             <cashDrawer>HPFK182AT</cashDrawer>
             <receiptPrinter>HPFK224AT</receiptPrinter>
           </HPPOS4SmallBusiness>
         </sets>
      </hp>
    </suppliers>
  </checkout>
  <db>
     <connection>
       <oracle>
         <DataSource>Data Source=TORCL</DataSource>
         <UserId>admin</UserId>
         <Password>myPassword</Password>
       </oracle>
     </connection>
   </db>
 </configuration>

 CLASS-ID. Utils as "AFP.Utils".
     environment division.
         configuration section.
             repository.
                 class     ClassXmlConfiguration          as "CoolThings.Commons.XmlConfiguration"
                 class     SystemString                   as "System.String"
                 class     CollectionHashTable            as "System.Collections.Hashtable".
     
     static.
          data division.
              working-storage section.
                  01 xmlConfig           usage object reference ClassXmlConfiguration.
                  01 driverName          usage object reference SystemString.
                  01 keyValue            pic n(200).
          procedure division.
              method-id. GetCheckoutDrivers as "GetCheckoutDrivers" is public.
                  data division.
                      linkage section.
                      01 hashTable       usage object reference CollectionHashTable.
                      
                  procedure division returning hashTable.
                      invoke ClassXmlConfiguration "GetInstance" returning xmlConfig
                      
                      invoke CollectionHashTable "NEW" returning hashTable
                      
                      set    keyValue    to  xmlConfig::"GetKey"(n"/configuration/checkout/currentSupplier")
                      set    keyValue    to  SystemString::"Concat"(keyValue, n"/currentSet")
                      set    keyValue    to  xmlConfig::"GetKey"(keyValue)
                      set    driverName  to  SystemString::"Concat"(keyValue, n"/cashDrawer")
                      set    driverName  to  xmlConfig::"GetKey"(driverName)
                      
                      invoke hashTable "Add" using "CashDrawer", driverName
                      set    driverName  to  SystemString::"Concat"(keyValue, n"/receiptPrinter")
                      set    driverName  to  xmlConfig::"GetKey"(driverName)
                      
                      invoke hashTable "Add" using "ReceiptPrinter", driverName.
                      
              end method GetCheckoutDrivers.
      end static.
  END CLASS Utils.