home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
inetlg75.zip
/
INETLOG.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
2001-09-15
|
71KB
|
1,927 lines
/* INetLog
Copyright 1996 - 2001 by Chuck McKinnis, Sandia Park, NM (USA) 04 May 2001
mckinnis@attglobal.net
Copyright 1995 by Jerry Levy, Marblehead, MA (USA) 03 Nov 95
REXX Program to extract and totalize daily and monthly time-ons by
analyzing the IBM WARP Internet Dialer log or the InJoy dialer log */
Trace 'N'
Parse Upper Arg otherparms '|' pmrexx
our_parms = otherparms
/* Where are we ? */
Parse Source . . our_prog .
install_path = Filespec('D',our_prog) || Filespec('P',our_prog)
inetcfg_ini = install_path || 'inetcfg.ini'
save_path = Directory()
our_path = Strip(install_path, 'T', '\')
our_path = Directory(our_path)
If Rxfuncquery('SysLoadFuncs') Then
Call Rxfuncadd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
Call SysLoadFuncs
pmrexx = (pmrexx <> '')
obj_id = '<INETLOG_RUN>'
If \pmrexx Then
Do
Call PMRexxGo 'START', obj_id, our_prog, 'Internet Log Analyzer', our_parms
Return
End
say_out_pipe = 'STDOUT'
/*
If Rxfuncquery('RxExtra') Then
Call Rxfuncadd 'RxExtra', 'RxExtras', 'RxExtra'
Call RxExtra 'LOAD'
*/
Signal On Failure Name errhandler
Signal On Halt Name errhandler
Signal On Syntax Name errhandler
/*========MAIN PROGRAM=========*/
Call Initialize_inetlog
If \ibm_dialer & \injoy_dialer Then
Do
Say 'You have not selected any logs to analyze'
Call Cleanup
End
If ibm_dialer Then
Do
/* gets, calculates, totalizes connect times.
Mostly a bunch of conditionals with a Call to a
data-formatting routine. All is stored in
variables for output all at once */
Call Analyze_inetlog
save_quiet = quiet
If combineonly Then
quiet = 1
Call Output_inetlog/* Outputs everything to console and to disk */
quiet = save_quiet
End
If injoy_dialer Then
Do
injoy_parms = ''
save_quiet = quiet
If combineonly Then
quiet = 1
injoy_rc = IJoyLog()
If injoy_rc Then /* pick up any changes made by injoylog */
Call Read_config
quiet = save_quiet
End
If (combine | combineonly) & injoy_rc Then
Do
save_quiet = quiet
quiet = 0
Call Combined_output
quiet = save_quiet
End
Call Cleanup /* Exits */
Return
/*====END OF MAIN PROGRAM=======*/
Initialize_inetlog:
trace_save = Trace('N')
quiet = (Wordpos('QUIET', otherparms) <> 0)
combine = (Wordpos('COMBINE', otherparms) <> 0)
combineonly = (Wordpos('COMBINEONLY', otherparms) <> 0)
If Rx_fileexists(inetcfg_ini) Then /* save any existing ini file */
Do
ini_save = Left(inetcfg_ini, Lastpos('.', inetcfg_ini)) || 'sav'
Address cmd '@copy' inetcfg_ini ini_save '> nul'
End
Call Read_config
If ibm_dialer Then
Do
/* Get path for connection log file and install directory */
x = Setlocal()
tcpip_etc_path = Value('ETC', ,'OS2ENVIRONMENT')
tcpip_etc_path = tcpip_etc_path || '\'
x = Endlocal()
dialer_ini = tcpip_etc_path || ibm_dialer_ini_file
Parse Value Log_file_parms(ibm_dialer_ini_file, dialer_ini) ,
With dialer_log_file dialer_log_size
log_file = dialer_log_file
/* Get full paths for output file and summary file */
output_file = data_path || ibm_output_file
summary_file = data_path || ibm_summary_file
Call Set_monthly_summary
ibm_summary = summary_file
/* initialize variables */
crlf = D2c(13) || D2c(10) /* carriage return + linefeed */
esc = D2c(27) /* Escape character */
time_stamp = '' /* Time stamp of each connect record */
Do i = 1 To 12 /* initialize months */
x = Right(i,2,'0')
month.x = Word('Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec',i)
End
/* calculated variables
signons_each_day Accumulate number of connects daily
signons_each_month Accumulate number of connects monthly
time_on Time, each connect (minutes)
daily_time_on Accumulated minutes, daily
monthly_time_on Accumulated minutes, monthly */
/* More variables: these we initialize as follows: */
old_m = 0 /* Storage of a 2-digit month (eg 05 = May) */
old_d = 0 /* ... and a 2-digit day */
dcounter = 0 /* Counter increments each sign-on in a day */
mcounter = 0 /* Same for each sign-on in a month */
monthline. = '' /* Initialize both of these as null strings */
dayline. = '' /* These are for monthly and daily output strings */
/* A typical line generated in the connect.log upon disconnect looks like
either this for a dialer version preceding v1.45:
11/15 19:08:38 Disconnected after 00:06:20 0 errors 0 discards'
or this style for v. 1.45 and later:
1995/11/15 19:08:38 Disconnected after 00:06:20 0 errors 0 discards
We search for a key_phrase using the RexxUtil function SysFileSearch */
/* Word or phrase we'll search for */
key_phrase = 'Disconnected after'
user_phrase = 'dialed' /* word to search for account and userid */
/* Here is where we Check if the output file exists. If it does, we
overwrite it, and if not we create it. BUT.... we don't want to
do something stupid like try to erase a vital file or the connect
logfile... */
If \Rx_fileexists(log_file) Then
Do
Say 'Aborting.' log_file 'does not exist.'
Call Beep 1000,100
Call Cleanup
End
file1 = Translate(Filespec('N', log_file))
file2 = Translate(Filespec('N', output_file))
If file2 == 'CONNECT.LOG',
| file2 == 'IPDIALER.LOG',
| file2 == 'CONFIG.SYS',
| file2 == 'AUTOEXEC.BAT',
| file2 == file1 Then
Do
Say log_file 'was entered as the dialer log file name and'
Say output_file 'was entered as the INETLOG output file name.'
Say 'These files cannot have the same name, and the names'
Say '"CONNECT.LOG, IPDIALER.LOG, CONFIG.SYS, and AUTOEXEC.BAT"'
Say 'are not permitted as INETLOG output file names.'
Say crlf
Call Beep 1000,100
Call Cleanup /* Error, so Exit */
End
/* make sure that we have control of the log file */
xrc = File_cmd(log_file, 'W')
If \xrc Then
Do Until xrc
Say 'Log file' log_file 'returned' result
xrc = File_cmd(log_file, 'C')
Say 'Unable to open' log_file
Say 'Press Esc to abort run'
answer = Say_message('Press any other key to wait 5 seconds')
If answer = esc Then
Call Cleanup
Call SysSleep 5
Call SysCls
xrc = File_cmd(log_file, 'W')
End
xrc = File_cmd(log_file, 'C')
/* Backup any output file of the same name if it exists, then erase orig. */
If Rx_fileexists(output_file) Then
Do
Parse Var output_file fname '.' ext
Address cmd '@COPY' output_file fname||'.bak > NUL'
Call SysFileDelete output_file
End
End
Trace(trace_save)
Return /* initialize_inetlog */
/* read the config file */
Read_config:
trace_save = Trace('N')
If Rx_fileexists(inetcfg_ini) Then /* do we have a config file */
input_file = inetcfg_ini
Else
Do
ini_save = Left(inetcfg_ini, Lastpos('.', inetcfg_ini)) || 'sav'
If Rx_fileexists(ini_save) Then
Do
Say 'Restoring' inetcfg_ini 'from' ini_save
Address cmd '@copy' ini_save inetcfg_ini '> nul'
input_file = inetcfg_ini
End
Else
Do
Say inetcfg_ini 'not found'
Say 'Please run Install'
Call Cleanup
End
End
Say 'Using configuration file -' input_file
cfg_common = SysIni(input_file, 'cfg_common', 'cfg_common')
If cfg_common <> 'ERROR:' Then
Do i = 1 To Words(cfg_common)
keyid = Word(cfg_common, i)
Interpret keyid '= sysini("' || input_file || '", "cfg_common", "' || keyid || '")'
End
Else
Do
Say 'cfg_common not found in' input_file
Say 'Please run Install'
Call Cleanup
End
cfg_inetlog = SysIni(input_file, 'cfg_inetlog', 'cfg_inetlog')
If cfg_inetlog <> 'ERROR:' Then
Do i = 1 To Words(cfg_inetlog)
keyid = Word(cfg_inetlog, i)
Interpret keyid '= sysini("' || input_file || '", "cfg_inetlog", "' || keyid || '")'
End
Else
Do
Say 'cfg_inetlog not found in' input_file
Say 'Please run Install'
Call Cleanup
End
cfg_ijoylog = SysIni(input_file, 'cfg_ijoylog', 'cfg_ijoylog')
If cfg_ijoylog <> 'ERROR:' Then
Do i = 1 To Words(cfg_ijoylog)
keyid = Word(cfg_ijoylog, i)
Interpret keyid '= sysini("' || input_file || '", "cfg_ijoylog", "' || keyid || '")'
End
Else
Do
Say 'cfg_ijoylog not found in' input_file
Say 'Please run Install'
Call Cleanup
End
Trace(trace_save)
Return 0
Log_file_parms: Procedure
trace_save = Trace('N')
Parse Arg dialer_ini_name, dialer_ini
Select
When Translate(dialer_ini_name) = 'DIALER.INI' Then
Do
dlog_eparm = 'AdvLog'
dlog_nparm = 'Cfn'
dlog_sparm = 'Cfs'
End
When Translate(dialer_ini_name) = 'TCPDIAL.INI' Then
Do
dlog_eparm = 'Common'
dlog_nparm = 'LoggingCfn'
dlog_sparm = 'LoggingCfs'
End
Otherwise Do
Say 'Unable to recognize dialer ini file'
Call Cleanup
Exit
End
End
dialer_log_file = Strip(SysIni(dialer_ini, dlog_eparm, dlog_nparm),,'00'x)
dialer_log_size = C2d(Left(SysIni(dialer_ini, dlog_eparm, dlog_sparm),3))
Trace(trace_save)
Return dialer_log_file dialer_log_size
/* Now find all lines in connect.log that contain the key_phrase
string. A typical line generated in the connect.log after
disconnect is either this for a dialer version preceding v. 1.45:
11/15 19:08:38 Disconnected after 00:06:20 0 errors 0 discards
or this style for v. 1.45 and later:
1995/11/15 19:08:38 Disconnected after 00:06:20 0 errors 0 discards
which we would parse as follows:
date word2 word3 word4 connect_time */
Analyze_inetlog:
trace_save = Trace('N')
Call SysFileSearch key_phrase, log_file, 'line.', 'N'
Call SysFileSearch user_phrase, log_file, 'user.', 'N'
/* this section will read backwards through the connection log file
data and attempt to assign account information and userid to each
connection log record */
k = user.0
Do i = line.0 To 1 By -1 While k > 0
Parse Var line.i disc_line_no .
acct_data = 'acctid=unknown userid=unknown'
j = i - 1
If j > 0 Then
Parse Var line.j prev_disc_line_no .
Else
prev_disc_line_no = 0
If k > 0 Then
Do
Parse Var user.k user_line_no . . acctid userid .
If disc_line_no > user_line_no & user_line_no > prev_disc_line_no Then
Do
acct_data = 'acctid=' || acctid 'userid=' || userid
k = k - 1
End
End
line.i = line.i acct_data
End
xrc = 0
Do i = 1 To line.0
Parse Var line.i . date word2 word3 word4 connect_time remainder
If remainder = '' Then
Iterate i
Parse Var remainder . 'acctid=' acctid 'userid=' userid .
acctid = Strip(acctid)
userid = Strip(userid)
/* Date, excluding year if year is or is not present, is 5 chars: mm/dd */
date2 = Right(date,5)
/* Make all dates uniform. If more than mm/dd (5 chars) then year
is there. The length(date) - 6 = length of however many
characters are used for the year (4 now (e.g., 1995) but some
joker might change it to 2 (e.g., 95) We then add 1 char for the
/ separator + 1 */
If Length(date) > 5 Then
year = Substr((date), 1, Length(date) -6 ) || ' '
Else
year = ' ' /* If pre v1.45 Dialer, no year, pad 5 spaces */
/* Extract the month of a connection as a 2-dig number */
mm = Substr(date2, 1, 2)
dd = Substr(date2, 4, 2) /* ...and the day */
/* Extract for time stamp and save */
Parse Var word2 t_hr ':' t_min ':' t_sec
If year <> ' ' Then
t_yr = Strip(year)
Else
t_yr = ' '
time_stamp = 'T' || t_yr || mm || dd || t_hr || t_min || t_sec
/* Extract the number of hours on-line */
hrs = Substr(connect_time, 1, 2)
mins = Substr(connect_time, 4, 2) /*... and mins */
secs = Substr(connect_time, 7, 2) /*...and seconds */
If hrs < 0, /* If hrs is negative */
| mins < 0, /* or mins is negative */
| secs < 0 Then
Call Errdst /* or secs is negative. Time change error? Abort */
/* Calculate time_on for that connection */
time_on = (60*hrs + mins + (1/60)*secs)
If time_stamp > last_time_stamp Then
Call Monthly_update
If old_d = 0 Then
Do /* for very first connection line */
old_m = mm
old_d = dd
old_y = year
signons_each_day = 1 /* reset to 1 */
signons_each_month = 1
/* This and next one are timeons in minutes */
daily_time_on = time_on
monthly_time_on = time_on
End
Else /* continue to accumulate times if same month and day */
If old_m = mm & old_d = dd & month <> 0 Then
Do
old_y = year
signons_each_day = signons_each_day + 1
signons_each_month = signons_each_month + 1
daily_time_on = daily_time_on + time_on
monthly_time_on = monthly_time_on + time_on
End
Else /* new day of same month */
If old_m = mm & old_d <> dd Then
Do
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = Space(year)
year.mcounter = Space(year)
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
old_d = dd
old_y = year
signons_each_day = 1 /* Start counting over again */
signons_each_month = signons_each_month + 1
daily_time_on = time_on
monthly_time_on = monthly_time_on + time_on
End
Else /* for any new month, which by definition is also a new day */
If old_m <> mm & old_m <> 0 Then
Do
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = Space(old_y)
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
mcounter = mcounter + 1
year.mcounter = Space(old_y)
monthline.mcounter = year.mcounter month.old_m m_signons m_mins m_hhmmss m_hrs
old_m = mm
old_d = dd
old_y = year
signons_each_day = 1
signons_each_month = 1
daily_time_on = time_on
monthly_time_on = time_on
End
End /* end of all these If's and Else If's of searching for
key_phrase in all possible lines in the connect.log */
/* Now, since last day and last month is done: */
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = Space(year)
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
mcounter = mcounter + 1
year.mcounter = Space(year)
monthline.mcounter = year.mcounter month.old_m m_signons m_mins m_hhmmss m_hrs
/* save the last */
ibm_last_time_stamp = time_stamp
Call SysIni inetcfg_ini, 'cfg_inetlog', 'ibm_last_time_stamp', time_stamp
Trace(trace_save)
return /* from analyze_inetlog */
Monthly_update:
s_yr = Strip(t_yr)
s_mo = Strip(mm)
If summary.acctid.userid.s_yr.s_mo <> '' Then
Do
Parse Var summary.acctid.userid.s_yr.s_mo s_yr s_mo s_stamp s_sess s_min .
If time_stamp > s_stamp Then
Do
s_sess = s_sess + 1
s_min = s_min + time_on
summary.acctid.userid.s_yr.s_mo = s_yr s_mo time_stamp s_sess s_min
End
End
Else
Do
x = monthly.0 + 1
monthly.x = acctid userid s_yr s_mo
monthly.0 = x
summary.acctid.userid.s_yr.s_mo = s_yr s_mo time_stamp '1' time_on
End
Return
Output_inetlog:
/* Now output everything to console and to file */
/* get the screen size; rows is what we are interested in */
Parse Value SysTextScreenSize() With rows cols
Call Stream stdin, 'C', 'OPEN READ'
/* Tell us all */
intro = what_r_we
Call Say_out intro
Call Lineout output_file, intro
Call Lineout output_file, crlf || 'Running with parms =' otherparms
intro = 'Analysis of' log_file '(' || Date() '@' Time() || ')'
Call Say_out ' ', intro
Call Lineout output_file, crlf || intro
If daily_report Then
Call Say_out ' ', 'Daily Totals', ' '
Call Lineout output_file, crlf || 'Daily Totals' || crlf
Do j = 1 To dcounter
If daily_report Then
Call Say_out dayline.j
Call Lineout output_file, dayline.j
End
/* back up the summary file and delete it */
If Rx_fileexists(summary_file) Then
Do
Parse Var summary_file fname '.' ext
Address cmd '@COPY' summary_file fname || '.bak > NUL'
Call SysFileDelete summary_file
End
xrc = File_cmd(summary_file,'W')
acct_user_save = ''
Call SysStemSort 'monthly.', 'A' /* sort the summary data */
Call Summary_sample /* get the header information */
/* insert the header info into the summary data */
Do k = summary_sample.0 To 1 By -1
Call SysStemInsert 'monthly.', 1, summary_sample.k
End
Do k = 1 To monthly.0
If Abbrev(monthly.k,'*') Then
Do /* write comments back out */
Call Lineout summary_file, monthly.k
Iterate k
End
Parse Var monthly.k acctid userid s_yr s_mo
acct_user = acctid userid
Call Lineout summary_file, acctid userid '*' summary.acctid.userid.s_yr.s_mo
Parse Var summary.acctid.userid.s_yr.s_mo . . . s_sess s_mins
m_sess = Format(s_sess, sig_x) || 'X'
m_mins = Format(s_mins, sig_min, 2) 'mins'
mo_hh = Format(Trunc(s_mins / 60),sig_hr)
mo_mm = Right(Trunc(s_mins // 60),2,'0')
mo_ss = Right(Trunc(60 * ((s_mins // 60) - Trunc(s_mins // 60))),2,'0')
m_hhmmss = ' '||mo_hh||':'||mo_mm||':'||mo_ss
m_hrs = Format((s_mins / 60), sig_hr, 2) 'hrs'
a_sess = s_mins / s_sess
If a_sess < 60 Then
a_sess = Format(a_sess,2,0) 'mins'
Else
a_sess = Format((a_sess / 60),2,2) 'hrs'
a_sess = '- Ave =' a_sess
monthline = s_yr month.s_mo m_sess m_mins m_hhmmss m_hrs a_sess
If acct_user <> acct_user_save Then
Do
intro = 'Monthly Totals for Account(' || acctid || ') Userid(' || userid || ')'
Call Say_out ' ', intro, ' '
Call Lineout output_file, crlf || intro || crlf
acct_user_save = acct_user
End
Call Lineout output_file, monthline
monthline = s_yr month.s_mo m_sess m_hrs a_sess
Call Say_out monthline
End
xrc = File_cmd(summary_file,'C')
finished = 'End of analysis of' log_file
Call Say_out ' ', finished
Call Lineout output_file, crlf || finished
xrc = SysFileTree(dialer_log_file, 'info.', 'F')
Parse Var info.1 . . log_file_size .
If dialer_log_size > 0 Then
Do
log_file_pct = Format((log_file_size / dialer_log_size) * 100,,0)
Call Say_out ' ', 'The connection log file is at' log_file_pct || '% of the maximum'
Call Say_out 'size,' Format(dialer_log_size,,0) 'bytes, specified in the Dialer settings.'
If log_file_pct > warn_pct Then
Do
Call Say_out ' ', 'You may want to consider running editing the'
Call Say_out dialer_log_file 'with the IBM tedit.exe', ' '
End
End
Return /* from output_inetlog */
Combined_output:
/* Combine output from IGN and InJoy and display */
save_trace = Trace('N')
If \injoy_dialer Then
Return
If quiet Then
Return
ign. = ''
ign.0 = 0
If ibm_dialer Then
Do
/* read the IBM dialer summary log */
If Rx_fileexists(ibm_summary) Then
Do
Call Rx_readlines ibm_summary
Do x = 1 To file_lines.0
If \Abbrev(file_lines.x,'*') & file_lines.x <> '' Then
Do
Parse Var file_lines.x acctid userid '*' s_yr s_mo s_time s_data
i = ign.0 + 1
ign.i = Space(acctid userid s_yr s_mo s_data)
ign.0 = i
End
End
End
End
i = ign.0 + 1 /* make an end of file record */
ign.i = Copies('FF'x, 8) Copies('FF'x, 8) Copies('FF'x, 4) 'FFFF'x
ign.0 = i
joy. = ''
joy.0 = 0
/* read the InJoy dialer summary file */
If Rx_fileexists(injoy_summary) Then
Do
Call Rx_readlines injoy_summary
Do x = 1 To file_lines.0
If \Abbrev(file_lines.x,'*') & file_lines.x <> '' Then
Do
Parse Var file_lines.x acctid userid '*' s_yr s_mo s_time s_data
acctid = Strip(acctid)
userid = Strip(userid)
s_yr = Strip(s_yr)
s_mo = Strip(s_mo)
i = joy.0 + 1
joy.i = Space(acctid userid s_yr s_mo s_data)
joy.0 = i
End
End
End
i = joy.0 + 1 /* make an end of file record */
joy.i = Copies('FF'x, 8) Copies('FF'x, 8) Copies('FF'x, 4) 'FFFF'x
joy.0 = i
combined. = ''
combined.0 = 0
i = 1
j = 1
Do While (i < ign.0) | (j < joy.0)
Parse Var ign.i i_acctid i_userid i_s_yr i_s_mo i_sess i_min
i_value = i_acctid || i_userid || i_s_yr || i_s_mo
Parse Var joy.j j_acctid j_userid j_s_yr j_s_mo j_sess j_min
j_value = j_acctid || j_userid || j_s_yr || j_s_mo
Select
When i_value = j_value Then
Do
t_sess = i_sess + j_sess
t_min = i_min + j_min
k = combined.0 + 1
combined.k = i_acctid i_userid i_s_yr i_s_mo t_sess t_min
combined.0 = k
i = i + 1
j = j + 1
End
When i_value < j_value Then
Do
k = combined.0 + 1
combined.k = i_acctid i_userid i_s_yr i_s_mo i_sess i_min
combined.0 = k
i = i + 1
End
When i_value > j_value Then
Do
k = combined.0 + 1
combined.k = j_acctid j_userid j_s_yr j_s_mo j_sess j_min
combined.0 = k
j = j + 1
End
Otherwise Nop
End
End
Trace 'n'
acct_user_save = ''
intro = what_r_we
If combine & \combineonly Then
Call Say_out ' '
Call Say_out intro
intro = 'Analysis of combined IGN and InJoy log files (' || Date() '@' Time() || ')'
Call Say_out ' ', intro
Do k = 1 To combined.0
If Abbrev(combined.k,'*') Then
Iterate
Parse Var combined.k acctid userid s_yr s_mo s_sess s_mins
acct_user = acctid userid
m_sess = Format(s_sess, sig_x) || 'X'
m_mins = Format(s_mins, sig_min, 2) 'mins'
mo_hh = Format(Trunc(s_mins / 60),sig_hr)
mo_mm = Right(Trunc(s_mins // 60),2,'0')
mo_ss = Right(Trunc(60 * ((s_mins // 60) - Trunc(s_mins // 60))),2,'0')
m_hhmmss = ' ' || mo_hh || ':' || mo_mm || ':' || mo_ss
m_hrs = Format((s_mins / 60), sig_hr, 2) 'hrs'
a_sess = s_mins / s_sess
If a_sess < 60 Then
a_sess = Format(a_sess,2,0) 'mins'
Else
a_sess = Format((a_sess / 60),2,2) 'hrs'
a_sess = '- Ave =' a_sess
monthline = s_yr month.s_mo m_sess m_hrs a_sess
If acct_user <> acct_user_save Then
Do
intro = 'MONTHLY TOTALS for Account(' || acctid || ') Userid(' || userid || '}'
Call Say_out ' ', intro
acct_user_save = acct_user
End
Call Say_out monthline
End
xrc = File_cmd(summary_file,'C')
finished = 'End of analysis of combined log files'
Call Say_out ' ', finished
Trace(save_trace)
Return /* from Combine_output */
Prepare_data:
/* Calculates and formats what is to be put into an output line */
/* Signons per day or month, as, e.g.: '4X' */
d_signons = Format(signons_each_day, sig_x)||'X'
m_signons = Format(signons_each_month, sig_x)||'X'
/* Minutes/day, minutes/month, hrs/day, hrs/month as, e.g.: '105.50 mins or hrs' */
d_mins = Format(daily_time_on, sig_min, 2) 'mins'
d_hrs = Format((daily_time_on/60), sig_hr, 2) 'hrs'
m_mins = Format(monthly_time_on, sig_min, 2) 'mins'
m_hrs = Format((monthly_time_on/60), sig_hr, 2) 'hrs'
/* minutes, seconds per day or month, as 2-digit numbers; hrs can exceed 2 digs */
dy_hh = Format(Trunc(daily_time_on/60),sig_hr)
dy_mm = Right(Trunc(daily_time_on//60),2,'0')
dy_ss = Right(Trunc(60*((daily_time_on//60) - Trunc(daily_time_on//60))),2,'0')
mo_hh = Format(Trunc(monthly_time_on/60),sig_hr)
mo_mm = Right(Trunc(monthly_time_on//60),2,'0')
mo_ss = Right(Trunc(60*((monthly_time_on//60) - Trunc(monthly_time_on//60))),2,'0')
/* hours, minutes, seconds per day or month, as, e.g.: '1:45:30'*/
d_hhmmss = ' '||dy_hh||':'||dy_mm||':'||dy_ss
m_hhmmss = ' '||mo_hh||':'||mo_mm||':'||mo_ss
Return /* Prepare_data */
Errdst: /* If error due to time change */
Say 'INETLOG has found a negative number for time-on-line'
Say 'in an entry in your' log_file 'file.'
Say ''
Say 'You may have reset your clock backwards while on line, e.g.,'
Say 'while changing from Summer time (Daylight Saving Time) to'
Say 'Winter time (Standard time).'
Say ''
Say 'To fix:'
Say ' 1. Open' log_file 'in your Tiny Editor (tedit.exe)'
Say ' 2. Edit any connection time(s) that have a minus sign.'
Say ' Example (for a typical one-hour summer-to-winter time correction):'
Say ''
Say ' change'
Say ' 1995/10/29 06:26:43 Disconnected after -00:-58:-4 0 errors 0 discards'
Say ' to'
Say ' 1995/10/29 06:26:43 Disconnected after 00:01:56 0 errors 0 discards'
Say ''
Say ' If the error was not from a summer-time change, make whatever'
Say ' correction seems reasonable to eliminate the offending minus'
Say ' signs (like just removing them).'
Say ''
Say ' 3. Save' log_file
Say ' 4. Run EOF2CRLF to remove the EOF characters'
Say ' added by the editor.'
Say 'Aborting . . .'
Call Cleanup
Return
Errhandler:
Call Beep 300, 500
Say 'Rexx error' rc 'in line' sigl||':' Errortext(rc)
Say Sourceline(sigl)
Call Cleanup
Return
Cleanup: /* Exit */
save_path = Directory(save_path)
Call PMRexxGo 'EXIT', obj_id
Return /* for Cleanup */
/* performs common Stream commands and returns 1 or a date if successful */
File_cmd: Procedure Expose result
trace_save = Trace('N')
Parse Arg file_name, command
command = Translate(command)
Select
When command = 'X' Then
Do
result = Stream(file_name, 'C', 'QUERY EXISTS')
answer = (result <> '')
End
When command = 'C' Then
Do
result = Stream(file_name, 'C', 'CLOSE')
answer = Abbrev(result,'READY') | (result = '')
End
When command = 'W' Then
Do
result = Stream(file_name, 'C', 'OPEN WRITE')
answer = Abbrev(result,'READY')
End
When command = 'R' Then
Do
result = Stream(file_name, 'C', 'OPEN READ')
answer = Abbrev(result,'READY')
End
When command = 'D' Then
Do
result = Stream(file_name, 'C', 'QUERY DATETIME')
If result <> '' Then
Do
Parse Var result date time
date = Dateconv(Translate(date, '/', '-'), 'U', 'S')
Parse Var time hr ':' min ':' sec
answer = Strip(date) || Strip(hr) || Strip(min) || Strip(sec)
End
Else
answer = '00000000000000'
End
Otherwise answer = 0
End
Trace(trace_save)
Return answer
Say_out: /* performs output to the console */
Procedure Expose quiet say_out_pipe
trace_save = Trace('N')
If quiet Then
Return
Parse Arg line1, line2, line3
If Length(line1) <> 0 Then
Call Lineout say_out_pipe, line1
If Length(line2) <> 0 Then
Call Lineout say_out_pipe, line2
If Length(line3) <> 0 Then
Call Lineout say_out_pipe, line3
Trace(trace_save)
Return
Say_message: /* performs message output and returns key entered */
Procedure Expose quiet
trace_save = Trace('N')
Parse Arg msg
Say msg
answer = SysGetKey('NOECHO')
Trace(trace_save)
Return answer
Summary_sample: Procedure Expose summary_sample.
trace_save = Trace('N')
summary_sample. = ''
x = 0
x = x + 1; summary_sample.x = '* The purpose of this file is to maintain monthly summaries across'
x = x + 1; summary_sample.x = '* pruning of the connection log'
x = x + 1; summary_sample.x = '*'
x = x + 1; summary_sample.x = '* The format of the file is:'
x = x + 1; summary_sample.x = '*'
x = x + 1; summary_sample.x = '* account userid * year month time-stamp sessions minutes'
x = x + 1; summary_sample.x = '* for example: usinet chmckin * 1995 01 T19950131235959 1 1.00'
x = x + 1; summary_sample.x = '* (the time-stamp is in the form'
x = x + 1; summary_sample.x = '* year || month || day || hour || minute || second'
x = x + 1; summary_sample.x = '* prefixed by a "T" to'
x = x + 1; summary_sample.x = '* force character compares)'
x = x + 1; summary_sample.x = '*'
x = x + 1; summary_sample.x = '* An "*" in column 1 indicates a comment. Comments and blank lines will'
x = x + 1; summary_sample.x = '* not be processed'
x = x + 1; summary_sample.x = '*'
x = x + 1; summary_sample.x = '* If your first run of INETLOG does not provide the monthly summaries that'
x = x + 1; summary_sample.x = '* you want, you may want to re-format monthly entries from the old'
x = x + 1; summary_sample.x = '* inetlog file, normally called inetlog.$$$, into this file. If the'
x = x + 1; summary_sample.x = '* month has ended set the time stamp to the highest possible timestamp'
x = x + 1; summary_sample.x = '* value for that month as shown below.'
x = x + 1; summary_sample.x = '*'
x = x + 1; summary_sample.x = '* 1995 Dec 15X 131.63 mins 2:11:37 2.19 hrs - Ave = 9 mins'
x = x + 1; summary_sample.x = '* unknown unknown * 1995 12 T19951231235959 15 131.63'
x = x + 1; summary_sample.x = '* 1996 Jan 178X 2341.83 mins 39:01:49 39.03 hrs - Ave = 13 mins'
x = x + 1; summary_sample.x = '* unknown unknown * 1996 01 T19960131235959 178 2342.83'
summary_sample.0 = x
Trace(trace_save)
Return
/* IJoyLog - InJoy log analyzer
╕ 1998 - 2000 by Charles H McKinnis, Sandia Park, NM (USA) 04 Feb 2000
mckinnis@attglobal.net
REXX Program to extract and totalize monthly time-ons by
analyzing the InJoy dialer log
*/
Ijoylog:
save_trace = Trace('N')
injoy_rc = Initialize_ijoylog()
If injoy_rc Then
injoy_rc = Analyze_ijoylog()/* gets, calculates, totalizes connect times.
Mostly a bunch of conditionals with a Call to a
data-formatting routine. All is stored in
variables for output all at once */
If injoy_rc Then
injoy_rc = Output_ijoylog()/* Outputs everything to console and to disk */
Return injoy_rc
Analyze_ijoylog:
trace_save = Trace('N')
/* Now find all lines in connect.log that contain the key_phrase
string. A typical line generated in the connect.log after
disconnect is:
DATE 21.02.1998, START 10:54:25, END 11:33:30, DURATION 39 min, 2345 sec
which we would parse as follows:
'DATE' date ',' . 'END' word2 ',' . 'min,' connect_time 'sec' */
/* this section will read through the connection log files
data and assign account information and userid to each
connection log record */
line. = ''
line.0 = 0
Do m = 1 To Words(injoy_logs)
log_file = Word(injoy_logs, m)
injoy_acct = Word(injoy_accts, m)
injoy_user = Word(injoy_users, m)
last_time.injoy_acct.injoy_user = Word(injoy_times, m)
lrc = SysFileSearch(key_phrase, log_file, 'temp.')
If lrc <> 0 | temp.0 < 1 Then
Iterate /* the log may have been cleared */
Do i = 1 To temp.0
j = line.0 + 1
line.j = Space(Injoyformat(temp.i) injoy_acct injoy_user)
line.0 = j
End
End
/* this is a great way to sort the entries */
/*
Call RxSort 'line.', 'A'
*/
Call SysStemSort 'line.', 'A'
Do i = 1 To line.0
Parse Var line.i time_stamp connect_time acctid userid .
acctid = Strip(acctid)
userid = Strip(userid)
connect_time = Strip(connect_time)
year = Substr(time_stamp, 2, 4)
t_yr = year
mm = Substr(time_stamp, 6, 2)
dd = Substr(time_stamp, 8, 2)
mins = connect_time % 60 /*... and mins */
secs = connect_time - (mins * 60) /*...and seconds */
/* Calculate time_on for that connection */
time_on = (mins + (1/60)*secs)
If time_stamp > last_time.acctid.userid Then
Call Monthly_update
If old_d = 0 Then
Do /* for very first connection line */
old_m = mm
old_d = dd
old_y = year
signons_each_day = 1 /* reset to 1 */
signons_each_month = 1
/* This and next one are timeons in minutes */
daily_time_on = time_on
monthly_time_on = time_on
End
Else /* continue to accumulate times if same month and day */
If old_m = mm & old_d = dd & month <> 0 Then
Do
old_y = year
signons_each_day = signons_each_day + 1
signons_each_month = signons_each_month + 1
daily_time_on = daily_time_on + time_on
monthly_time_on = monthly_time_on + time_on
End
Else /* new day of same month */
If old_m = mm & old_d <> dd Then
Do
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = year
year.mcounter = year
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
old_d = dd
old_y = year
signons_each_day = 1 /* Start counting over again */
signons_each_month = signons_each_month + 1
daily_time_on = time_on
monthly_time_on = monthly_time_on + time_on
End
Else /* for any new month, which by definition is also a new day */
If old_m <> mm & old_m <> 0 Then
Do
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = old_y
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
mcounter = mcounter + 1
year.mcounter = old_y
monthline.mcounter = year.mcounter month.old_m m_signons m_mins m_hhmmss m_hrs
old_m = mm
old_d = dd
old_y = year
signons_each_day = 1
signons_each_month = 1
daily_time_on = time_on
monthly_time_on = time_on
End
End /* end of all these If's and Else If's of searching for
key_phrase in all possible lines in the connect.log */
/* Now, since last day and last month is done: */
Call Prepare_data
dcounter = dcounter + 1
year.dcounter = year
dayline.dcounter = year.dcounter month.old_m old_d d_signons d_mins d_hhmmss d_hrs
mcounter = mcounter + 1
year.mcounter = year
monthline.mcounter = year.mcounter month.old_m m_signons m_mins m_hhmmss m_hrs
time_stamp = ''
Do m = 1 To Words(injoy_logs)
injoy_acct = Word(injoy_accts, m)
injoy_user = Word(injoy_users, m)
time_stamp = time_stamp last_time.injoy_acct.injoy_user
End
/* save the last */
injoy_times = Space(time_stamp)
Call SysIni inetcfg_ini, 'cfg_ijoylog', 'injoy_times' injoy_times
Trace (trace_save)
Return 1 /* from analyze_ijoylog */
Injoyformat: Procedure
Parse Arg line
Parse Var line 'DATE' date ',' . 'END' word2 ',' . 'min,' connect_time 'sec' .
date = Strip(date)
Parse Var date dd '.' mm '.' year
word2 = Strip(word2)
/* Extract for time stamp and save */
Parse Var word2 t_hr ':' t_min ':' t_sec
t_yr = year
time_stamp = 'T' || t_yr || mm || dd || t_hr || t_min || t_sec
connect_time = Strip(connect_time)
line = time_stamp connect_time
Return line
Output_ijoylog:
/* Now output everything to console and to file */
/* get the screen size; rows is what we are interested in */
Parse Value SysTextScreenSize() With rows cols
Call Stream stdin, 'C', 'OPEN READ'
/* Tell us all */
intro = what_r_we
Call Say_out ' ', intro
Call Lineout output_file, intro
Call Lineout output_file, crlf || 'Running with parms =' otherparms
intro = 'Analysis of InJoy log file(s)' injoy_logs '(' || Date() '@' Time() || ')'
Call Say_out ' ', intro
Call Lineout output_file, crlf || intro
If daily_report Then
Call Say_out ' ', 'Daily Totals', ' '
Call Lineout output_file, crlf || 'Daily Totals' || crlf
Do j = 1 To dcounter
If daily_report Then
Call Say_out dayline.j
Call Lineout output_file, dayline.j
End
j = 0
/* back up the summary file and delete it */
If Rx_fileexists(summary_file) Then
Do
Parse Var summary_file fname '.' ext
Address cmd '@COPY' summary_file fname || '.bak > NUL'
Call SysFileDelete summary_file
End
rc = File_cmd(summary_file,'W')
acct_user_save = ''
/*
Call RxSort 'monthly.', 'A' /* sort the summary data */
*/
Call SysStemSort 'monthly.', 'A'
Call Summary_sample /* get the header information */
/* insert the header info into the summary data */
Do k = summary_sample.0 To 1 By -1
/*
Call RxStemInsert 'monthly.', 1, summary_sample.k
*/
Call SysStemInsert 'monthly.', 1, summary_sample.k
End
Do k = 1 To monthly.0
If Abbrev(monthly.k,'*') Then
Do /* write comments back out */
Call Lineout summary_file, monthly.k
Iterate k
End
Parse Var monthly.k acctid userid s_yr s_mo
acct_user = acctid userid
Call Lineout summary_file, acctid userid '*' summary.acctid.userid.s_yr.s_mo
Parse Var summary.acctid.userid.s_yr.s_mo . . . s_sess s_mins
m_sess = Format(s_sess, sig_x) || 'X'
m_mins = Format(s_mins, sig_min, 2) 'mins'
mo_hh = Format(Trunc(s_mins / 60),sig_hr)
mo_mm = Right(Trunc(s_mins // 60),2,'0')
mo_ss = Right(Trunc(60 * ((s_mins // 60) - Trunc(s_mins // 60))),2,'0')
m_hhmmss = ' '||mo_hh||':'||mo_mm||':'||mo_ss
m_hrs = Format((s_mins / 60), sig_hr, 2) 'hrs'
a_sess = s_mins / s_sess
If a_sess < 60 Then
a_sess = Format(a_sess,2,0) 'mins'
Else
a_sess = Format((a_sess / 60),2,2) 'hrs'
a_sess = '- Ave =' a_sess
monthline = s_yr month.s_mo m_sess m_mins m_hhmmss m_hrs a_sess
If acct_user <> acct_user_save Then
Do
intro = 'Monthly Totals for Account(' || acctid || ') Userid(' || userid || '}'
Call Say_out ' ', intro, ' '
Call Lineout output_file, crlf || intro || crlf
acct_user_save = acct_user
End
Call Lineout output_file, monthline
monthline = s_yr month.s_mo m_sess m_hrs a_sess
Call Say_out monthline
End
rc = File_cmd(summary_file,'C')
finished = 'End of analysis of InJoy log file(s)'
Call Say_out ' ', finished
Call Lineout output_file, crlf || finished
Return 1 /* from output_ijoylog */
Initialize_ijoylog:
trace_save = Trace('N')
If Read_config() Then
Return 0
/* Get full paths for output file and summary file */
output_file = data_path || injoy_output_file
summary_file = data_path || injoy_summary_file
Call Set_monthly_summary
injoy_summary = summary_file
/* initialize variables */
crlf = D2c(13) || D2c(10) /* carriage return + linefeed */
esc = D2c(27) /* Escape character */
time_stamp = '' /* Time stamp of each connect record */
Do i = 1 To 12 /* initialize months */
x = Right(i,2,'0')
month.x = Word('Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec',i)
End
/* calculated variables
signons_each_day Accumulate number of connects daily
signons_each_month Accumulate number of connects monthly
time_on Time, each connect (minutes)
daily_time_on Accumulated minutes, daily
monthly_time_on Accumulated minutes, monthly */
/* More variables: these we initialize as follows: */
old_m = 0 /* Storage of a 2-digit month (eg 05 = May) */
old_d = 0 /* ... and a 2-digit day */
dcounter = 0 /* Counter increments each sign-on in a day */
mcounter = 0 /* Same for each sign-on in a month */
monthline. = '' /* Initialize both of these as null strings */
dayline. = '' /* These are for monthly and daily output strings */
/* A typical line generated in the default.log upon disconnect looks like
DATE 20.02.1998, START 16:22:32, END 16:22:33, DURATION 0 min, 1 sec
We search for a key_phrase using the RexxUtil function SysFileSearch */
key_phrase = 'DATE' /* Word or phrase we'll search for */
Do i = 1 To Words(injoy_logs)
If \Rx_fileexists(Word(injoy_logs, i)) Then
Do
Say 'Log file' Word(injoy_logs, i) 'does not exist.'
Say 'It may have been cleared and will be bypassed.'
End
/* make sure that we have control of the log file */
Else
Do
rc = File_cmd(Word(injoy_logs, i), 'W')
If \ rc Then
Do Until rc
Say 'Log file' Word(injoy_logs, i) 'returned' result
rc = File_cmd(Word(injoy_logs, i), 'C')
Say 'Unable to open' Word(injoy_logs, i)
Say 'Press Esc to abort run'
answer = Say_message('Press any other key to wait 5 seconds')
If answer = esc Then
Return 0
Call SysSleep 5
Call SysCls
rc = File_cmd(Word(injoy_logs, i), 'W')
End
End
rc = File_cmd(Word(injoy_logs, i), 'C')
End
/* Here is where we Check if the output file exists. If it does, we
overwrite it, and if not we create it. BUT.... we don't want to
do something stupid like try to erase a vital file or the connect
logfile... */
/* Backup any output file of the same name if it exists, then erase orig. */
If Rx_fileexists(output_file) Then
Do
Parse Var output_file fname '.' ext
Address cmd '@COPY' output_file fname||'.bak > NUL'
Call SysFileDelete output_file
End
Trace (trace_save)
Return 1 /* initialize_ijoylog */
Set_monthly_summary: /* set monthly summary */
monthly. = ''
monthly.0 = 0
summary. = ''
s_time = 'T00000000000000'
If Rx_fileexists(summary_file) Then
Do
Call Rx_readlines summary_file
Do i = 1 To file_lines.0
If \ Abbrev(file_lines.i,'*') & file_lines.i <> '' Then
Do
Parse Var file_lines.i acctid userid '*' s_yr s_mo s_time s_data
If s_yr = '' Then
Do
acctid = 'unknown'
userid = 'unknown'
Parse Var file_lines.i s_yr s_mo s_data
End
acctid = Strip(acctid)
userid = Strip(userid)
s_yr = Strip(s_yr)
s_mo = Strip(s_mo)
j = monthly.0 + 1
monthly.j = acctid userid s_yr s_mo
monthly.0 = j
summary.acctid.userid.s_yr.s_mo = s_yr s_mo s_time s_data
End
End
/*
Call RxSort 'monthly.0', 'A'
*/
Call SysStemSort 'monthly.', 'A'
End
Else
s_time = 'T00000000000000' /* reset timestamp to get updates */
Return /* Set_monthly_summary */
/*:VRX Rx_readlines
Usage: rx_readlines(input_file, <flag>)
Where: input_file = a fully qualified file to be read into an
exposed stem, "file_lines.", with 1 additional
stem entry if the file ended with an end-of-file
character ('1a'x) and the "-eof" flag is set
flag = "-e<of>" - read and preserve the eof flag ('1a'x)
Result: 1 - the file exists
0 - the file did not exist
*/
Rx_readlines: Procedure Expose file_lines. verbose log_out log_file
save_trace = Trace('N')
Parse Arg input_file, flag
If \Datatype(verbose, 'b') Then
verbose = 1
If \Datatype(log_out, 'b') Then
Do
xrc = SysFileTree(log_file, 'test.', 'fo')
If xrc = 0 & test.0 <> 0 Then
log_out = 1
Else
log_out = 0
End
flag = Translate(flag)
set_eof = (Pos('E', flag) <> 0)
If Stream(input_file, 'c', 'query exists') <> '' Then
Do
Call Stream input_file, 'c', 'open read'
If set_eof Then
Do
/* check for eof character */
file_size = Stream(input_file, 'c', 'query size')
If Charin(input_file, file_size, 1) = '1a'x Then
eof = 1
Else
eof = 0
Call Stream input_file, 'c', 'close'
End
Else
eof = 0
Call Stream input_file, 'c', 'open read'
file_lines. = ''
file_lines.0 = 0
Do i = 1 Until Lines(input_file) = 0
file_lines.i = Linein(input_file)
End
file_lines.0 = i
If eof Then
Do
i = file_lines.0 + 1
file_lines.i = '1a'x
file_lines.0 = i
End
Call Stream input_file, 'c', 'close'
xrc = 1
End
Else
xrc = 0
Trace(save_trace)
Return xrc
/*:VRX rx_fileexists
Usage: rx_fileexists(file_name)
Where: file_name = name of file or path to be tested
Result: 1 if file or path exists, 0 otherwise
*/
Rx_fileexists: Procedure Expose verbose log_out log_file
save_trace = Trace('N')
Parse Arg file_name
If \Datatype(verbose, 'b') Then
verbose = 1
If \Datatype(log_out, 'b') Then
Do
xrc = SysFileTree(log_file, 'test.', 'fo')
If xrc = 0 & test.0 <> 0 Then
log_out = 1
Else
log_out = 0
End
xrc = SysFileTree(file_name, 'test.', 'fo')
If xrc = 0 & test.0 <> 0 Then
exists = 1
Else
Do
/* may be a directory */
xrc = SysFileTree(file_name, 'test.', 'do')
If xrc = 0 & test.0 <> 0 Then
exists = 1
Else
exists = 0
End
Trace(save_trace)
Return exists
/*:VRX Dateconv
*/
/*----------------------------------------------------------------------------+
| DATECONV FUNCTION |
+-----------------------------------------------------------------------------+
| This code is a REXX internal function; add it to your REXX programs. |
| See DATECONV PACKAGE and DATECONV HELPCMS for more information. |
+-----------------------------------------------------------------------------+
| Labels used within DATECONV Procedure are: |
| Dateconv: <--- entry point |
| Dateconv_yy2cc: <--- 2 digit to 4 digit year conversion
| Dateconv_b2s_s2b: <--- Basedate/Sorted format conversion |
+-----------------------------------------------------------------------------+
| YYMMDD Change history:
| 900803 rlb v1.0 new code. Russel L. Brooks BROOKS/SJFEVMX
| 900808 rlb v2.0 new, better, faster. doesn't use old BASEDATE code.
| 900821 rlb v3.0 add Arg(4) "Yx" to control assumed leading year digits.
| add format_out "L" for leap year.
| 910220 rlb v4.0 add Arg(5) Offset output date +/- days.
| Turn Trace Off at both labels. Set ERROR in Month Select.
| 910226 rlb v4.1 move TRACE past PROCEDURE for compiler.
| 910418 rlb v4.2 add ISO date format yyyy-mm-dd.
| allow input date to default to TODAY.
| convert all uses of EBCDIC Not sign "¬" to "<>".
| change input date parsing to allow leading blanks.
| if offset amount is 0 turn offset off.
| 910916 rlb v5.0 generate all formats but select what is requested.
| reduce overchecking, drop numerics 15 in b2s2b routine.
| allow muliple format request.
| 930414 rlb v5.1 bugfix: don't allow yyyymm00 as a valid Date(S) date.
| 940831 rlb v6.0 bugfix: better detection of invalid Date(J|U) dates.
| combine Date(E|O|U) code. remove unneeded code.
| Signal on NoValue (but _we_ don't have 'novalue' label).
| only develop DOW, Month, Leapyear if asked for.
| test numbers w/ verify(integer) instead of datatype(W).
| 950113 rlb v6.1 parse out days/month for very small speed increase.
| 980629 rlb v7.0 changed internal variable 'yx' to 'cc' (century).
| if Fi=U/E/O/J & cc = '' then 100 year sliding window.
|
+----------------------------------------------------------------------------*/
Dateconv:
Procedure
Trace o
Signal On Novalue /* force error detection */
Parse Upper Arg date date_xtra, fi xtra1, fo xtra2, cc xtra3, offset
Select
When xtra1 <> '' Then
out = 'ERROR'
When xtra2 <> '' Then
out = 'ERROR'
When xtra3 <> '' Then
out = 'ERROR'
When Arg() > 5 Then
out = 'ERROR'
Otherwise /* initialize */
Parse Value fi With 1 fi 2 . sdate bdate out . /* 1 ltr + nuls */
today = Date('S') Date('B')
End
/*----------------------------------------------------------------------+
| Input date formats U/E/O/J only use 2 digit years. If CC is null then
| we'll calculate an appropriate century using a 100 year sliding window
| similar to what Rexx's Date() uses.
|
| Date format "C" is different. Event though it doesn't specify a
| century we won't try to calculate one based on a sliding window.
| The user can specify an alternate century via Arg(4) "CC".
+----------------------------------------------------------------------*/
If cc <> '' Then /* check user value */
Select
When Verify(cc,'0123456789') > 0 Then
out = 'ERROR' /* <>Num */
When Length(cc) <> 2 Then
out = 'ERROR'
When cc < 0 Then
out = 'ERROR'
Otherwise Nop /* user's CC looks ok */
End
/*----------------------------------------------------------------------+
| If no leading +/- sign then treat as +. User could use + but if not
| included in quotes then REXX strips off the + sign.
+----------------------------------------------------------------------*/
Parse Value Space(offset,0) With 1 offset_sign 2 offset_amnt . 1 offset .
If offset = '' Then
offset = 0
Else
Do
If offset_sign = '+' | offset_sign = '-' Then
Nop
Else
Do
offset_sign = '+' /* missing so default to '+' */
offset_amnt = offset /* use entire user field as amount */
End
If Verify(offset_amnt,'0123456789') >0 Then
out = 'ERROR' /* <>Num */
If offset_amnt = 0 Then
offset = 0 /* no offset request */
Else
offset = 1 /* yes, return date needs shifting */
End
/*----------------------------------------------------------------------+
| Examine date according to "fi" (format in) caller passed. If ok then
| convert date to either "B"asedate, "S"orted, or both formats.
|
| Dates are converted because it is easy to create "fo" (format out)
| dates from one or the other of these input formats. This also limits
| having to directly support every possible "fi" to "fo" combination.
+----------------------------------------------------------------------*/
Select
When out <> '' Then
Nop /* Error already detected */
When fi = '' Then /* today */
Do
/*----------------------------------------------------------------+
| special case. allow input date and input format to default to
| TODAY. This bypasses input date validation because we can rely
| on REXX to supply valid dates.
+----------------------------------------------------------------*/
If date = '' Then
Parse Value today With sdate bdate .
Else
out = 'ERROR' /* missing FormatIN for date */
End
When fi = 'N' Then /* Normal dd Mmm yyyy */
Do/* Test for N early because its only one that uses 'date_xtra' */
Parse Value date date_xtra With dd mm yy date_xtra
If date_xtra <> '' Then
out = 'ERROR' /* too many parms */
Else
Do
mm = Wordpos(mm,'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC')
If mm = 0 Then
out = 'ERROR' /* invalid 3 letter month */
Else
sdate = yy || Right(mm,2,0)Right(dd,2,0)
End
End
When date_xtra <> '' Then
out = 'ERROR' /* too many parms */
When fi = 'B' Then
bdate = date /* Basedate dddddd */
When fi = 'S' Then
sdate = date /* Sorted yyyymmdd */
When fi = 'D' Then /* Days ddd */
Select
When Verify(date,'0123456789') > 0 Then
out = 'ERROR' /* <>Num */
Otherwise
yyyy = Left(today,4)
dd = Dateconv_b2s_s2b(yyyy'0101','S') /* Jan 1st */
temp = Dateconv_b2s_s2b(yyyy+1'0101','S')/* Jan 1st next year */
If date < 1 | date > temp-dd Then
out = 'ERROR' /* max 365|366 */
Else
bdate = dd + date - 1
End
When fi = 'C' Then /* Century ddddd */
Select
When Verify(date,'0123456789') > 0 Then
out = 'ERROR' /* <>Num */
Otherwise
If cc = '' Then
cc = Left(today,2)
dd = Dateconv_b2s_s2b(cc'000101','S') /* this century */
temp = Dateconv_b2s_s2b(cc+1'000101','S') /* next century */
If date<1 | date>temp-dd Then
out = 'ERROR' /* max 36524|36525 */
Else
bdate = dd + date - 1
End
When fi = 'J' Then /* Julian yyddd */
Select
When Length(date) <> 5 Then
out = 'ERROR'
When Verify(date,'0123456789') > 0 Then
out = 'ERROR' /* <>Num */
Otherwise
Parse Value date With 1 yy 3 ddd .
If cc = '' Then
cc = Dateconv_yy2cc(yy)
yyyy = cc || yy
dd = Dateconv_b2s_s2b(yyyy'0101','S') /* Jan 1st */
temp = Dateconv_b2s_s2b(yyyy+1'0101','S') /* Jan 1st next yy */
If ddd < 1 | ddd > temp-dd Then
out = 'ERROR' /* max 365|366 */
Else
bdate = dd + ddd - 1
End
Otherwise /* USA|European|Ordered|ISO ...or invalid */
Select
When fi = 'U' Then
Parse Value date With mm'/'dd'/'yy .
When fi = 'E' Then
Parse Value date With dd'/'mm'/'yy .
When fi = 'O' Then
Parse Value date With yy'/'mm'/'dd .
When fi = 'I' Then
Parse Value date With 1 cc 3 yy'-'mm'-'dd .
Otherwise out = 'ERROR' /* invalid Format_In */
End
Select
When out <> '' Then
Nop
When Verify(Space(cc yy mm dd,0),'0123456789') > 0 Then
out = 'ERROR'
When Length(yy) <> 2 Then
out = 'ERROR'
When Length(mm) > 2 Then
out = 'ERROR'
When Length(dd) > 2 Then
out = 'ERROR'
Otherwise
If cc = '' Then
cc = Dateconv_yy2cc(yy)
sdate = cc || Right(yy,2,0)Right(mm,2,0)Right(dd,2,0)
End
End
/*----------------------------------------------------------------------+
| If the output date is being shifted by an offset then...
| 1- get the basedate if it doesn't already exist
| 2- offset the basedate by the amount requested
| 3- scratch sorted date because it doesn't match offset basedate
+----------------------------------------------------------------------*/
If offset & out = '' Then
Do
If bdate = '' Then
Do
bdate = Dateconv_b2s_s2b(sdate,'S')
If bdate = '' Then
out = 'ERROR'
End
If out = '' Then /* no Error */
Do
If offset_sign = '+' Then
bdate = bdate + offset_amnt
Else
bdate = bdate - offset_amnt
End
sdate = '' /* date shifted, if sdate existed it is now invalid */
End
/*----------------------------------------------------------------------+
| we have Basedate or Sorted, generate the other if we don't have both.
+----------------------------------------------------------------------*/
Select
When out <> '' Then
Nop /* error */
When bdate = '' Then
Do
bdate = Dateconv_b2s_s2b(sdate,'S')
If bdate = '' Then
out = 'ERROR'
End
When sdate = '' Then
Do
sdate = Dateconv_b2s_s2b(bdate,'B')
If sdate = '' Then
out = 'ERROR'
End
Otherwise Nop/* both Bdate and Sdate already exist (and no errors) */
End
Parse Value sdate With 1 yyyy 5 . 1 cc 3 yy 5 mm 7 dd .
Parse Value '' With ddd ddddd month . /* (re)initialize to null */
/*----------------------------------------------------------------------+
| "fo" Format_Out defaults to "Normal" out.
| "*" means return multiple formats, ALL if just "*" or the set of dates
| specified by the letters following "*".
+----------------------------------------------------------------------*/
Parse Value fo With 1 fo_string 2 temp
Select
When fo_string = '' Then
fo_string = 'N' /* default: "Normal" format */
When fo_string <> '*' Then
Nop /* use single letter in 'fo_string' */
Otherwise
If temp = '' Then
fo_string = 'NBSMWDJCOEULI' /* all formats */
Else
fo_string = temp /* multiple formats selected by caller */
End
If out = '' Then /* if no Error yet */
Do While fo_string <> ''
Parse Value fo_string With 1 fo 2 fo_string
Select
When fo = 'B' Then
out = out bdate /* Basedate */
When fo = 'S' Then
out = out sdate /* Sorted */
When fo = 'M' | fo = 'N' Then
Do
If month = '' Then
Do
temp = 'January February March April May June July'
temp = temp 'August September October November December'
month = Word(temp,mm)
If month = '' Then
Do
out = 'ERROR'
Leave
End
End
If fo = 'M' Then
out = out month /* Month */
Else
out = out dd+0 Left(month,3) yyyy /* Normal */
End
When fo = 'W' Then /* Weekday */
Do
temp = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday'
out = out Word(temp,(bdate//7)+1)
End
When fo = 'D' | fo = 'J' Then
Do
If ddd = '' Then
Do
ddd = Dateconv_b2s_s2b(yyyy'0101','S')
If ddd = '' Then
Do
out = 'ERROR'
Leave
End
Else
ddd = bdate - ddd + 1
End
If fo = 'D' Then
out = out ddd /* Days */
Else
out = out yy || Right(ddd,3,0) /* Julian */
End
When fo = 'C' Then /* Century */
Do
ddddd = Dateconv_b2s_s2b(cc'000101','S')
If ddddd = '' Then
Do
out = 'ERROR'
Leave
End
Else
ddddd = bdate - ddddd + 1
out = out ddddd
End
When fo = 'L' Then /* Leapyear */
Do
Select
When yyyy // 4 > 0 Then
leap_year = 0
When yyyy // 100 > 0 Then
leap_year = 1
When yyyy // 400 = 0 Then
leap_year = 1
Otherwise leap_year = 0
End
out = out leap_year
End
When fo = 'E' Then
out = out dd'/'mm'/'yy /* European */
When fo = 'O' Then
out = out yy'/'mm'/'dd /* Ordered */
When fo = 'U' Then
out = out mm'/'dd'/'yy /* USA */
When fo = 'I' Then
out = out yyyy'-'mm'-'dd /* ISO */
Otherwise
out = 'ERROR' /* Format_Out not recognized */
Leave
End
End
If out = 'ERROR' Then
out = '' /* null return indicates function error */
Return Strip(out,'L') /* <--- Dateconv Function exits here */
/*----------------------------------------------------------------------+
| Calculate a suitable Century for a 2 digit year using a sliding window
| similar to Rexx's Date() function.
|
| (current_year - 50) = low end of window
| (current_year + 49) = high end of window
+----------------------------------------------------------------------*/
Dateconv_yy2cc:
temp = Left(today,4) + 49
If (Left(temp,2)||Arg(1)) <= temp Then
Return Left(temp,2)
Else
Return Left(temp,2) - 1
/*----------------------------------------------------------------------+
| Convert Date(B) <--> Date(S)
|
| Arg(1) : Date(B) or Date(S) date to be converted to other format.
|
| Arg(2) : "B" or "S" to identify Arg(1)
|
| Return : the converted date or "" (null) if an error detected.
+----------------------------------------------------------------------*/
Dateconv_b2s_s2b:
Procedure
Trace o
Signal On Novalue /* force error detection */
Arg dd . /* Total days or sorted date, don't know which (yet) */
If Verify(dd,'0123456789') > 0 Then
Return '' /* <>Num */
/* Initialize Days per month stem */
temp = 0 31 28 31 30 31 30 31 31 30 31 30 31
Parse Value temp With d. d.1 d.2 d.3 d.4 d.5 d.6 d.7 d.8 d.9 d.10 d.11 d.12 .
Select
When Arg(2) = 'B' Then /* Convert Date(B) to Date(S) */
Do
dd = dd + 1 /* Date(S) = Date(B)+1 */
yyyy = dd % 146097 * 400 /* 400 year groups */
dd = dd // 146097 /* all 400 year groups are similar */
temp = dd % 36524 /* 100 year groups */
dd = dd // 36524
If temp = 4 Then
Do
temp = 3/* back up 1, 4th 100 year group not same as 1st 3 */
dd = dd + 36524
End
yyyy = temp * 100 + yyyy
temp = dd % 1461 /* 4 year groups */
dd = dd // 1461
If temp = 25 Then
Do
temp = 24/* back up 1, 25th 4 year group not same as 1st 24 */
dd = dd + 1461
End
yyyy = temp * 4 + yyyy
yyyy = dd % 365.25 + yyyy /* 1 year groups */
dd = dd - ((dd % 365.25) * 365.25) % 1
If dd = 0 Then
Parse Value 12 31 With mm dd . /* Dec 31st */
Else
Do
yyyy = yyyy + 1 /* partial year = mm/dd */
Select
When yyyy // 4 > 0 Then
Nop
When yyyy // 100 > 0 Then
d.2 = 29 /* Leap Year */
When yyyy // 400 = 0 Then
d.2 = 29 /* Leap Year */
Otherwise Nop
End
Do mm = 1 While dd > d.mm /* count months */
dd = dd - d.mm /* while subtracting days */
End
End
Return Right(yyyy,4,0)Right(mm,2,0)Right(dd,2,0)/* Date(Sorted) */
End
When Arg(2) = 'S' Then /* Convert Date(S) to Date(B) */
Do
If Length(dd) <> 8 Then
Return ''
Parse Value dd With 1 yyyy 5 mm 7 dd .
Select
When yyyy // 4 > 0 Then
Nop
When yyyy // 100 > 0 Then
d.2 = 29 /* Leap Year */
When yyyy // 400 = 0 Then
d.2 = 29 /* Leap Year */
Otherwise Nop
End
mm = mm + 0 /* strip leading 0s */
If d.mm = 0 Then
Return '' /* bad month */
If dd = 0 | dd > d.mm Then
Return '' /* bad days */
/* What was the Basedate December 31st of the "PREVIOUS" year? */
yyyy = yyyy - 1 /* previous year */
If yyyy = 0 Then
days = 0 /* there was no previous year */
Else
days = yyyy * 365 + (yyyy % 4) - (yyyy % 100) + (yyyy % 400)
/* What 'nth' day of this year is mm/dd? */
Do i = 1 To (mm-1)
days = days + d.i /* add days of completed months */
End
Return days + dd - 1 /* Date(Basedate) = Date(S)-1 */
End
Otherwise Return '' /* Error: Arg(2) not "B" or "S" */
End
/*----------------------------------------------------------------------------+
| End of DATECONV FUNCTION code. |
+----------------------------------------------------------------------------*/
/*:VRX PMRexxGo
*/
/* setup to run under PMREXX */
Pmrexxgo: Procedure Expose quiet say_out_pipe
save_trace = Trace('N')
Parse Arg action, obj_id, our_prog, title, our_parms
obj_id = '<' || obj_id || '>'
If action = 'START' Then
Do
our_dir = Left(our_prog, Lastpos('\', our_prog) - 1)
pmrexx_name = SysSearchPath('PATH', 'PMREXX.EXE')
If pmrexx_name <> '' Then
Do
class = 'WPProgram'
location = '<WP_DESKTOP>'
obj = 'OBJECTID=' || obj_id || ';'
exec = 'EXENAME=' || pmrexx_name || ';'
parm = 'PARAMETERS=' || our_prog our_parms '| X' || ';'
startdir = 'STARTUPDIR=' || our_dir || ';'
window = 'MAXIMIZED=NO;MINIMIZED=NO;NOAUTOCLOSE=NO;'
setup = obj || exec || parm || startdir || window
rc = SysCreateObject(class, title, location, setup, 'R')
If rc Then
Do
rc = SysSetObjectData(obj_id, 'OPEN=DEFAULT;CCVIEW=NO;')
If rc Then
Call Say_out 'Started' title 'under PMRexx'
Else
Call Say_out 'Unable to start' title 'under PMRexx'
Exit
End
Else
Call Say_out 'Unable to create object' title
End
End
Else
Do
Call Say_out 'Press enter to terminate this program'
Parse Upper Pull .
Call SysDestroyObject obj_id
Call SysSleep 2
End
Trace(save_trace)
Return
