/**/
v='$VER: XQManager Rexx XferQ Queue Manager  Williamson 0.11'
sv=strip(right(v,5))
if ~show("L", "rexxsupport.library") then
  if ~addlib("rexxsupport.library", 0, -30, 2) then do
    say "Couldn't access rexxsupport.library !"
    exit 20
  end
if show("L", "amigaguide.library") then call remlib("amigaguide.library")
if show("L", "datatypes.library") then call remlib("datatypes.library")
if show("L", "locale.library") then call remlib("locale.library")
if ~show("L", "xferq.library") then
  if ~addlib("xferq.library", 0, -30, 0) then do
    say "Couldn't access xferq.library !"
    exit 20
  end
if ~show("L", "rexxdossupport.library") then
  if ~addlib("rexxdossupport.library", 0, -30, 2) then do
    say "Couldn't access rexxdossupport.library !"
    exit 20
  end
if ~show("L", "rexxreqtools.library") then
  if ~addlib("rexxreqtools.library", 0, -30, 2) then do
    say "Couldn't access rexxreqtools.library !"
    exit 20
  end
LF='0a'x

debug=GetVar('XQM','G')=='DEBUG'
address COMMAND 'AVAIL >NIL: FLUSH'
hopen=0
LF='0a'x;CLS='0c'x
CSI='1b'x||'[';AOFF=CSI||'0m';BOLD=CSI||'1m';ITALICS=CSI||'3;40m'
hspec='RAW:40/180/400/100/XQManager Help/NOCLOSE/NOSIZE'
if debug then do
bol.0="FALSE"
bol.1="TRUE"
end

host=GetVar('XFERQ:hostaddr','G')

show_sites:
sitelist=XfqGetSiteList()
call XfqWalkSession(sitelist,sites)
/* Build Systems List */
systems.0=sites.numentries
do loop=1 to sites.numentries
  MaxPri=XfqMaxSitePri(sites.loop)
  online=" "
  if XfqSessionUp(sites.loop) then online="*"
  addrtags.XQ_Mandatory=511
  addrtags.XQ_Optional=511
  tmp=XfqPutAddress(sites.loop,addrtags)
  call XfqWalkQueue(sites.loop,sitework)
  systems.loop=left_justify(tmp,33)" "right_justify(sitework.NUMENTRIES,3)"  "right_justify(MaxPri,4)||online
end

xq.left=0
xq.top=10
xq.width=350
xq.height=200
xq.font='SCREEN'
xq.multiselect='FALSE' 
xq.sort='TRUE'
xq.title="XQM v"left_justify(sv HOST,27)"Files   Pri"
xq.gadgettext='_View|_Add|_Kill|_Dial|_Scan|_Help|_Quit'
SYSTEMQUEUE.0=0
address COMMAND 'AVAIL >NIL: FLUSH'
call addlib('rexxtricks.library',-1,-30,0)
  xq.pubscreen=GetDefaultPubScreen()
  call PubScreenToFront(xq.pubscreen)
  ItemSelected=viewlist('systems','xq','SYSTEMQUEUE')
call remlib('rexxtricks.library')

if debug then do
  say 'Select :'bol.ItemSelected 
  say 'Entries:'SYSTEMQUEUE.0
  say 'Entry  :'SYSTEMQUEUE.1
  say 'Gadget :'SYSTEMQUEUE.gadget
end

/* we do not exit on ItemSelected=0 */
if SYSTEMQUEUE.gadget=0 then SIGNAL xexit
else if SYSTEMQUEUE.gadget=6 then signal help_main
else if SYSTEMQUEUE.gadget=5 then signal show_sites
SiteSelected=word(SYSTEMQUEUE.1,1)
if SYSTEMQUEUE.gadget=4 then address COMMAND 'DIAL 'SiteSelected
else if SYSTEMQUEUE.gadget=3 then do             /* KILL */
  if ~ItemSelected then SIGNAL show_sites
  else do
    site_pattern=translate(SiteSelected,'?','#')
    sitelist=XfqGetSiteList()
    call XfqWalkSession(sitelist,sites)
    do loop=1 to sites.NUMENTRIES
      addrtags.XQ_Mandatory=511
      addrtags.XQ_Optional=511
      SYSTEM=upper(XfqPutAddress(sites.loop,addrtags))
      if ~MatchPattern(site_pattern,SYSTEM,'N') then iterate
      else do
        call XfqWalkQueue(sites.loop,sitework)
        do n=1 to sitework.NUMENTRIES
          FINDIT.XQ_NAME=sitework.n.NAME
          FINDIT.XQ_SITE=sites.loop
          work=NULL
          work=XfqFindWork(FINDIT)
          if(work~=NULL) then call XfqRemoveWork(work)
        end
      end
    end
    call XfqDropObject(sitelist)
    drop FINDIT. sitework. 
    SIGNAL show_sites
  end
end;else if SYSTEMQUEUE.gadget=2 then do         /* ADD */
  if ItemSelected then XSYSTEM=SiteSelected
  else do
    XSYSTEM=rtgetstring(,"Site to Send To?","Enter FQFA Address","Ok|Cancel",,)
    if XSYSTEM="" then SIGNAL show_sites
    SiteSelected=XSYSTEM
  end
  call add_file(XSYSTEM)
  site_pattern=translate(XSYSTEM,'?','#')
  call show_queue(site_pattern)
end;else if SYSTEMQUEUE.gadget=1 then do         /* VIEW */
  site_pattern=translate(SiteSelected,'?','#')
  call show_queue(site_pattern)
end
SIGNAL show_sites


show_queue:
/* Traverse queue, search for selected system */
do loop=1 to sites.numentries
  addrtags.XQ_Mandatory=511;addrtags.XQ_Optional=511
  SYSTEM=upper(XfqPutAddress(sites.loop,addrtags))
  if debug then say sites.numentries loop system 
  /* Build Queue List */
  if ~MatchPattern(site_pattern,SYSTEM,'N') then iterate
  else do
    call XfqWalkQueue(sites.loop,QUEUE)
    do idx=1 to QUEUE.numentries
      if debug then SITEQUEUE.idx=left_justify(QUEUE.idx.NAME,40) left_justify(QUEUE.idx.ASNAME,14) right_justify(QUEUE.idx.PRI,3) right_justify(QUEUE.idx.STATUS,3) right_justify(QUEUE.idx.FLAGS,3)
      else do
       bits=""
        f=""
        if QUEUE.idx.FLAGS=0 then do
          f='L'
          bits='00000000'
        end;else do
          bin=bitXOR(d2x(QUEUE.idx.FLAGS),'00110000'B)
          do z=7 to 0 by -1
            if bittst(bin,z) then bits=bits||'1'
            else bits=bits||'0'
          end
          if bittst(bin,4) then f=f||'K'
          if bittst(bin,3) then f=f||'A'
          else if bittst(bin,2) then f=f||'I'
          if bittst(bin,1) then f=f||'T'
          else if bittst(bin,0) then f=f||'D'
          else f=f||'L'
        end
        if QUEUE.idx.STATUS=2 then bits=BOLD||bits||AOFF
        SITEQUEUE.idx=left_justify(QUEUE.idx.NAME,40) left_justify(QUEUE.idx.ASNAME,14) right_justify(QUEUE.idx.PRI,3) right_justify(f,2) bits QUEUE.idx.FLAGS
      end
    end
    if QUEUE.numentries>0 then do
      SITEQUEUE.0=QUEUE.numentries
      xq.width=640
      xq.sort='FALSE'
      xq.multiselect='TRUE' 
      if debug then xq.title="Files "left_justify(SYSTEM,35)"AsName"copies(" ",9)"Pri/Stat/Flag"
      else xq.title="Files "left_justify(SYSTEM,35)"AsName"copies(" ",9)"Pri Disp"
      xq.gadgettext="_ReScan|_Add|_Kill|_Crash|_Hold|_Edit|_Sites|_Help|_Quit"
      SITEENTRY.0=0
      call addlib('rexxtricks.library',-1,-30,0)
        call PubScreenToFront(xq.pubscreen)
        ItemSelected=viewlist('SITEQUEUE','xq','SITEENTRY')
      call remlib('rexxtricks.library')
      if debug then do
        say 'Select :'bol.ItemSelected
        say 'Entries:'SITEENTRY.0
        do i=1 to SITEENTRY.0
        say 'Entry  :'SITEENTRY.i
        end
        say 'Gadget :'SITEENTRY.gadget
      end
      if SITEENTRY.gadget=0 then SIGNAL xexit
      else if SITEENTRY.gadget=1 then SIGNAL show_queue
      else if SITEENTRY.gadget=2 then call add_file(SYSTEM)
      else if SITEENTRY.gadget=7 then SIGNAL show_sites
      else if SITEENTRY.gadget=8 then SIGNAL help_site
      else if ItemSelected then do
        if SITEENTRY.gadget=6 then do
          val=""
          OP=rtezrequest("Select parameter to change","Address|AsName|Priority|Disposition|Cancel","Edit File Queue",,OP)
          if OP>0 then do q=1 to SITEENTRY.0
            if debug then parse var SITEENTRY.q FULLNAME XASNAME XPRI XSTATUS XFLAGS
            else parse var SITEENTRY.q FULLNAME XASNAME XPRI DISP BITS XFLAGS
            val=edit_site(SYSTEM,OP,val)
            if debug then say 'Edit Site Returned:'val
          end
        end
        else if SITEENTRY.gadget=5 then do  /* HOLD */
          do q=1 to SITEENTRY.0
            if debug then parse var SITEENTRY.q FULLNAME XASNAME XPRI XSTATUS XFLAGS
            else parse var SITEENTRY.q FULLNAME XASNAME XPRI DISP BITS XFLAGS
            call kill_file(SYSTEM,FULLNAME)
            if XPRI>30 then XPRI=XPRI-100
            else XPRI=-50
            call XfqAddWorkQuick(SYSTEM,FULLNAME,XASNAME,XPRI,XFLAGS)
          end
        end
        else if SITEENTRY.gadget=4 then do  /* CRASH */
          do q=1 to SITEENTRY.0
            if debug then parse var SITEENTRY.q FULLNAME XASNAME XPRI XSTATUS XFLAGS
            else parse var SITEENTRY.q FULLNAME XASNAME XPRI DISP BITS XFLAGS
            call kill_file(SYSTEM,FULLNAME)
            if XPRI<0 then XPRI=XPRI+100
            else XPRI=50
            call XfqAddWorkQuick(SYSTEM,FULLNAME,XASNAME,XPRI,XFLAGS)
          end
        end
        else if SITEENTRY.gadget=3 then do
          do q=1 to SITEENTRY.0
            if debug then parse var SITEENTRY.q FULLNAME XASNAME XPRI XSTATUS XFLAGS
            else parse var SITEENTRY.q FULLNAME XASNAME XPRI DISP BITS XFLAGS
            call kill_file(SYSTEM,FULLNAME)
          end
        end
      end     
      SIGNAL show_queue
    end
  end
end
return

edit_site:
SYSTEM=arg(1)
OP=arg(2)
val=arg(3)
  if OP=0 then return ""
  select
    when OP=1 then do                       /* CHANGE ADDRESS */
      if val~="" then NEWADDRESS=val
      else do
        NEWADDRESS=rtgetstring(NEWADDRESS,"Route "XASNAME" To?","Route File","Ok|Cancel",,)
        if NEWADDRESS="" then return ""
        val=NEWADDRESS
      end
      /* ASK EVERYTIME IF ARCMAIL*/
      if MatchPattern("????????.(MO|TU|WE|TH|FR|SA|SU)[0-9]",XASNAME,'N') then do
        XASNAME=rtgetstring(XASNAME,"Change ARCMAIL "XASNAME" to?","Change AsName","Ok|Cancel",,)
      end
      call kill_file(SYSTEM,FULLNAME)
      call XfqAddWorkQuick(NEWADDRESS,FULLNAME,XASNAME,XPRI,XFLAGS)
      return val
    end
    when OP=2 then do                       /* CHANGE ASNAME */
      /* ASK EVERYTIME */
      XASNAME=rtgetstring(XASNAME,"Change "XASNAME" to?","Change AsName","Ok|Cancel",,)
      if XASNAME="" then return ""
      val=""
    end
    when OP=3 then do                       /* CHANGE PRIORITY */
      if val~="" then XPRI=val
      else do
        XPRI=rtgetstring(XPRI,"New Priority (-127 to +127) ?","Change Priority","Ok|Cancel",,)
        if XPRI="" then return ""
        if XPRI<128 & XPRI>(-127) then
        val=XPRI
      end
    end
    when OP=4 then do                       /* CHANGE DISPOSITION */
      if val~="" then XFLAGS=val
      else do
        call rtezrequest("New Disposition?","Leave|Delete|Truncate|NoChange","Change Disposition",,NEWXFLAGS)
        if NEWXFLAGS=4 then return ""
        if NEWXFLAGS>0 then XFLAGS=NEWXFLAGS-1
        val=XFLAGS
      end 
    end
    otherwise return val
  end
  call kill_file(SYSTEM,FULLNAME)
  call XfqAddWorkQuick(SYSTEM,FULLNAME,XASNAME,XPRI,XFLAGS)
return val


add_file:
  XSYSTEM=arg(1)
  FULLNAME=rtfilerequest("MAIL:OUTBOUND/",,XSYSTEM,,"rtfi_flags=freqf_multiselect")
  if FULLNAME == "" then SIGNAL show_sites
  do j=1 to rtresult.count
    FULLNAME=rtresult.j
    XASNAME=get_fn(FULLNAME)
    XASNAME=rtgetstring(XASNAME,"Send As Name?","Enter Send As Name","Ok|Cancel",,)
    if XASNAME="" then XASNAME=get_fn(FULLNAME)
    XPRI=50
    XPRI=rtgetstring(XPRI,"Priority (-127 to +127) ?","Enter Priority","Ok|Cancel",,)
    if XPRI="" then XPRI=50
    else if XPRI>127 | XPRI<(-127) then XPRI=0
    call rtezrequest("Disposition?","Leave|Delete|Truncate","Select Disposition",,XFLAGS)
    if XFLAGS="" then XFLAGS=0
    if XFLAGS>0 then XFLAGS=XFLAGS-1
    call XfqAddWorkQuick(XSYSTEM,FULLNAME,XASNAME,XPRI,XFLAGS)
  end
return

kill_file: PROCEDURE
  site_address=XfqGetAddress(arg(1))
  QUERY.XQ_NAME=arg(2)
  QUERY.XQ_SITE=site_address
  work=NULL;work=XfqFindWork(QUERY)
  call XfqRemoveWork(work)
  call XfqDropObject(work)
  call XfqFlushQueue(site_address)
  call XfqDropObject(site_address)
  drop QUERY.
return


Get_FN: PROCEDURE
  if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
return arg(1)


/* align text to right of field  adding spaces or trucating on left to fit   */
right_justify:
  if length(arg(1)) > arg(2) then return (right(arg(1),arg(2)))
  else return (copies(" ",arg(2)-length(arg(1))) || arg(1))

/* align text to left of field  adding spaces or trucating on right to fit   */
left_justify:
  if length(arg(1)) > arg(2) then return (left(arg(1),arg(2)))
  else return (arg(1) || copies(" ",arg(2)-length(arg(1))))

xexit:
call remlib('rexxtricks.library')
call XfqDropObject(sitelist)
call XfqClose()
exit

help_main:
if ~hopen then hopen=open('h',hspec,'w')
call writech('h',CLS)
buf= LF' View - show queue for selected site'LF
buf=buf' Add  - add a file to selected site or'LF
buf=buf'        add a  new site and queue file'LF
buf=buf' Kill - remove selected site from the queue'LF
buf=buf' Dial - Call selected site'LF
buf=buf' Scan - rescan and display sites'LF||LF
buf=buf' * indicates site is online'LF
call writech('h',buf)
drop buf
signal show_sites

help_site:
if ~hopen then hopen=open('h',hspec,'w')
call writech('h',CLS)
buf= LF' Sites  - Show sites in queue'LF
buf=buf' ReScan - Rescan and display site file queue'LF
buf=buf' Add    - Add file(s) to site queue'LF
buf=buf' Kill   - Remove file(s) from site queue'LF
buf=buf' Crash  - Change file(s) priority to Crash'LF
buf=buf' Hold   - Change file(s) priority to Hold'LF
buf=buf' Edit   - Change address, asname, priority or'LF
buf=buf'          disposition of selected file(s)'LF
call writech('h',buf)
drop buf
signal show_queue