/*
** AreaStat.ems by Adam Sjøgren 1993
**
** and improved by Bernd Ernesti (Version 1.2a) (14-Aug-93)
**
** Inspired by AreaStat.spot by Brian Jacobsen.
**
** Set up i config/Externals like this:
**
**   Title="Area statistics" Command="AreaStat.ems %s %a" ScreenPos=DoNothing
**
*/
/***************************************/
/* $VER: AreaStat.ems 1.2a (27.08.93)  */
/***************************************/

script_version = 'v1.2a'


options results
signal on error
signal on syntax

parse arg session_number current_area .

/* Variables: */
fromlist. = 0
tolist.   = 0
subjlist. = 0
names.    = 0

/* Make sure EMS is listening: */
if( ~show( 'l', "ems_rexx.library" ) ) then
do
   if( ~addlib( "ems_rexx.library", 0, -30, 0 ) ) then
   do
      say "Could not open ems_rexx.library"
      exit 10
   end
end


/* Here comes the main program: */

if session_number ~= '' then
do

   res.0 = 2
   res.1 = 'Current Area'
   res.2 = 'Choose from list'
   sel   = 1
   ok    = EMS_Do_Choice_Single( 'Process which area?', 'res', 'sel' ); if ok = 'CANCEL' then signal ScriptEnd

end
else
do

   sel = 2

end

if sel = 1 then
do

   msgarea = current_area

end
else
do

   ok = EMS_Area_Select( 'msgarea' ); if ok = 'CANCEL' then signal ScriptEnd

end

call EMS_Area_Item_List( msgarea, 'MSG', 'itemlist' )

if itemlist.0 = 0 then
do

   call EMS_Do_Request( 'The area is empty.', 'I knew that!' )
   signal ScriptEnd

end

StartMsg = 1
EndMsg   = itemlist.0

/* A full Messagebase, or just the last month? */
res.0 = 4
res.1 = 'Full Messagebase'
res.2 = 'By the Real-Message-Number'
res.3 = 'By month and year'
res.4 = 'By the year'
sel   = 1
ok    = EMS_Do_Choice_Single( 'How long search for ?', 'res', 'sel' ); if ok = 'CANCEL' then signal ScriptEnd

smb   = 1
month = ''
year  = ''

if sel = 1 then month='#?'

if sel = 2 then
do

   ok  = EMS_String_Select( 'Start Msg-Number ?', 'StartMsg' ); if StartMsg > itemlist.0 | StartMsg < 1        then signal ScriptEnd
   ok  = EMS_String_Select( 'End Msg-Number ?'  , 'EndMsg'   ); if EndMsg   > itemlist.0 | EndMsg   < StartMsg then signal ScriptEnd
   smb = 2

end

if sel = 3 then
do

   ok = EMS_String_Select( 'Which Month (3 chars, e.g. JAN) ?', 'month' )

   month = left( compress( upper( month ) ), 3 )

   test = pos( month, 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC' )

   if test ~= 0 & (test=1 | (test - 1)//3 = 0) then smb   = 3
                                               else month = '#?'
end

if sel = 3 | sel = 4 then
do

   ok = EMS_String_Select( 'Which Year ?', 'year' )

   year = COMPRESS( year ); if year = '' | length( Year ) < 2 | DATATYPE( year ) ~= 'NUM' then
   do

      month = '#?'
      year  = '#?'
      smb   = 1

   end
   else
   do

      year = right( year, 2 )

      if smb ~= 3 then
      do
         smb   = 4
         month = ''
      end

   end

end

/* A full stat's file, or just the first 10? */
res.0 = 2
res.1 = 'Top 10 only'
res.2 = 'Full statistics'
sel   = 1
ok    = EMS_Do_Choice_Single( 'What kind of statistics?', 'res', 'sel' ); if ok = 'CANCEL' then signal ScriptEnd

if sel = 1 then
do

   toptext = 'Top Ten'
   top     = 1

end
else
do

   toptext = 'All'
   top     = 0

end

/* How do you want the output? */
output_area = ''
output_file = ''
res.1 = 'Send as a message'
res.2 = 'To a file'
sel   = 1
ok    = EMS_Do_Choice_Single( 'Where do you want the chart?', 'res', 'sel' ); if ok = 'CANCEL' then signal ScriptEnd

if sel=1 then
do

   res.1 = 'Current Area'
   res.2 = 'Choose from list'
   sel2  = 1
   ok    = EMS_Do_Choice_Single( 'Post in what area?', 'res', 'sel2' ); if ok = 'CANCEL' then signal ScriptEnd

   if sel2 = 1 then
   do

      output_area = current_area

   end
   else
   do

      ok = EMS_Area_Select( 'output_area' ); if ok='CANCEL' then signal ScriptEnd

   end

end
else
do

   output_file = ''
   ok          = EMS_File_Select( 'Filename for chart:', 'output_file' )

end

TotalMsg = 0
do i = StartMsg to EndMsg

   date = EMS_Area_Item_Header_Date_Created( msgarea, 'MSG', itemlist.i )
   to   = EMS_Area_Item_Header_To(           msgarea, 'MSG', itemlist.i )
   from = EMS_Area_Item_Header_From(         msgarea, 'MSG', itemlist.i )
   subj = EMS_Area_Item_Header_Subject(      msgarea, 'MSG', itemlist.i ); subj = upper( strip( subj ) )

   if i = StartMsg then StartMsgDate = date
   if i = EndMsg   then EndMsgDate   = date

   test = pos( month || year, compress( upper( date ) ) )

   if test = 0 & smb > 2 then iterate
   if smb  = 4 & (test ~= 9 & test ~= 6) then iterate

   if left( subj, 4 ) = 'RE: ' then subj = substr( subj, 5 )

   call EMS_Add_To_Stem( 'names', to  , 'UNIQUE' )
   call EMS_Add_To_Stem( 'names', from, 'UNIQUE' )
   call EMS_Add_To_Stem( 'subjs', subj, 'UNIQUE' )

   tolist.to     = tolist.to     + 1
   fromlist.from = fromlist.from + 1
   subjlist.subj = subjlist.subj + 1
   TotalMsg      = TotalMsg      + 1

end

if TotalMsg = 0 then
do

   say 'No messages found !'
   signal ScriptEnd

end

/* Make the TO: stem ready */
do i = 1 to TotalMsg

   name = names.i

   if tolist.name > 0 then
   do

      percent   = tolist.name * 100 / TotalMsg
      remainder = percent // 1
      percent   = percent  % 1

      if remainder > 0.5 then percent = percent + 1

      out_1 =            copies( ' ', (length( names.0 ) + 1) - length( tolist.name ) ) || tolist.name
      out_2 = 'msgs(' || copies( ' ',                      2  - length( percent     ) ) || percent || '%) to' names.i


      call EMS_Add_To_Stem( 'to_out', out_1 out_2 )

   end

end

call EMS_Sort_Stem( 'to_out' )


/* The FROM: stem: */
do i = 1 to TotalMsg

   name = names.i

   if fromlist.name > 0 then
   do

      percent   = fromlist.name * 100 / TotalMsg
      remainder = percent // 1
      percent   = percent  % 1

      if remainder > 0.5 then percent = percent + 1

      out_1 =            copies( ' ', (length( names.0 ) + 1) - length( fromlist.name ) ) || fromlist.name
      out_2 = 'msgs(' || copies( ' ',                      2  - length( percent     ) ) || percent || '%) from' names.i


      call EMS_Add_To_Stem( 'from_out', out_1 out_2 )

   end

end

call EMS_Sort_Stem( 'from_out' )


/* The SUBJ: stem: */
do i = 1 to TotalMsg

   subj = subjs.i

   if subjlist.subj > 0 then
   do

      percent   = subjlist.subj * 100 / TotalMsg
      remainder = percent // 1
      percent   = percent  % 1

      if remainder > 0.5 then percent = percent + 1

      out_1 =              copies( ' ', (length( subjs.0 ) + 1) - length( subjlist.subj ) ) || subjlist.subj
      out_2 = 'topics(' || copies( ' ',                      2  - length( percent     ) ) || percent || '%) :' subjs.i

      call EMS_Add_To_Stem( 'subj_out', out_1 out_2 )

   end

end

call EMS_Sort_Stem( 'subj_out' )


/* Do the output: */
temp_file = 't:areastat.ems.' || session_number
mline = '----------------------------------------------------------------------------'

call open( 'temp', temp_file, 'W' )

call writeln( 'temp', ''                            )
call writeln( 'temp', 'Area-Statistics for' msgarea )

if smb = 1 then call writeln( 'temp', 'Full Messagebase with' TotalMsg 'messages')
if smb = 2 then call writeln( 'temp', 'Msg #' || StartMsg '(' || StartMsgDate || ')' '-' '#' || EndMsg '(' || EndMsgDate || ')' 'with' TotalMsg 'msgs')
if smb > 2 then
do

   if smb = 3 then part = 'Month' month
              else part = 'Year'

   if year > 77 then part = part '19' || year
                else part = part '20' || year

   call writeln( 'temp', 'Messagebase from' part 'with' TotalMsg 'messages' )

end

call writeln( 'temp', 'Statistics generated on  :' DATE() 'at' TIME() )
call writeln( 'temp', 'Active users in this area:' names.0            )
call writeln( 'temp', mline                                           )
call writeln( 'temp', ''                                              )

if top = 1 then
do

   low_f = (from_out.0) - 10; j_f = 10
   low_t = (  to_out.0) - 10; j_t = 10
   low_s = (subj_out.0) - 10; j_s = 10

end
else
do

   low_f = 0; j_f   = from_out.0
   low_t = 0; j_t   =   to_out.0
   low_s = 0; j_s   = subj_out.0

end

j = 0
call writeln( 'temp', toptext 'Submitters:' )
call writeln( 'temp', mline                 )

do i = from_out.0 to 1 by -1

   if i <= low_f then leave

   j = j + 1

   call writeln( 'temp', copies( ' ', length( j_f ) - length( j ) ) || j || '. ' || from_out.i )
end

call writeln( 'temp', '' )


j = 0
call writeln( 'temp', toptext 'Recipiants:' )
call writeln( 'temp', mline                 )

do i = to_out.0 to 1 by -1

   if i <= low_t then leave

   j = j + 1

   call writeln( 'temp', copies( ' ', length( j_t ) - length( j ) ) || j || '. ' || to_out.i )

end

call writeln( 'temp', '' )


j = 0
call writeln( 'temp', toptext 'Topics:' )
call writeln( 'temp', mline             )
do i = subj_out.0 to 1 by -1

   if i <= low_s then leave

   j = j + 1
   call writeln( 'temp', copies( ' ', length( j_s ) - length( j ) ) || j || '. ' || subj_out.i )

end

call writeln( 'temp', '' )


call close( 'temp' )

if output_file ~= '' then address command 'copy' temp_file output_file

if output_area ~= '' then
do

   area_addr = EMS_Area_Address( output_area )

   call EMS_Item_Alloc(               'newmsg', output_area, 'MSG'       )
   call EMS_Item_Header_From(         'newmsg', 'Statistics Generator'   )
   call EMS_Item_Header_To(           'newmsg', 'All'                    )
   call EMS_Item_Header_Subject(      'newmsg', 'Stats for area' msgarea )
   call EMS_Item_Header_Address_From( 'newmsg', area_addr                )
   call EMS_Item_Header_Address_To(   'newmsg', area_addr                )

   call EMS_Item_Line_Unique(        'newmsg', 'HEADER', '--- '       , '--- EMS AreaStat' script_version                                    )
   call EMS_Item_Line_Unique(        'newmsg', 'HEADER', ' * Origin: ', ' * Origin: > EMS Area Statistics Generator < (' || area_addr || ')' )

   if exists( temp_file ) then call EMS_Item_File_Read( 'newmsg', 'text', temp_file )

   call EMS_Item_Write( 'newmsg' )
   call EMS_Item_Free(  'newmsg' )

end

address command 'Delete >NIL:' temp_file

/*
 * Tell EMS that we're finished playing:
 */
ScriptEnd:

call EMS_FreeScriptData()
exit 0

/*
 * Oh no! lAmEr, dEwD!
 */
error:
syntax:

error_text = EMS_LastError()

if error_text = '' then error_text = rc ErrorText( rc )

say '| ***BREAK: error at' sigl error_text

call EMS_FreeScriptData()
exit rc