From 877b8876b078c8ab2632c17ab09e0ac0c2789c8a Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Tue, 4 May 2021 16:44:20 -0400
Subject: Initial work on the CGI interface for web access.

---
 common/utilities.F90 | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

(limited to 'common')

diff --git a/common/utilities.F90 b/common/utilities.F90
index 093595b..670d48f 100644
--- a/common/utilities.F90
+++ b/common/utilities.F90
@@ -467,4 +467,67 @@ contains
     
     end function get_files_in_directory
     
+    subroutine get_one_line_output_shell_command(cmd, output, retcode)
+    implicit none
+    
+        character(*), intent(in)::cmd
+        character(*), intent(out)::output
+        integer, intent(out), optional::retcode
+        
+        integer::internal_retcode, ierr, unum
+        character(len=:), pointer::tempfilename
+        
+        tempfilename => generate_temporary_filename()
+        call execute_command_line(trim(cmd)//" > "//trim(tempfilename), &
+                                  wait=.true., &
+                                  exitstat=internal_retcode)
+        
+        if(present(retcode)) then
+            retcode = internal_retcode
+        end if
+        
+        open(newunit=unum, file=tempfilename, status="old", iostat=ierr)
+        if(ierr == 0) then
+            read(unum, '(A)') output
+            close(unum)
+        end if
+        
+        call delete_file(tempfilename)
+        deallocate(tempfilename)
+    
+    end subroutine get_one_line_output_shell_command
+    
+    subroutine toupper(str)
+    implicit none
+    
+        character(*), intent(inout)::str
+        integer::i
+        
+        interface
+            function toupper_c(c) bind(c, name="toupper")
+            use iso_c_binding
+            integer(kind=c_int), value::c
+            integer(kind=c_int)::toupper_c
+            end function toupper_c
+        end interface
+        
+        do i=1, len_trim(str)
+            str(i:i) = char(toupper_c(IACHAR(str(i:i))))
+        end do
+        
+    end subroutine toupper
+    
+    subroutine echo_file_stdout(filename)
+    implicit none
+    
+        character(*), intent(in)::filename
+        
+#ifdef WINDOWS
+        call execute_command_line("type "//trim(filename), wait=.true.)
+#else
+        call execute_command_line("cat "//trim(filename), wait=.true.)
+#endif
+
+    end subroutine echo_file_stdout
+    
 end module utilities
\ No newline at end of file
-- 
cgit v1.2.3