26 character(len=DICT_VALUE_LENGTH) :: value
38 integer,
private,
save ::
method = -1
46 include
'dictionary.f90'
67 integer,
intent(in) :: html
68 type(dict_struct),
pointer :: dict
69 integer,
intent(out) :: luout
74 character(len=DICT_BUFFER_LENGTH) :: string
75 character(len=1) :: ch
80 if (
associated(dict) )
then
81 call dict_destroy( dict )
89 call get_environment_variable(
"QUERY_STRING", length=length, status=status )
90 if ( status == 0 )
then
94 call get_environment_variable(
"CONTENT_LENGTH",
value=string, status=status )
95 if ( status == 0 )
then
96 read( string, * ) length
100 read( *,
'(A)', advance =
'no' ) ch
101 if ( ch ==
'%' )
then
106 elseif ( index(
'1234567890', ch ) > 0 )
then
120 call cgi_error(
"CGI protocol not recognised or not implemented" )
133 inquire( luout, opened = opend )
134 if ( .not. opend )
then
138 open( luout, file =
'cgiout' )
153 call cgi_error(
"Programming error: wrong value for parameter 'html' in CGI_BEGIN" )
165 integer,
intent(in) :: type
171 write(
luout_cgi,
'(a)' )
'Content-Type: text/html;charset=iso8859-1'
174 write(
luout_cgi,
'(a)' )
'Content-Type: text/plain;charset=iso8859-1'
177 call cgi_error(
"Programming error: value 'output_no_header' not allowed in CGI_HEADER" )
179 call cgi_error(
"Programming error: wrong value for parameter 'type' in CGI_HEADER" )
191 type(dict_struct),
pointer :: dict
192 integer,
intent(in) :: length
194 character(len=length) :: buffer
196 call get_environment_variable(
"QUERY_STRING",
value=buffer )
209 type(dict_struct),
pointer :: dict
210 integer,
intent(in) :: length
212 character(len=length) :: buffer
214 read( *,
'(a)', advance=
'no' ) buffer
227 type(dict_struct),
pointer :: dict
230 character(len=DICT_KEY_LENGTH) :: key
231 character(len=DICT_BUFFER_LENGTH) :: input
237 read( *,
'(a)' ) input
238 read( *,
'(a)' ) input
240 do while ( input /=
'%END%' )
243 read( *,
'(a)', iostat=ierr ) input
244 if ( ierr /= 0 )
then
259 type(dict_struct),
pointer :: dict
260 character(len=*),
intent(in) :: string
262 character(len=DICT_KEY_LENGTH) :: key
263 character(len=len(string)) :: buffer
272 k = index( buffer,
'&' )
274 if ( buffer ==
' ' )
then
286 keq = index( buffer(1:k-1),
'=' )
288 key = buffer(1:keq-1)
289 data%value = buffer(keq+1:k-1)
291 if ( .not.
associated( dict ) )
then
292 call dict_create( dict, key,
data )
294 call dict_add_key( dict, key,
data )
298 if ( k < len(buffer) )
then
299 buffer = buffer(k+1:)
315 character(len=*),
intent(inout) :: string
324 k = index( string,
'+' )
334 k = index( string,
'%' )
337 read( string(k+1:k+2),
'(z2)' ) ch
338 string(k:) = achar(ch) // string(k+3:)
357 inquire( lu, opened=opend )
358 if ( .not. opend )
then
359 open( lu, file =
"cgiready" )
377 character(len=*),
intent(in) :: msg
378 character(len=*),
intent(in),
optional :: template
380 character(len=200) :: text
388 if (
present(template) )
then
389 inquire( file = template, exist = exists )
393 write(
luout_cgi,
'(a)' )
'Status: 400 Bad Request'
394 write(
luout_cgi,
'(a)' )
'Content-Type: text/plain,charset=utf8'
400 inquire( lu, opened = opend )
401 if ( .not. opend )
then
405 open( lu, file = template )
408 read( lu,
'(a)', iostat=ierr ) text
409 if ( ierr /= 0 )
exit
411 k = index( text,
'MSG' )
413 write(
luout_cgi,
'(3a)' ) text(1:k-1), trim(msg), text(k+3:)
439 type(dict_struct),
pointer :: dict
440 character(len=*) :: value
442 character(len=20) :: time_string
445 if ( dict_has_key( dict,
"sessionid" ) )
then
446 data = dict_get_key( dict,
"sessionid" )
449 call date_and_time( time = time_string )
450 value = time_string(5:6) // time_string(8:10)
452 call dict_add_key( dict,
"sessionid",
data )
469 type(dict_struct),
pointer :: dict
470 character(len=*) :: varname
471 character(len=*) :: value
475 if ( dict_has_key( dict, varname ) )
then
476 data = dict_get_key( dict, varname )
483 type(dict_struct),
pointer :: dict
484 character(len=*) :: varname
491 if ( dict_has_key( dict, varname ) )
then
492 data = dict_get_key( dict, varname )
493 read( data%value, *, iostat=ierr ) new_value
494 if ( ierr == 0 )
then
502 type(dict_struct),
pointer :: dict
503 character(len=*) :: varname
510 if ( dict_has_key( dict, varname ) )
then
511 data = dict_get_key( dict, varname )
512 read( data%value, *, iostat=ierr ) new_value
513 if ( ierr == 0 )
then
521 type(dict_struct),
pointer :: dict
522 character(len=*) :: varname
523 real(kind=8) :: value
527 real(kind=8) :: new_value
529 if ( dict_has_key( dict, varname ) )
then
530 data = dict_get_key( dict, varname )
531 read( data%value, *, iostat=ierr ) new_value
532 if ( ierr == 0 )
then
540 type(dict_struct),
pointer :: dict
541 character(len=*) :: varname
548 if ( dict_has_key( dict, varname ) )
then
549 data = dict_get_key( dict, varname )
550 read( data%value, *, iostat=ierr ) new_value
551 if ( ierr == 0 )
then
552 value = (new_value == 1)
subroutine cgi_post_method(dict, length)
integer, parameter dict_buffer_length
subroutine cgi_get_session(dict, value)
subroutine cgi_get_string(dict, varname, value)
subroutine cgi_error(msg, template)
integer, parameter, private output_text_delayed
integer, parameter output_text
integer, parameter output_html
integer, parameter output_no_header
subroutine cgi_header(type)
subroutine cgi_get_logical(dict, varname, value)
subroutine cgi_get_integer(dict, varname, value)
integer, save, private method
subroutine cgi_get_method(dict, length)
integer, save, private luout_cgi
integer, parameter dict_key_length
subroutine cgi_get_real(dict, varname, value)
integer, parameter, private output_html_delayed
logical, save, private header_written
type(dict_data), parameter dict_null
subroutine cgi_begin(html, dict, luout)
subroutine cgi_get_real8(dict, varname, value)
subroutine cgi_decode_string(string)
subroutine cgi_dustmote_method(dict)
subroutine cgi_store_dict(dict, string)
integer, parameter dict_value_length