Exemplo PERL utilizando OBCOM

Veja o exemplo a seguir, acessando uma Base de Dados OpenBASE Local.

O esquema do banco usado neste exemplo é o seguinte:

Banco EXEMPLO 1

nome: PESSOA E

    NOMEP(0)    U20

    IDADE       N3

O Script Perl é o seguinte:

#!c:\perl\bin\perl

use Win32::OLE ;

use Win32::OLE ;

print "Content-type: text/html\n\n" ;

if ( $ENV{'CONTENT_LENGTH'} gt "0" ) {

  $Banco = "C:\\usr\\tsgbd\\tsdic\\EXEMPLO" ;

  $nivel = "a" ;

  $seguranca = 1 ;

  $modo = "2" ;

  $Arquivo="PESSOA" ;

  $result = 0 ;

  $in_nome = "" ;

  $result = $com = Win32::OLE->new('OpenBase.OBcom.1');

  $result = $com->OAbreBancoDeDados($Banco,$nivel,$seguranca,$modo);

  $result = $com->OObtemRegistrosNoArquivo($Arquivo);

  &ReadParse;

  $in_nome = $in{'in_nome'} ;

  $result = $com->OLeRegistroPorChavePrimaria($Arquivo,$in_nome);

  $in_nome = $com->OPegaItem($Arquivo,"NOMEP");

  $gw_ida = $com->OPegaItem($Arquivo,"IDADE");

  $result = $com->OFechaBancoDeDados(0);

$in_nome =~ s/[ ]*$//g;    # remove trailing blanks

print<<"_TERMINA_"

<html><body>\n

<h2>Demonstra&ccedil;&atilde;o OpenBASE COM - Perl</h2>\n

<Form method='post' action='$ENV{'SCRIPT_NAME'}'>\n

Informe o Nome: \n

<input type='text' size=20 name='in_nome' value="$in_nome">

&nbsp;&nbsp;&nbsp;

<input type='submit' name='in_cont' value='Continua'>

<br><br>

_TERMINA_

if ( $ENV{'CONTENT_LENGTH'} gt "0" ) {

  print<<"_TERMINA_"

<br><b>Resultados: <br>

<ul>

<li>Nome ==> $in_nome <br>

<li>Idade ==> $gw_ida <br>

<eul>

_TERMINA_

print<<"_TERMINA_"

</form></body></html>

_TERMINA_

sub ReadParse {

  local (*in) = @_ if @_;

  local ($i, $key, $val);

  ### replaced his MethGet function

  if ( $ENV{'REQUEST_METHOD'} eq "GET" ) {

    $in = $ENV{'QUERY_STRING'};

  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {

    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});

  } else {

        # Added for command line debugging

        # Supply name/value form data as a command line argument

        # Format: name1=value1\&name2=value2\&...

        # (need to escape & for shell)

        # Find the first argument that's not a switch (-)

        $in = ( grep( !/^-/, @ARGV )) [0];

        $in =~ s/\\&/&/g;

  @in = split(/&/,$in);

  foreach $i (0 .. $#in) {

    # Convert plus's to spaces

    $in[$i] =~ s/\+/ /g;

    # Split into key and value.

    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

    # Convert %XX from hex numbers to alphanumeric

    $key =~ s/%(..)/pack("c",hex($1))/ge;

    $val =~ s/%(..)/pack("c",hex($1))/ge;

    # Associate key and value. \0 is the multiple separator

    $in{$key} .= "\0" if (defined($in{$key}));

    $in{$key} .= $val;

  return length($in);