REXX Tips & Tricks, Version 2.80


Inf-HTML [About][Toc][Index] 0.9b (c) 1995 Peter Childs


Maintain Multi-Value EAs in REXX





 
/*                                                                    */
/* sample routine to maintain multi-Value EAs in REXX                 */
/* The Demo program uses the EA ".HISTORY"                            */
/*                                                                    */
/* (see also Extended Attribute Data Types and EAs used by the WPS)   */
/*                                                                    */
  say ""
  say "Sample program to show the use of the routine FileHistory"
  say ""

/* -------------------------- */

                    /* get the name of this file                      */
  parse source . . thisFile

                    /* load the REXXUTIL functions for the demo       */
  call rxFuncAdd "SysLoadFuncs", "REXXUTIL", "SysLoadFuncs"
  call SysLoadFuncs

/* -------------------------- */

  say "Now detecting the history of this file ..."
  call ReadEA1

/* -------------------------- */

  say "Now initializing the history of this file with 1 value ..."

  call FileHistory "ADD", thisFile,,
                   "Jim Bacon    Created    01.01.1995", testStem
  say "  Result of FileHistory is " || result

  call ReadEA

/* -------------------------- */

  say "Now initializing the history of this file with 3 values ..."

  MyStem1.0 = 3
  MyStem1.0.codepage = 0
  Mystem1.1 = "Jon Doe I     Created      20.01.1995"
  MyStem1.2 = "Jon Doe II    Changed      22.01.1995"
  MyStem1.3 = "Jon Doe III   Changed      23.01.1995"

  call FileHistory "SET", thisFile, "MyStem1"
  say "  Result of FileHistory is " || result

  call ReadEA
/* -------------------------- */

  say "Now adding another entry to the history of this file ..."
  call FileHistory "ADD", thisFile, "Jim Bean   Changed   24.01.1995"
  say "  Result of FileHistory is " || result

  call ReadEA

/* -------------------------- */

  say 'Now deleting the history of this file ...'
  call FileHistory 'CLEAR', thisFile
  say '  Result of FileHistory is ' || result

  call ReadEA

/* -------------------------- */

exit

/*                                                                    */
/* demo subroutine to read the EA                                     */
/*                                                                    */
ReadEA:
  say "Now reading the new history of this file ..."

ReadEA1:
  call FileHistory "GET", thisFile, "MyStem"
  say "  Result of FileHistory is " || result

  say "  The history list for this file contains " || ,
      MyStem.0 || " entries."
  say "  The codepage of the history list is " || MyStem.0.CodePage || "."

  do i = 1 to MyStem.0
    say "  History list entry no " || i  || " is  "
    say "     <" || myStem.i || ">"
  end /* do i = 1 to MyStem.0 */

  say "Press O to open the Settings Notebook of this file " || ,
      "or any other key to continue"
  UserInput = translate( SysGetKey( "NOECHO" ) )
  if userInput = "O" then
  do
    call SysOpenObject thisFile, 2 , 1
    say "Close the Settings Notebook and press any key to continue"
    UserInput = translate( SysGetKey( "NOECHO" ) )
  end /* if userInput = "O" then */
RETURN

/* ------------------------------------------------------------------ */
/* function: Get, Set or Clear the .HISTORY EA of a file              */
/*                                                                    */
/* call:     FileHistory GET, filename, NewHistoryStem                */
/*           FileHistory ADD, filename, newHistoryEntry {,newStem}    */
/*           FileHistory SET, filename, CurHistoryStem                */
/*           FileHistory CLEAR, filename                              */
/*                                                                    */
/* where:    GET, ADD, SET, CLEAR                                     */
/*             - action:                                              */
/*                GET - get a list of the current entries             */
/*                ADD - add an entry to the list                      */
/*                SET - replace the EA with a new list                */
/*              CLEAR - clear the whole list                          */
/*           filename                                                 */
/*             - name of the file                                     */
/*           NewHistoryStem                                           */
/*             - stem for the history list entries                    */
/*           newStem                                                  */
/*             - stem for the history list entries                    */
/*           CurHistoryStem                                           */
/*             - stem _with_ the history list entries                 */
/*           newHistoryEntry                                          */
/*             - new entry for the history list                       */
/*               (ASCII string)                                       */
/*                                                                    */
/* returns:  0 - okay                                                 */
/*           1 - file not found                                       */
/*           2 - EA is invalid                                        */
/*           3 - CurHistoryStem.0 is invalid                          */
/*           4 - CurHistoryStem.0.codepage is invalid                 */
/*          -1 - invalid parameter                                    */
/*        else - unexpected error                                     */
/*                                                                    */
/* notes:                                                             */
/*  Do not add the trailing dot to the stem name!                     */
/*  Format of the stems:                                              */
/*    history_stem.0 = number of entries                              */
/*    history_stem.0.codepage = codepage of the EA                    */
/*                              (def.: 0, use default codepage)       */
/*    history_stem.n = entry n                                        */
/*                                                                    */
/*  The format of the .HISTORY EA is:                                 */
/*                                                                    */
/*     EA Type  Code                                                  */
/*              page Count                                            */
/*   +--------------------------------------------------+             */
/*   | EAT_MVMT 0000 0002                               |             */
/*   |          EAT_ASCII 0017  Joe    Created  2/10/88 |             */
/*   |          EAT_ASCII 0017  Harry  Changed  2/11/88 |             */
/*   +--------------------------------------------------+             */
/*              EA Type  length contents (ASCII string)               */
/*                                                                    */
/*  All numeric values are WORDs in INTEL format.                     */
/*                                                                    */
/* (see also Extended Attribute Data Types and EAs used by the WPS)   */
/*                                                                    */
/*  FileHistory uses the prefix 'FH.' for all local variables. The    */
/*  local variables are dropped at the end of the routine!            */
/*                                                                    */
/* (c) 1996 Bernd Schemmer, Germany, EMail: 100104.613@compuserve.com */
/*                                                                    */
FileHistory:

                    /* name of the EA to use                          */
                    /* note: change this variable to use the routine  */
                    /*       for the EAs .COMMENTS or .KEYPHRASES.    */
                    /*       In this case you must also delete the    */
                    /*       Codepage related code in this routine.   */
  FH.__EAName = '.HISTORY'

                    /* init the return code                           */
  rc = 0

/* -------------------------- */
                    /* install local error handlers                   */
  SIGNAL ON SYNTAX  NAME FileHistoryEnd
  SIGNAL ON ERROR   NAME FileHistoryEnd
  SIGNAL ON FAILURE NAME FileHistoryEnd
/* -------------------------- */
                    /* get the parameter                              */
  parse upper arg FH.__action , FH.__file , FH.__variable , .

                    /* get the parameter for the ADD action           */
  parse arg  , , FH.__newValue , FH.__tempStem

                    /* check the parameter                            */
  select

                    /* check the action parameter                     */
    when wordPos( FH.__action, 'GET ADD SET CLEAR' ) = 0 then
      rc = -1

                    /* check the parameter for the stem variable      */
    when wordPos( FH.__action, 'GET ADD SET' ) <> 0 & ,
         FH.__variable = '' then
      rc = -1

                    /* check the parameter for the filename           */
    when FH.__file = '' then
      rc = -1

                    /* test, if the file exists                       */
    when stream( FH.__file, 'c', 'QUERY EXISTS' ) = '' then
      rc = 1

                    /* check the number fields in the stem            */
    when FH.__action = 'SET' then
    do
      select

                    /* stem.0 must contain the number of entries      */
        when datatype( value( FH.__variable || '.0' ) ) <> 'NUM' then
          rc = 3
                    /* use the default codepage if the entry          */
                    /* stem.0.codepage is missing                     */
        when symbol( FH.__variable || '.0.CodePage' ) <> 'VAR' then
          call value FH.__variable || '.0.CodePage', 0

                    /* stem.0.codepage must be a numeric value if     */
                    /* it exist                                       */
        when datatype( value( FH.__variable || '.0' ) ) <> 'NUM' then
          rc = 4

        otherwise
          nop
      end /* select */

    end /* when */

    when FH.__action = 'ADD' then
    do
                    /* use the fourth parameter as name of the stem   */
                    /* if entered                                     */
      if FH.__tempStem <> '' then
        FH.__variable = FH.__tempStem
      else
        FH.__variable = 'FH.__tempStem'
    end /* when */

    otherwise
      nop

  end /* select */

/* -------------------------- */

  if rc = 0 then
  do
                    /* load the necessary REXXUTIL functions          */

                    /* use special REXX names to avoid errors if      */
                    /* another program drops the REXXUTIL functions   */
    call rxFuncAdd 'FH_SysGetEA', 'REXXUTIL', 'SysGetEA'
    call rxFuncAdd 'FH_SysPutEA', 'REXXUTIL', 'SysPutEA'

/* -------------------------- */
                    /* constants for the EA type specifier            */
    FH.__EAT_BINARY       = SwapWord( 'FFFE'x )
    FH.__EAT_ASCII        = SwapWord( 'FFFD'x )
    FH.__EAT_BITMAP       = SwapWord( 'FFFB'x )
    FH.__EAT_METAFILE     = SwapWord( 'FFFA'x )
    FH.__EAT_ICON         = SwapWord( 'FFF9'x )
    FH.__EAT_EA           = SwapWord( 'FFEE'x )
    FH.__EAT_MVMT         = SwapWord( 'FFDF'x )
    FH.__EAT_MVST         = SwapWord( 'FFDE'x )
    FH.__EAT_ANS1         = SwapWord( 'FFDD'x )

/* -------------------------- */

    if FH.__action = 'CLEAR' then
    do
                    /* clear the history list                         */
                                                             /* v2.80 */
      call FH_SysPutEA FH.__file, FH.__EAName, ''

    end /* if FH.__action = 'CLEAR' then */

/* -------------------------- */

    if wordPos( FH.__action, 'GET ADD' ) <> 0 then
    do
                    /* read the EA                                    */

                    /* init the stem for the EA values                */
      call value FH.__variable || '.', ''
      call value FH.__variable || '.0' , 0
      call value FH.__variable || '.0.codepage', 0

                    /* read the EA                                    */
      rc = FH_SysGetEA( FH.__file, FH.__EAName, FH.__historyEA )
      if rc = 0 & FH.__historyEA <> '' then
      do
                    /* split the EA into the header fields and the    */
                    /* values                                         */
        parse var FH.__historyEA FH.__historyEAType +2 ,
                                 FH.__historyEACodePage +2,
                                 FH.__historyEACount +2 ,
                                 FH.__historyEAValues

                    /* convert the count value to decimal             */
        FH.__historyEACount = c2d( SwapWord( FH.__HistoryEACount ) )

                    /* check the EA type                              */
        if FH.__historyEAType = FH.__EAT_MVMT then
        do
                    /* save the codepage                              */
          call value FH.__variable || '.0.codepage' ,,
                     c2d( SwapWord( FH.__historyEACodePage ) )

                    /* split the value into separate fields           */
          do FH.__i = 1 to FH.__HistoryEACount while rc = 0

            FH.__HistoryEACurType = substr( FH.__HistoryEAValues, 1, 2 )
            if FH.__HistoryEACurType <> FH.__EAT_ASCII then
              rc = 2    /* invalid EA type                            */
            else
            do
                    /* get the length of this value                   */
              FH.__HistoryEACurLen  = c2d( SwapWord( substr( FH.__HistoryEAValues, 3, 2 ) ) )

              parse var FH.__historyEAValues 5 FH.__HistoryEACurVal,
                                             +( FH.__HistoryEACurLen) ,
                                             FH.__historyEAValues

                    /* save the value into the stem                   */
              call value FH.__variable || '.' || FH.__i ,,
                         FH.__HistoryEACurVal

            end /* else */
          end /* do FH.__i = 1 to c2d( FH.__HistoryEACount ) while rc = 0 */

                    /* save the number of entries in stem.0           */
          if rc = 0 then
            call value FH.__variable || '.0' , FH.__i-1

        end /* if FH.__historyEAType = FH.__EAT_MVST then */
        else
          rc = 2    /* invalid EA type                                */

      end /* if rc = 0 then */

    end /* if wordPos( FH.__action, 'GET ADD' ) <> 0 then */

/* -------------------------- */

    if FH.__action = 'ADD' & rc = 0 then
    do
                    /* add an entry                                   */

      FH.__i = value( FH.__variable || '.0' ) +1
      call value FH.__variable || '.' || FH.__i , FH.__newValue
      call value FH.__variable || '.0' , FH.__i

    end /* if FH.__action = 'ADD' & rc = 0 then */

/* -------------------------- */

    if wordPos( FH.__action, 'SET ADD' ) <> 0 & rc = 0 then
    do
                    /* write the EA                                   */

      FH.__newEA = FH.__EAT_MVMT || ,
         SwapWord( right( '00'x || d2c( value( FH.__variable || '.0.codepage' ) ), 2 ) ) || ,
         SwapWord( right( '00'x || d2c( value( FH.__variable || '.0' ) ), 2 ) )

      do FH.__i = 1 to value( FH.__variable || '.0' )
        FH.__curEntry = value( FH.__variable || '.' || FH.__i )

        FH.__newEA = FH.__newEA || ,
                     FH.__EAT_ASCII || ,
                     SwapWord( right( '00'x || d2c( length( FH.__curEntry ) ), 2 ) ) || ,
                     FH.__curEntry
      end /* do FH.__i = 1 to value( FH.__variable || '.0' ) */

                                                             /* v2.80 */
      call FH_SysPutEA FH.__file, FH.__EAName, FH.__newEA
      rc = result

    end /* if wordPos( FH.__action, 'SET ADD' ) <> 0 then */

  end /* if rc = 0 then */

                    /* label for the local error handler              */
FileHistoryEnd:

                    /* drop the REXXUTIL functions                    */
                    /* (possible and necessary because we use unique  */
                    /*  REXX names!)                                  */
    call rxFuncDrop 'FH_SysGetEA'
    call rxFuncDrop 'FH_SysPutEA'

                    /* drop local variables                           */
  drop FH.

RETURN rc

/* ------------------------------------------------------------------ */
/* function: Convert a hexadecimal WORD from LSB format to MSB format */
/*           and vice versa                                           */
/*                                                                    */
/* call:     SwapWord hexadecimal_word                                */
/*                                                                    */
/* where:    hexadecimal_word - input as hexadecimal word             */
/*                                                                    */
/* output:   value in MSB format as hexadecimal word                  */
/*                                                                    */
SwapWord: PROCEDURE
  RETURN strip( translate( "12", arg(1), "21" ) )


  

Inf-HTML End Run - Successful