Hello Wim,

Saturday 30 November 2002 17:27, Wim Bijlenga wrote to Eddy Thilleman:

ET>> I've made REXX code to truncate text files (log files), and seek
ET>> backwards for CR/LF (End Of Line) in
ET>> the process. Also a function to test if a given content is
ET>> present in a stem variable.

WB> Although I'm not anyone I'm interested.

/* ---------------- sample code to use InStem ---------------- */

area.  = ''
area.0 = 3
area.1 = 'house'
area.2 = 'road'
area.3 = 'map'

if InStem( area., 'house' ) then say 'house is in area'
if InStem( area., 'map'   ) then say 'map   is in area'
if InStem( area., 'road'  ) then say 'road  is in area'
if InStem( area., 'car'   ) then say 'car   is in area'
return

/* function InStem */
InStem: procedure
  use arg Stem., text
  False = 0
  True  = 1
  n     = 0        /* index var */
  Found = False
  if (Stem.0 > 0) & (strip( text )  "") then
  do
    do while (n <= Stem.0) & (Found = False)
      n = n + 1
      Found = (lowercase( Stem.n ) = lowercase( text ))  /* case
insensitive comparison */
    end  /* while Found = False */
  end  /* Stem and text not empty */
return Found

/* function lowercase */
Lowercase: procedure
  parse arg txt
return translate( txt, XRange('a','z'), XRange('A','Z') )

/* ---------------- end of sample code for InStem ---------------- */


The function to seek EOL (backwards or forwards) is in truncate.cmd

Truncate.cmd uses RexxDate.dll for date calculations.

Truncate.cmd uses FileRexx.dll to move files, but this doesn't work. I
don't know why, it just returns 0 (=no error). The filedate of FileRexx.dll
is 12 feb 1995, so it's relative old.
1995-02-12 16:20:08      14.225 C:\OS2\DLL\FILEREXX.DLL

My REXX interpreter is Object REXX (REXX 6.00).
1998-05-06 16:31:00     406.496 D:\OS2\DLL\REXX.DLL
1998-07-23 15:54:00      26.171 D:\OS2\DLL\REXXAPI.DLL
1997-03-31 17:35:00      55.531 D:\OS2\DLL\REXXCRT.DLL
1996-08-01 13:53:54       5.686 D:\OS2\DLL\REXXINIT.DLL
1996-07-22 19:33:08      26.989 D:\OS2\DLL\REXXSC.DLL
1996-07-22 19:33:26      34.793 D:\OS2\DLL\REXXSOM.DLL
1997-12-16 13:09:00      28.635 D:\OS2\DLL\REXXUTIL.DLL
1996-07-22 19:33:26       2.752 D:\OS2\DLL\REXXWPS.DLL

Maybe I can find a newer copy, or is there one that does work?

------------------- begin of truncate.cmd -------------------
/* truncate given file by size or by age */

/* query my filename */
parse source . . prog
fprog = substr(  prog, lastpos( '\',  prog ) + 1 )
fprog = substr( fprog, lastpos( '\', fprog ) + 1, pos( '.', fprog ) -
lastpos( '\', fprog ) - 1 )

/* load function DLL files */
call RxFuncAdd "SysLoadFuncs","RexxUtil","SysLoadFuncs"
call SysLoadFuncs
if RxFuncQuery('RxDate') then call RxFuncAdd 'RxDate', 'RexxDate', 'RxDate'
call RxFuncAdd 'FileLoadFuncs', 'FILEREXX', 'FileLoadFuncs'
call FileLoadFuncs

'{at}echo off'

CR  = '0D'x
LF  = '0A'x

dag.  = ""
dag.0 = 8
dag.1 = "Sunday"
dag.2 = "Monday"
dag.3 = "Tuesday"
dag.4 = "Wednesday"
dag.5 = "Thursday"
dag.6 = "Friday"
dag.7 = "Saturday"
dag.8 = "Date"

DateNrSearch = 1
DateNrFound  = 0

numeric digits 99
parse value SysTextScreenSize() with row col   /* screen width */

env = 'OS2ENVIRONMENT'
TempDir = value( 'tmp', , env )
if TempDir = "" then TempDir = value( 'temp', , env )

parse arg fspec options

select
when (fspec = '') then
  wrong=1
when (pos( '/size:', lowercase( options ) ) = 0) & (pos( '/age:',
lowercase( options ) ) = 0) then
  wrong=2
when (pos( '/size:', lowercase( options ) ) > 0) & (pos( '/age:',
lowercase( options ) ) > 0) then
  wrong=3
otherwise
  wrong=0
end  /* select */

if wrong>0 then
  do
    call Help
  end
else
  do
    if SysFileTree( fspec, 'files', 'FO' ) = 0 then
      do f = 1 to files.0
        call Truncate( files.f options )
      end  /* do f = 1 to files.0 */
    else
      'echo Error SysFileTree with ' || fspec || ': not enough memory'
    /* SysFileTree  0, iow returned 2, not enough memory */
  end
return


Truncate:
  parse arg file options
  if FileExist( file ) then
  do
    TempFile = SysTempFileName( TempDir || "\Trunc$???$.??$" )
    if TempFile  "" then    /* TempFileName OK */
    do
      if OpenReadFile( file ) then
      do
        dummy = charout( , CR || "truncating" file
">" TempFile )
        if OpenWriteFile( TempFile ) then
        do
          select
          when (pos( '/size:', lowercase( options ) ) = 1) then
            do
              size = substr( options, length( '/size:' ) + 1 )
              if (datatype( size ) = 'NUM') then
              do
                size = format( 1024 * substr( options, length( '/size:' ) + 1 ),, 0 )
                fpos = SeekFile( file 'seek <'size 'read' )
                if (datatype( fpos ) = 'NUM') then
                do
                  if fpos > 0 then
                    fpos = SeekEOL( file '-' )                   /* seek
EOL backwards */
                  if fpos > 0 then
                    call UpdateFile
                  else
                    call NotUpdateFile
                  /* */
                end  /* if SeekFile OK */
                else
                  call NotUpdateFile
                /* */
              end  /* if size is numeric */
              else
              do
                call NotUpdateFile
                say 'used :' fprog fspec options
                say 'error: no size passed or size is not numeric'
                say 'size must be numeric'
              end  /* if size  numeric */
            end  /* option='/size:n' */
          when (pos( '/age:', lowercase( options ) ) = 1) then
            do
              age = substr( options, length( '/age:' ) + 1 )
              if (datatype( age ) = 'NUM') then
              do
                if age >= 0 then
                do
                  DateNrSearch = rxDate() - age
                  DateNrFound  = 0
                  do while (Lines(file)=1) & (DateNrFound <
DateNrSearch)  /* while not end of file */
                    Line = LineIn( file )                                 
/* read next line */
                    d = 1
                    do while (d <= dag.0) & (DateNrFound < DateNrSearch)
                      p = pos( lowercase( dag.d ), lowercase( Line ) )
                      if p > 0 then
                      do
                        DateFound = word( Line, wordpos( lowercase( dag.d
), lowercase( Line ) ) + 1 )
                        DateNrFound = rxDate( substr( DateFound, 7 ) || '-'
|| substr( DateFound, 4, 2 ) || '-' || substr( DateFound, 1, 2 ) )
                      end
                      d = d + 1
                    end  /* do d = 1 to dag.0 */
                  end  /* while not end of file */
                  if (DateNrFound >= DateNrSearch) then
                  do
                    dummy = charout( , ' from' rxDate( DateNrFound, '%A %d-%m-%Y' ) )
                    written = LineOut( TempFile, Line )         /* write
line in new file */
                  end
                  call UpdateFile
                end  /* if age >= 0 */
                else
                do   /* if age < 0 */
                  call NotUpdateFile
                  say 'used :' fprog fspec options
                  say 'error: age is less than 0'
                end  /* if age < 0 */
              end  /* if age is numeric */
              else
              do
                call NotUpdateFile
                say 'used :' fprog fspec options
                say 'error: no age passed or age is not numeric'
                say 'age must be numeric'
              end  /* if age  numeric */
            end  /* option='/age:n' */
          otherwise
            call NotUpdateFile
            call Help
          end  /* select */
        end  /* if TempFile is open */
      end  /* file open */
      else /* file not open */
      do
        call DisplayError( CR || "Error: file" file "could
not be opened" )
      end  /* file not open */
    end  /* TempFileName OK */
    else /* TempFileName is empty */
    do
      call DisplayError( CR || "Error: No TempFileName in TempDir
" || TempDir )
    end  /* TempNameFile is empty */
  end  /* if FileExist( file ) */
  else /* if not FileExist( file ) */
  do
    say "file" file "not found"
  end  /* if not FileExist( file ) */
return


UpdateFile:
  do while (Lines(file)=1)                    /* while not end of file */
    Line = LineIn( file )                       /* read new line */
    written = LineOut( TempFile, Line )         /* write line in new file */
  end  /* while not end of file */
  call CloseFile( file )               /* close inputfile  */
  call CloseFile( TempFile )           /* close outputfile */

  err = SysFileDelete( file )
  if err  0 then
  do
    dummy = Lineout( , CR || 'Deleting' file 'Error:' SysGetMessage( err ) )
    raise Error (err)
  end

  err = FileMoveFile( TempFile, file )
  if err  0 then
  do
    dummy = Lineout( , CR || 'Moving' TempFile 'to' file 'Error:'
SysGetMessage( err ) )
    raise Error (err)
  end

  /* ---------- temp code ---------- */
  if FileExist( file ) & \FileExist( TempFile ) then
    nop
  else
  do
    'mov' TempFile file '> nul'
  end
  /* ---------- temp code ---------- */

  if FileExist( file ) & \FileExist( TempFile ) then
  do
    if (FileSize( file ) > 0) then
    do
      if (datatype( fpos ) = 'NUM') then
      do
        dummy = Lineout( , CR || left( "truncated" file
"from pos" FormatNum( fpos ), col-1 ) )
      end
      if (DateNrFound >= DateNrSearch) then
      do
        dummy = Lineout( , CR || left( "truncated" file
"from" rxDate( DateNrFound, '%A %d-%m-%Y' ), col-1 ) )
      end
      if (datatype( fpos )  'NUM') & (DateNrFound < DateNrSearch) then
      do
        dummy = Lineout( , CR || left( "truncated" file 'to'
FormatNum( FileSize( file ) ) 'bytes', col-1 ) )
      end
    end  /* if (FileSize( file ) > 0) */
    else /* NOTE: it's impossible that a file has a size < 0 */
    do   /* if not (FileSize( file ) > 0) */
      if (FileSize( file ) = 0) then
      do
        err = SysFileDelete( file )
        if err = 0 then
        do
          dummy = Lineout( , CR || left( "deleted" file 'its
filesize=' || FileSize( file ), col-1 ) )
        end
        else
        do
          dummy = Lineout( , CR || left( 'Deleting' file 'Error:'
SysGetMessage( err ), col-1 ) )
          raise Error (err)
        end
      end  /* if (FileSize( file ) = 0) */
    end  /* if not (FileSize( file ) > 0) */
  end  /* if FileExist( file ) & \FileExist( TempFile ) */
  else
  do  /* if not (FileExist( file ) & \FileExist( TempFile )) */
    dummy = Lineout( , CR || left( 'Error:' TempFile 'was not moved back
to' file, col-1 ) )
    raise Error (err)
  end /* if not (FileExist( file ) & \FileExist( TempFile )) */
return


NotUpdateFile:
  call CloseFile( file )               /* close inputfile  */
  call CloseFile( TempFile )           /* close outputfile */
  err = SysFileDelete( TempFile )
  dummy = charout( , CR || copies( " ", col-1 ) || CR )
return


/* function lowercase */
Lowercase: procedure
  parse arg txt
return translate( txt, XRange('a','z'), XRange('A','Z') )


/* function InStem */
InStem: procedure
  use arg Stem., text
  False = 0
  True  = 1
  n     = 0        /* index var */
  Found = False
  if (Stem.0 > 0) & (strip( text )  "") then
  do
    do while (n <= Stem.0) & (Found = False)
      n = n + 1
      Found = (lowercase( Stem.n ) = lowercase( text ))
    end  /* while Found = False */
  end  /* Stem and text not empty */
return Found


FormatNum: procedure
  parse arg n         /* number to format */
  ln = length( n ) - 2
  do p=ln to 2 by -3
    n = insert( '.', n, p-1 )
  end
return n


DirExist: Procedure
parse arg dirname
  d = 0              /* index number for dir  */
  ReturnValue = 0
  if SysFileTree( dirname, 'dir', 'DO' ) = 0 then
    do d = 1 to dir.0  /* all matched directories */
      if lowercase( dir.d ) = lowercase( dirname ) then ReturnValue = 1
    end  /* all matched directories */
  else
    say 'not enough memory'
  /* SysFileTree  0, iow returned 2, not enough memory */
return ReturnValue


FileExist: procedure
  parse arg file
  FileName = strip( stream( file, 'c', 'query exists' ) )
return (Length( FileName ) > 0)


FileSize: procedure
  parse arg file
return stream( file, 'c', 'query size' )


FilePos: procedure
  parse arg file
return stream( file, 'c', 'query position' )


/* function SeekEOL, Seek End Of Line */
/* (before or after the current read position) */
SeekEOL: procedure expose CR LF
  parse arg file direction
  ch1 = ""
  ch2 = ""
  if (direction = '+') | (direction = '-') then
  do
    fpos = stream( file, 'c', 'seek' direction||'1 read' )
    if (datatype( fpos ) = 'NUM') & (fpos > 0) then
    do
      ch1 = charin( file )
      fpos = stream( file, 'c', 'seek' direction||'1 read' )
    end
    do while (datatype( fpos ) = 'NUM') & (fpos > 0) & (c2x(ch1)
 c2x(CR)) & (c2x(ch2)  c2x(LF))
      ch2 = ch1
      fpos = stream( file, 'c', 'seek' direction||'1 read' )
      if (datatype( fpos ) = 'NUM') & (fpos > 0) then
      do
        ch1 = charin( file )
        fpos = stream( file, 'c', 'seek' direction||'1 read' )
      end  /* if (datatype( fpos ) = 'NUM') */
    end  /* do while (datatype( fpos ) = 'NUM') & (ch2  CR)
& (ch1  LF) */
    if (datatype( fpos ) = 'NUM') & (fpos > 0) then
    do
      if (c2x(ch1) = c2x(CR)) & (c2x(ch2) = c2x(LF)) then
        fpos = stream( file, 'c', 'seek' '+2 read' )
      else
        if (c2x(ch1) = c2x(CR)) | (c2x(ch1) = c2x(LF)) | (c2x(ch2) =
c2x(CR)) | (c2x(ch2) = c2x(LF)) then
          fpos = stream( file, 'c', 'seek' '+1 read' )
        /* */
      /* */
    end  /* if no error & ch1=CR & ch2=LF */
  end  /* if direction = '+' or '-' */
return fpos


/* function SeekFile( file, seekstring ) */
SeekFile: procedure
  parse arg file seekto
  fpos = stream( file, 'c', seekto )
return fpos


/* function OpenReadFile( fname ) */
OpenReadFile: procedure
  parse arg fname
  fpos = stream( fname, 'c', 'query exists' )
  if length( fpos ) > 0 then
  do
    fpos = stream( fname, 'c', 'open read' )
    if (fpos == 'READY') | (fpos == 'READY:') then
      r = 1
    else
    do
      r = 0
      say "Cannot open file" fname", status" stream(
fname, 'D' )  /* display description about possible error */
    end  /* r = 0 */
  end
  else
  do
    r = 0
  end
return r


/* function OpenWriteFile( file ) */
OpenWriteFile: procedure
  parse arg file
  fpos = stream( file, 'c', 'open write' )
  if (fpos == 'READY') | (fpos == 'READY:') then
    r = 1
  else
  do
    r = 0
    say file":" stream( file, 'D' )  /* display description about
possible error */
  end
return r


/* function CloseFile( fname ) */
CloseFile: procedure
  parse arg fname
  fpos = stream( fname, 'C', 'close' )
  if (fpos == 'READY') | (fpos == 'READY:') then
    r = 1
  else
  do
    r = 0
    say "Error closing" fname":" stream( fname, 'D' ) 
/* display description about possible error */
  end
return


DisplayError:
  parse arg text
  dummy = Lineout( , text )
  if \DirExist( TempDir ) then
  do
    dummy = Lineout( , "directory" TempDir "NOT found..." )
  end
  dummy = Lineout( , "any key to quit..." )
  dummy = SysGetKey( NoEcho )
exit


Error:
  dummy = Lineout( , "any key to quit..." )
  dummy = SysGetKey( NoEcho )
exit


Help:
  say 'used   :' fprog fspec options
  say 'usage  :' fprog 'filespec /size:s | /age:d'
  say '         to truncate file(s)'
  say '         filespec wildcards supported'
  say '         s in Kb, partial Kb is supported'
  say '         d in days'
  say '         /size: and /age: exclude each other'
  say '         /size: or /age: is mandatory'
  say '         s or d must be numeric'
  say 'example:' fprog 'test.txt /size:10'
  say 'example:' fprog 'part.txt /size:0.9'
  say 'example:' fprog 'p1st.txt /size:0.4352'
  say 'example:' fprog 't2nd.txt /size:1.1'
  say 'example:' fprog 't2nd.txt /age:5'
  say 'example:' fprog 't2nd.txt /age:365'
return
-------------------- end of truncate.cmd --------------------

  Greetings   -=Eddy=-

netmail: 2:280/5003.10  1:261/38.3
  email: e.thilleman{at}freeler.nl
         e.thilleman{at}hccnet.nl

... OS/2 users have 'Extended Attributes'
--- GoldED/2 3.0.1