------------------- 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

/* this is the format of dates in log files to truncate */
   DateFormat = 'dd-mm-yyyy'        /* European date format */
/* DateFormat = 'mm-dd-yyyy' */     /* American date format */
/* DateFormat = 'yyyy-mm-dd' */     /* Japanese date format */

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

/* for use with log files that does not have the names of days of the week
   but instead the word "Date" followed by the date */
dag.0 = 8
dag.8 = "Date"

DateNrSearch = 1
DateNrFound  = 0
DateFound = ''

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
wrong = 0

if (fspec = '') then
do
  say '* filename or filename specification was not passed'
  wrong = 1
end

if (pos( '/size:', lowercase( options ) ) = 0) & (pos( '/age:',
lowercase( options ) ) = 0) then
do
  say '* /size: or /age: was not passed'
  say '  pass /size: or /age:'
  say '  do not pass both'
  wrong = 2
end

if (pos( '/size:', lowercase( options ) ) > 0) & (pos( '/age:',
lowercase( options ) ) > 0) then
do
  say '* both /size: and /age: were passed'
  say '  pass one or the other, not both'
  wrong = 3
end

if wrong > 0 then
  do
    call Help
  end
else
  do
    if SysFileTree( fspec, 'files', 'FO' ) = 0 then
      do
        if files.0 = 0 then
          say 'no files match' fspec
        do f = 1 to files.0
          call Truncate( files.f options )
        end  /* do f = 1 to files.0 */
      end
    else
      say '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
                if size >= 0 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 >= 0 */
                else /* if size < 0 */
                do
                  call NotUpdateFile
                  say 'used :' fprog fspec options
                  say 'error: size < 0'
                  say 'size must be >= 0'
                end  /* if size < 0 */
              end  /* if size is numeric */
              else /* if size  numeric */
              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 */
                    pos1 = FilePos( file )
                    Line = LineIn( file )                                 
/* read next line */
                    d = 1
                    p = 0
                    do while (d <= dag.0) & (DateNrFound <
DateNrSearch) & (p = 0)
                      p = pos( lowercase( dag.d ), lowercase( Line ) )
                      if p > 0 then
                      do
                        DateFound = word( Line, wordpos( lowercase( dag.d
), lowercase( Line ) ) + 1 )
                        select
                        /* DateFound is in the format stored in DateFormat
(the delimiter in the date doesn't matter) */
                        /* the following lines of code checks and passes
DateFound in the format yyyy-mm-dd to rxDate */
                        when DateFormat = 'dd-mm-yyyy' then  /* dd-mm-yyyy 
--->  yyyy-mm-dd */
                          do
                            dd   = substr( DateFound, 1, 2 )
                            mm   = substr( DateFound, 4, 2 )
                            yyyy = substr( DateFound, 7, 4 )
                            if (datatype( dd ) = 'NUM') & (datatype( mm
) = 'NUM') & (datatype( yyyy ) = 'NUM') then
                              DateNrFound = rxDate( yyyy || '-' || mm || '-' || dd )
                            /* parts of date numeric? */
                          end
                        when DateFormat = 'mm-dd-yyyy' then  /* mm-dd-yyyy 
--->  yyyy-mm-dd */
                          do
                            mm   = substr( DateFound, 1, 2 )
                            dd   = substr( DateFound, 4, 2 )
                            yyyy = substr( DateFound, 7, 4 )
                            if (datatype( mm ) = 'NUM') & (datatype( dd
) = 'NUM') & (datatype( yyyy ) = 'NUM') then
                              DateNrFound = rxDate( yyyy || '-' || mm || '-' || dd )
                            /* parts of date numeric? */
                          end
                        when DateFormat = 'yyyy-mm-dd' then  /* no need for
date conversion */
                          do
                            yyyy = substr( DateFound, 1, 4 )
                            mm   = substr( DateFound, 6, 2 )
                            dd   = substr( DateFound, 9, 2 )
                            if (datatype( yyyy ) = 'NUM') & (datatype(
mm ) = 'NUM') & (datatype( dd ) = 'NUM') then
                              DateNrFound = rxDate( DateFound )
                            /* parts of date numeric? */
                          end
                        otherwise   /* DateFormat is empty or something
other, just quit */
                          call NotUpdateFile
                          say 'DateFormat is empty or not valid'
                          say 'for DateFormat see the begin of this' prog 'file'
                          exit
                        end  /* select */
                      end
                      d = d + 1
                    end  /* do d = 1 to dag.0 */
                  end  /* while not end of file */

                  if DateFound  '' then  /* if any date found */
                  do
                    if (DateNrFound >= DateNrSearch) then  /* if date found */
                    do
                      if pos1 > 1 then
                      do
                        dummy = charout( , ' from' rxDate( DateNrFound, '%A
%d-%m-%Y' ) )
                        written = LineOut( TempFile, Line )         /*
write line in new file */
                        call UpdateFile
                      end  /* if pos1 > 1 */
                      else
                      do   /* if pos1 = 1 */
                        call NotUpdateFile
                      end  /* if pos1 = 1 */
                    end  /* if date found */
                    else
                    do   /* if date not found */
                      call UpdateFile
                    end  /* if date not found */
                  end  /* if DateFound  '' */
                  else
                  do   /* if no date found, not a single date found */
                    call NotUpdateFile
                  end  /* if no date found, not a single date found */
                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 (FileSize( file ) = 0) */
      if (FileSize( file ) = 0) then
      do
        err = SysFileDelete( file )
        if err = 0 then
        do
          dummy = Lineout( , CR || left( "deleted" 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 (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') )


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' '+2 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 "Error opening" 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 "Error opening" 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 'p?rt.t*t /size:0.9'
  say 'example:' fprog 'p*st.txt /size:0.4352'
  say 'example:' fprog 't2nd.t?t /size:1.1'
  say 'example:' fprog 'must.log /size:0'
  say '         /size:0 effectively deletes the file'
  say 'example:' fprog '*.log /age:5'
  say 'example:' fprog '*.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

... Headline reads 'World Wide Web broken: Spiderman at large'
--- GoldED/2 3.0.1