module gfcgi
!! GeoFOld CGI module for gf1cgi and gf1cgi
!! C.Bystroff Fri Nov 21 16:38:37 EST 2008
!!--------------------------------------------
  implicit none
  private
  character(len=200),parameter :: tmpdir="/tmp"
  character(len=200),parameter :: curlpdb = "/home/bystrc/bin/curlpdb "
  public :: gfcgi_parseit, gfcgi_errormsg, gfcgi_findpdbfile, &
            gfcgi_replace, gfcgi_split, gfcgi_getpdbchains, gfcgi_stdinsave, &
            gfcgi_replacefield, gfcgi_stdinbinary, gfcgi_stdin_pdf
  !!---------
CONTAINS
  subroutine gfcgi_stdin_pdf(iunit,pdffile,pid)
    !! Read stdin until a PDF file is reached.
    !! Write the PDF file to a tmp file until EOF is reached.
    !! iunit = text input
    !! pdffile = tmp PDF file
    implicit none
    integer,intent(out) :: iunit
    character(len=*),intent(out) :: pdffile
    integer,optional :: pid
    logical :: isopen=.false.
    integer :: ios, ipid, junit, i
    byte :: bigbyte(1000)
    byte :: onebyte
    character(len=5) :: tag
    character(len=1000) :: aline, tmpfile
    !!
    iunit = 21
    junit = 22
    inquire(unit=iunit,opened=isopen)
    do while (isopen)
      iunit = iunit + 1
      inquire(unit=iunit,opened=isopen)
    enddo
    if (present(pid)) then
      ipid = pid
    else
     ipid = getpid()
    endif
    write(tmpfile,'(a,i8.8,a)') trim(tmpdir)//"/",ipid,".stdin"
    write(pdffile,'(a,i8.8,a)') trim(tmpdir)//"/",ipid,".pdf"
    open(iunit,file=trim(tmpfile),status='replace',form='formatted',iostat=ios)
    if (ios/=0) stop 'gfcgi:: stdinbinary: error opening output file. Permissions?'
    inquire(unit=junit,opened=isopen)
    do while (isopen)
      junit = junit + 1
      inquire(unit=junit,opened=isopen)
    enddo
    open(junit,file=trim(pdffile),status='replace',form='unformatted',iostat=ios)
    if (ios/=0) stop 'gfcgi:: stdinbinary: error opening output PDF file. Permissions?'
    do
      read(*,'(a)',iostat=ios) aline
      if (ios/=0) exit
      write(*,'(a)') trim(aline)
      if (aline(1:4)=="%PDF") exit
      write(iunit,'(a)') trim(aline)
    enddo
    if (.not.aline(1:4)=="%PDF") then
      write(0,*) "%PDF line not found in input stream."
      pdffile = " "
      return
    endif
    write(junit) trim(aline)
    tag = " "
    do 
      bigbyte(:) = 0
      read(*,iostat=ios) bigbyte
      if (ios/=0) exit
      tag(1:1) = char(bigbyte(1))
      tag(2:2) = char(bigbyte(2))
      tag(3:3) = char(bigbyte(3))
      tag(4:4) = char(bigbyte(4))
      tag(5:5) = char(bigbyte(5))
      write(*,'(a)') trim(tag)
      i = 1
      do 
        onebyte = bigbyte(i)
        write(junit) onebyte
        if (char(onebyte)==" ") exit
      enddo
      !if (tag(1:5)=="%%EOF") exit
      !tag(1:4) = tag(2:5)
    enddo
    if (ios/=0) write(0,*) "No %%EOF found for PDF input"
    close(junit)
    rewind(iunit)  !! text file is ready to read... just close it when you're done.
  end subroutine gfcgi_stdin_pdf
  !---------------------------------------------
  subroutine gfcgi_stdinbinary(iunit,pid)
    implicit none
    integer,intent(out) :: iunit
    integer,optional :: pid
    logical :: isopen=.false.
    integer :: ios, ipid
    character :: onebyte
    character(len=1000) :: aline, tmpfile
    !!
    iunit = 21
    inquire(unit=iunit,opened=isopen)
    do while (isopen)
      iunit = iunit + 1
      inquire(unit=iunit,opened=isopen)
    enddo
    if (present(pid)) then
      ipid = pid
    else
     ipid = getpid()
    endif
    write(tmpfile,'(a,i8.8,a)') trim(tmpdir)//"/",pid,".stdin"
    open(iunit,file=trim(tmpfile),status='replace',form='unformatted',iostat=ios)
    if (ios/=0) stop 'gfcgi:: stdinbinary: error opening output file. Permissions?'
    do
      read(*,iostat=ios) onebyte
      if (ios/=0) exit
      write(iunit) onebyte
    enddo
    rewind(iunit)  !! ready to read... just close it when you're done.
  end subroutine gfcgi_stdinbinary
  !---------------------------------------------
  subroutine gfcgi_stdinsave(iunit,pid)
    implicit none
    integer,intent(out) :: iunit
    integer,optional :: pid
    logical :: isopen=.false.
    integer :: ios, ipid
    character(len=1000) :: aline, tmpfile
    !!
    iunit = 21
    inquire(unit=iunit,opened=isopen)
    do while (isopen)
      iunit = iunit + 1
      inquire(unit=iunit,opened=isopen)
    enddo
    if (present(pid)) then
      ipid = pid
    else
     ipid = getpid()
    endif
    write(tmpfile,'(a,i8.8,a)') trim(tmpdir)//"/",pid,".stdin"
    open(iunit,file=trim(tmpfile),status='replace',form='formatted',iostat=ios)
    if (ios/=0) stop 'gfcgi:: stdinsave: error opening output file. Permissions?'
    do
      read(*,'(a)',iostat=ios) aline
      if (ios/=0) exit
      write(iunit,'(a)') trim(aline)
    enddo
    rewind(iunit)  !! ready to read... just close it when you're done.
  end subroutine gfcgi_stdinsave
  !---------------------------------------------
  subroutine gfcgi_parseit(aline,atag,result)
    character(len=*),intent(in) :: aline, atag
    character(len=*),intent(out) :: result
    integer :: i,j,ich, k, n
    ich = 1
    result = " "
    do
      i = index(aline(ich:),atag)
      !! --- if tag not found, return empty result
      if (i==0) exit
      j = i + len(atag)+ich
      k = index(aline(j:),'&')
      result = trim(result)//aline(j:j+k-2)
      ich = j + k
    enddo
  end subroutine gfcgi_parseit
  !---------------------------------------------
  subroutine gfcgi_errormsg(atag,entry)
    character(len=*),intent(in) :: atag,entry
    write(*,'(a,//)') 'Content-type: text/html'
    write(*,'(a)') '<meta http-equiv="refresh" content="30;url=server.php">'
    write(*,'(a)') "<html>"
    write(*,'(a)') "<body>"
    write(*,'(a,a)') '<font color="#FF0000">ERROR! Please enter a valid </font>',trim(atag)
    write(*,'(a,a,a)') 'You entered "',trim(entry),'" </font>'
    write(*,'(a)') '<h2><A HREF="server.php">try again</A></h2>'
    write(*,'(a)') "</body>"
    write(*,'(a)') "</html>"
    stop
  end subroutine gfcgi_errormsg
  !---------------------------------------------
  subroutine gfcgi_findpdbfile(code,pdbdir,pdbchains,biolunit)
    character(len=*),intent(in) :: pdbdir, code, biolunit
    character(len=*),intent(out) :: pdbchains
    character(len=200) :: pdbfile, aline, command
    character :: cnchar
    logical :: isthere
    integer :: ios, ich
    ! curlpdb = "/home/bystrc/bin/curlpdb "
    ich = 0
    !!
    ! write(*,'(a)') "Looking locally...<br>"
    pdbfile = trim(pdbdir)//trim(code)//".pdb"
    inquire(file=pdbfile,exist=isthere)
    if (isthere) then
      ! write(*,'(a)') "Found. <br>"
    else
      ! write(*,'(a)') "Not found. <br>Looking offsite (www.pdb.org)...<br>"
      if (biolunit(1:8)=="biolunit") then
        command = trim(curlpdb)//" "//trim(code)//" 1 "
        ! write(*,'(a)') trim(command)
        call system(command)
      elseif (biolunit(1:6)=="select") then
        !! NOTE. curlpdb puts the file in $PDB. The setting of $PDB
        !! in this program must match the setting in curlpdb
        command = trim(curlpdb)//" "//trim(code)
        call system(command)
      else    !! if chain is any other string, dont send a job to curlpdb
      endif
    endif
    !! see if PDB file landed
    inquire(file=pdbfile,exist=isthere)
    if (isthere) then
      call gfcgi_getpdbchains(pdbfile,pdbchains)
    else
      !! write(*,'(a)') "<p>PDB file not found. Check your input. <br>"
      pdbchains = " "
    endif
  end subroutine gfcgi_findpdbfile
  !---------------------------------------------
    subroutine gfcgi_getpdbchains(pdbfile,pdbchains)
      character(len=*),intent(in) :: pdbfile
      character(len=*),intent(out) :: pdbchains
      integer :: ios, ich
      character(len=200) :: aline
      character :: cnchar
      !!
      open(11,file=pdbfile,status='old',form='formatted',iostat=ios)
      if (ios/=0) then
        pdbchains = " "
        return
        ! stop "gfcgi::getpdbchains: A file was found but could not be opened! BUG?"
      else
        ! write(*,'(a)') "... found. <br>"
        ich = 0
        do 
          read(11,'(a)',iostat=ios) aline
          if (ios/=0) exit
          !if (aline(1:6)=="HEADER") then
          !  write(*,'(a)') trim(aline)//"<br>"
          !endif
          if (aline(1:5)/="ATOM ") cycle
          cnchar = aline(22:22)
          if (cnchar==" ") cnchar = "_"
          if (index(pdbchains,cnchar)==0) then
            ich = ich + 1
            pdbchains(ich:ich) = cnchar
          endif
        enddo
        ! write(*,'(i9,a)') ich," chains found.<br>"
        if (ich==0) pdbchains = " "
      endif
      close(11)
    end subroutine gfcgi_getpdbchains
  !---------------------------------------------
  subroutine gfcgi_replace(str,srch,rplc)
    character(len=*),intent(inout) :: str
    character(len=*),intent(in) :: srch,rplc
    integer :: i,j,k
    i = 1
    k = len(srch)
    do
      i = index(str(1:),srch)
      if (i == 0) exit
      str = str(1:i-1)//rplc//str(i+k:)
    enddo
  end subroutine gfcgi_replace
  !---------------------------------------------
  subroutine gfcgi_replacefield(str,srch,tag,rplc)
    !! Remove the field bracketed by srch that starts with tag, from str.
    character(len=*),intent(inout) :: str
    character(len=*),intent(in) :: srch
    character(len=*),intent(in) :: tag, rplc
    integer :: i,j,k,m,n
    i = 1
    k = len(srch)
    m = len(tag)
    j = 0
    !! diagnostic
    !  write(0,'(a)') "Replacing field >>"//srch//"<< with tag>>"//tag//"<< with >>"//rplc//"<<"
    do
      i = j + index(str(j+1:),srch) 
      if (i == j) exit                    !! no more srch
      !! diagnostic
      if (i > len(str)) exit              !! no more srch
      !write(0,'(a)') str(i:)
      if (str(i+k:i+k+m-1)==tag(1:m)) then
        !! make i,n bracket field
        i = i + k  !! 1st char after tag
        n = i + index(str(i:),srch) - 1   !! last char before tag
        if (n<=i) then                    !! or end of str
          str = str(1:i-1)//rplc
        else
          str = str(1:i-1)//rplc//str(n:)
        endif
        exit
      endif
      j = i
    enddo
  end subroutine gfcgi_replacefield
  !---------------------------------------------
  subroutine gfcgi_split(str,srch,iunit,tag)
    integer,intent(in) :: iunit
    character(len=*),intent(inout) :: str
    character(len=*),intent(in) :: srch
    character(len=*),optional,intent(in) :: tag
    integer :: i,j,k
    i = 1
    k = len(srch)
    do
      i = index(str(1:),srch)
      if (i == 0) exit
      if (present(tag)) then
        write(iunit,'(a)') str(1:i-1)//tag
      else
        write(iunit,'(a)') str(1:i-1)
      endif
      str = str(i+k:)
    enddo
  end subroutine gfcgi_split
  !---------------------------------------------

end module gfcgi