#!/usr/bin/perl # # hello.pl -- programa "hello, world" padrao para demonstrar programacao # basica em CGI e o uso da rotina &getcgivars(). # # Primeiro, armazenar as variaveis CGI em uma lista de strings %cgivars= &getcgivars ; # Imprimir o header de resposta CGI, exigido para toda saida HTML. # Notar o \n adicional, para enviar a linha vazia. print "Content-type: text/html\n\n" ; # Finalmente, imprimir a pagina de resposta HTML completa. print < CGI Results

Hello, world.

Your CGI input variables were:

[$_] = [$cgivars{$_}]\n" ; } # Imprimir fechamento do arquivo HTML print < EOF exit ; #----------------- inicio do modulo &getcgivars() ---------------------- # Ler todas as variaveis CGI para dentro de um array associativo. # Se multiplos campos de entrada tiverem o mesmo nome, serao concatenados em # um elemento do array e delimitados com o caractere \0 (isso falha se # a entrada contiver algum caractere \0, muito improvavel mas # conceitualmente possivel). # Atualmente suporta apenas Content-Type de application/x-www-form-urlencoded. sub getcgivars { local($in, %in) ; local($name, $value) ; # Primeiro, ler a cadeia inteira de variaveis CGI e armazenar em $in if ( ($ENV{'REQUEST_METHOD'} eq 'GET') || ($ENV{'REQUEST_METHOD'} eq 'HEAD') ) { $in= $ENV{'QUERY_STRING'} ; } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { if ($ENV{'CONTENT_TYPE'}=~ m#^application/x-www-form-urlencoded$#i) { $ENV{'CONTENT_LENGTH'} || &HTMLdie("No Content-Length sent with the POST request.") ; read(STDIN, $in, $ENV{'CONTENT_LENGTH'}) ; } else { &HTMLdie("Unsupported Content-Type: $ENV{'CONTENT_TYPE'}") ; } } else { &HTMLdie("Script was called with unsupported REQUEST_METHOD.") ; } # Resolver e decodificar pares nome/valor em %in foreach (split('&', $in)) { s/\+/ /g ; ($name, $value)= split('=', $_, 2) ; $name=~ s/%(..)/chr(hex($1))/ge ; $value=~ s/%(..)/chr(hex($1))/ge ; $in{$name}.= "\0" if defined($in{$name}) ; # concatenate multiple vars $in{$name}.= $value ; } return %in ; } # Morrer, colocando na saida a pagina de erro HTML # Se nao houver $title, usar um titulo default sub HTMLdie { local($msg,$title)= @_ ; $title || ($title= "CGI Error") ; print < $title
$title

$msg
EOF exit ; }

Hello, world.

$title

$msg