/* This arexx script checks the speed and crunch factor of xpk-libraries.
**
**  (C) 1995 - Anders Nordby
**             Kastetskogen 66
**             3218 Sandefjord
**             +47 33451010
*/

/************************************************
*****                                       *****
*****     P A R S E   A R G U M E N T S     *****
*****                                       *****
**********************************************@*/

parse arg arg1 arg2 arg3

if arg1 = '?' then do
   call headline
   call template
end

library = ''

if upcasestr(arg1) = 'LIB' then do
   library = arg2
   filename = arg3
end
else do
   filename = arg1
   if upcasestr(arg2) = 'LIB' then library = arg3
end

/************************************************
*****                                       *****
*****     S E T T I N G S   /   I N I T     *****
*****                                       *****
**********************************************@*/

configfilename = 'sys:s/XPKTEST.config'
xpkoutput = 'ram:xpkoutput'
fnoutput = 'ram:fnoutput'
signal on break_c
signal on break_d
address command 'resident c:xpack add pure'

/**************************
*****                 *****
*****     M A I N     *****
*****                 *****
************************@*/

call headline
if filename = '' then filename = velg_fn(filename)
if ~open('cfg',configfilename,'r') then
   if library = '' then call no_nothing(configfilename)
filename = compress(filename)

options failat 21
address command 'list' filename 'lformat "%p%n" files >'||fnoutput
options failat 10

max_fnlength = checkfno(fnoutput)

if ~open('fno',fnoutput,'r') then exit
open('fno',fnoutput,'r')

if library = '' then do                            /* (multi-library-mode) */
   do while ~eof('fno')
      filename = readln('fno')
      if filename = '' then iterate

      filesize = checkfilesize(filename)
      call header_mlib(filename,filesize)

      open('cfg',configfilename,'r')
      do while ~eof('cfg')
         library = upcasestr(word(readln('cfg'),1))
         if ~(length(library) = 4) then iterate

         ctime = convtime(pack(filename,library,xpkoutput))
         dtime = convtime(unpack(filename))

         echo('xpk'||library ' ' ctime '    ' makelength(calculatekbs(filesize,ctime),8) ' ' dtime '      ' makelength(calculatekbs(filesize,dtime),9) ' ' extract_cf(xpkoutput) )

/*         address command 'delete' xpkoutput '>nil:'*/
      end
      close('cfg')
      echo ''
   end
end
else do                                           /* (single-library-mode) */
   library = upcasestr(compress(library))

   header_slib(library,max_fnlength)

   do while ~eof('fno')
      filename = readln('fno')
      if filename = '' then iterate

      filesize = checkfilesize(filename)

      ctime = convtime(pack(filename,library,xpkoutput))
      dtime = convtime(unpack(filename))

      echo delpath(filename)||spaces(max_fnlength-length(delpath(filename))) ' ' makelength(filesize,9) ' ' ctime '    ' makelength(calculatekbs(filesize,ctime),8) ' ' dtime '      ' makelength(calculatekbs(filesize,dtime),9) ' ' extract_cf(xpkoutput)
   end
   echo ''
end
call close('fno')

address command 'delete' xpkoutput '>nil:'
address command 'delete' fnoutput '>nil:'
address command 'resident c:xpack remove'

exit                                                           /* END MAIN */

/********************************************
*****                                   *****
*****     F I L B E H A N D L I N G     *****
*****                                   *****
******************************************@*/

checkfilesize: proecedure
   parse arg filename

   sizetemp = 'ENV:filesize'
   address command 'list' filename 'lformat "%l" >'||sizetemp

   if ~open('fil',sizetemp,'r') then exit
   open('fil',sizetemp,'r')
   size = readln('fil')
   call close('fil')
return size

/******************************************
*****                                 *****
*****     P R O G R A M D E L E R     *****
*****                                 *****
****************************************@*/

extract_cf: procedure
   parse arg xpkoutput

   if ~open('fil',xpkoutput,'r') then exit
   call open('fil',xpkoutput,'r')
   do while ~eof('fil')
      tmp = tmp2
      tmp2 = readln('fil')
   end
   call close('fil')

   cf = compress(delstr(right(tmp,9),5))
   if cf = 'uce' then cf = 'None'
   if cf = 'req' then cf = '** ERROR : Password required **'
   if cf = 'oos' then cf = '** ERROR : File too small **'
   if cf = 'crun' then cf = '** ERROR : File already crunched **'
   if delstr(cf,1,1) = '.li' then cf = '** ERROR : Cannot open library **'

   if length(cf) > 4 then do i = 1 to 4-length(cf)
      cf = cf||' '
   end
return cf

calculatekbs: procedure /* 01:13:28 */
   parse arg size,time

   h = delstr(time,3)
   m = delstr(delstr(time,1,3),3)
   s = delstr(time,1,6)

   s = s + (m * 60) + (h * 3600)

   kbs = twodecimals((size / 1024) / s)
return kbs

velg_fn: procedure
   fchoice = 'ram:fchoice'

   address command 'requestfile >'||fchoice

   if ~open('file',fchoice,'r') then call intet_fn
   open('file',fchoice,'r')
      filename = readln('file')
   call close('file')
   address command 'delete' fchoice '>nil:'

   if filename = '' then call intet_fn
return filename

pack: procedure
   parse arg filename,library,xpkoutput

   call time('r')
   address command 'xpack "'||filename||'" method' library || '.100 >'||xpkoutput
   time = time('e')
return time

unpack: procedure
   parse arg filename

   tempfilename = 'ram:'||delpath(filename)
   address command 'copy' filename tempfilename

   call time('r')
   address command 'xpack "'||tempfilename||'" >nil:'
   time = time('e')

   address command 'copy' tempfilename filename '>nil:'
   address command 'delete' tempfilename '>nil:'
return time

/**********************************************
*****                                     *****
*****     T E K S T   /   O U T P U T     *****
*****                                     *****
********************************************@*/

headline: procedure
   echo ''
   echo 'XPK-TEST V2.1 by Anders Nordby 1995'
   echo '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
   echo ''
return 0

header_mlib: procedure
   parse arg filename,filesize

   echo '» Filename : '||delpath(filename)
   echo '» Size     : '||filesize||' bytes'

   echo ''
   echo 'Library   Crunch time   KB/S       Decrunch time   KB/S        Crunch factor'
   echo '--------------------------------------------------------------------------------------------------'
return 0

header_slib: procedure
   arg library,max_fnlength

   echo '» Library : xpk'||library
   echo ''
   echo 'Filename   '||spaces(max_fnlength-8)||'Size        Crunch time   KB/S       Decrunch time   KB/S        Crunch factor'
   echo '----------------------------------------------------------------------------------------------------------------'
return 0

/******************************************
*****                                 *****
*****     K O N V E R T E R I N G     *****
*****                                 *****
****************************************@*/

twodecimals: procedure
   parse arg number

   pos = 0
   do i = 1 to length(number)
      cu_ch = delstr(delstr(number,1,i-1),2)
      if cu_ch = '.' then pos = i
   end

   if pos = 0 then number = number + '.00'
   else do
      if length(delstr(number,1,pos)) = 1 then number = number + '0'
      else number = delstr(number,pos+3)
   end
return number

convtime: procedure
   parse arg time

   hs = right(time,2)
   s = delstr(time,length(time)-2)

   if (s / 60) > 1 then do
      m = trunc(s / 60)
      s = s - (trunc(s / 60) * 60)
      if length(m) < 2 then m = '0'||m
   end
   else m = '00'
   if length(s) < 2 then s = '0'||s

   time = m||':'||s||':'||hs
return time

/**************************************************
*****                                         *****
*****     S T R E N G B E H A N D L I N G     *****
*****                                         *****
************************************************@*/

spaces: procedure
   parse arg no_spaces

   string = ''
   do i = 1 to no_spaces
      string = string||' '
   end
return string

delpath: procedure
   parse arg filename

   pos = 0
   do i = 1 to length(filename)
        cu_ch = delstr(delstr(filename,1,i-1),2)
        if cu_ch = '/' then pos = i
        if cu_ch = ':' then pos = i
   end

   filename = delstr(filename,1,pos)
return filename

upcasestr: procedure
   arg string
return string

makelength: procedure
   parse arg string,slength

   if length(string) > slength then string = delstr(string,slength+1)
   else string = string||spaces(slength-length(string))
return string

/**********************************************
*****                                     *****
*****     F E I L B E H A N D L I N G     *****
*****                                     *****
********************************************@*/

checkfno: procedure
   parse arg fnoutput

   if ~open('fno',fnoutput,'r') then exit
   open('fno',fnoutput,'r')
   filename = readln('fno')

   max_fnlength = 0
   seek('fno',0,'B')
   do while ~eof('fno')
      fnlength = length(delpath(readln('fno')))
      if fnlength > max_fnlength then max_fnlength = fnlength
   end
   close('fno')

   if filename = ': object not found' then do
      echo '** ERROR : Object not found **'
      exit
   end

   if max_fnlength < 8 then max_fnlength = 8
return max_fnlength

intet_fn: procedure
   echo 'No filename was specified.'
   echo ''
   call template

no_nothing: procedure
   arg configfilename
   echo 'The configfile ("'||configfilename||'") could not be opened,'
   echo 'and no single library was specified as argument.'
   echo ''
   call template

template: procedure
   echo 'Usage: RX xpkTEST.rexx [filename] [LIB library]'
   echo ''
   exit

/**************************************************
*****                                         *****
*****     S Y S T E M P R O S E D Y R E R     *****
*****                                         *****
************************************************@*/

break_c:
exit

break_d:
exit