Perl Guru Forums: Perl Programming Help: Intermediate: ASP x PerlScript why not getting right value?

Home: Perl Programming Help: Intermediate:
ASP x PerlScript why not getting right value?

web2solutions
Novice

Sep 17, 2010, 10:33 PM

Post #1 of 12 (1361 views)

ASP x PerlScript why not getting right value?	Can't Post

Hi guys,

login.asp
<code>
<%@ LANGUAGE="PerlScript" CODEPAGE="65001"%>

<%

#$usuario=GetFormValue("UserName");
#$senha=GetFormValue("Password");

$usuario=$Request->QueryString("UserName");
$senha=$Request->QueryString("Password");

print login($usuario, $senha);

%>
</code>

desktop.asp
<code>
<%
use Win32::ASP;
use Win32::OLE;
use Digest::MD5 qw(md5_hex);
use JSON;

$conexao = $Server->CreateObject("ADODB.Connection");
$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.web2.eti.br; DATABASE=xxx;UID=xxxx;PWD=xxxx; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;");

sub esta_logado {

}

sub login {
$usuario = $_[0];
$senha = $_[1];
$json = "";

if(not defined($usuario) or not length($usuario))
{
$json = "{errors:[{id:'user', msg:'Campo obrigatório'}]}";
}
elsif(not defined($usuario) or not length($usuario))
{
$json = "{errors:[{id:'pass', msg:'Campo obrigatório'}]}";
}else
{
my $query=$usuario;
$sql="select login from tbl_usuarios WHERE login='$query';";

}
return $sql;
}

sub logout {

}

%>
</code>

when I access http://localhost/extranet/perl/desktop2/source/login/login.asp?UserName=eduardo&Password=demo

I get:

select login from tbl_usuarios WHERE login='Win32::OLE=HASH(0x1019fb84)';

Why not I'm getting:

select login from tbl_usuarios WHERE login='eduardo';

??? Please help me, a tried so many things, but dont'works. excuse my bad english

(This post was edited by web2solutions on Sep 17, 2010, 10:44 PM)

FishMonger
Veteran

Sep 18, 2010, 7:05 AM

Post #2 of 12 (1347 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Code

$Request->QueryString("UserName")

It appears that is returning a Win32::OLE object, which is a reference to a hash. Then that hash ref is being stored in $usuario.

Use the Data::Dumper module and dump that var so you can see its structure. From there, you should be able to see how to de reference it.

web2solutions
Novice

Sep 18, 2010, 8:10 AM

Post #3 of 12 (1343 views)

Re: [FishMonger] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Thanks guy

web2solutions
Novice

Sep 18, 2010, 8:22 AM

Post #4 of 12 (1341 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Cause I'm a OO noobie, I'm getting some simple troubles.

Now, I'm gettin error using ADO connections in my package..

Look

----> login.asp

Code

<%@ LANGUAGE="PerlScript" CODEPAGE="65001"%> 
<!--#include file="../desktopnew.asp"--> 
<% 
	$usuario=$Request->QueryString("UserName")->item(); 
	$senha=$Request->QueryString("Password")->item(); 
	 
	print Desktop->login($usuario, $senha); 
	 
%>

----> desktopnew.asp

Code

<% 
use Win32::ASP; 
use Date::Day; 
use Win32::OLE; 
use Digest::MD5 qw(md5_hex); 
use JSON; 
 
$conexao = $Server->CreateObject("ADODB.Connection"); 
$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.web2.eti.br; DATABASE=xxxx;UID=xxxxxx;PWD=xxxx; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;"); 
 
{package  Desktop; 
	 
		sub esta_logado { 
		   
		} 
		 
		sub login { 
			$usuario = $_[1]; 
			$senha = $_[0]; 
			$json = ""; 
 
			if(not defined($usuario) or not length($usuario)) 
			{ 
				$json = "{errors:[{id:'user', msg:'Campo obrigatório'}]}"; 
			} 
			elsif(not defined($usuario) or not length($usuario)) 
			{ 
				$json = "{errors:[{id:'pass', msg:'Campo obrigatório'}]}"; 
			}else 
			{ 
					$sql="select login from tbl_usuarios WHERE login='$usuario';"; 
					$RS = $conexao->Execute($sql); 
					if ($RS->{EOF}) 
					{ 
						$json = "{errors:[{id:'user', msg:'Usuario nao encontrado'}]}"; 
					}else 
					{ 
						$criptsenha = $senha; 
						$sql="select login,senha from tbl_usuarios WHERE login='$usuario' AND senha='$criptsenha';"; 
						$RS1 = $conexao->Execute($sql); 
						if ($RS1->{EOF}) 
						{ 
							$json = "{errors:[{id:'pass', msg:'Senha incorreta'}]}"; 
						}else 
						{ 
							$sql="select login,senha from tbl_usuarios WHERE login='$usuario' AND senha='$criptsenha';"; 
							$RS2 = $conexao->Execute($sql); 
							if ( ! $RS2->{EOF}) 
							{ 
								$usuarioid = $RS2->Fields("id")->{Value}; 
								$usuariotipo = $RS2->Fields("id")->{Value}; 
								$usuariologin = $RS2->Fields("id")->{Value}; 
								$usuarionome = $RS2->Fields("id")->{Value}; 
								$json = "{success:true, key:'', username:'$usuariologin', name:'$usuarionome', type:'$usuariotipo'}\n"; 
							}else 
							{ 
								$json = "{errors:[{id:'user', msg:'Falha ao efetuar login'}]}"; 
							} 
							$RS2->Close(); 
						} 
						$RS1->Close(); 
					} 
					$RS->Close(); 
			} 
			return $json; 
		} 
		 
		sub logout { 
			 
		} 
		 
}	 
%>

When I access
http://localhost/extranet/perl/desktop2/source/login/login.asp?UserName=eduardo&Password=demo

I got:

PerlScript Error erro '80004005'

(in cleanup) Can't call method "Execute" on an undefined value

/extranet/perl/desktop2/source/desktopnew.asp, linha 32

line 31 --> $sql="select login from tbl_usuarios WHERE login='$usuario';";
line 32 --> $RS = $conexao->Execute($sql);

FishMonger, could you help me again?

Code

(This post was edited by web2solutions on Sep 18, 2010, 11:11 AM)

FishMonger
Veteran

Sep 18, 2010, 9:04 AM

Post #5 of 12 (1337 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Please use the code tags whenever you post any code.

Perl is case sensitive.

Try changing:

Code

$RS = $conexao->Execute($sql);

To:

Code

$RS = $conexao->execute($sql);

FishMonger
Veteran

Sep 18, 2010, 9:15 AM

Post #6 of 12 (1334 views)

Re: [FishMonger] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Let me take a step back.

The problem is probably that $conexao is not defined, which would occur if this line failed.

Code

$conexao = $Server->CreateObject("ADODB.Connection");

However, I'd expect the open call just after that line to fail as well and either of those failures should have produced an error message.

Where did you define $Server? I don't see it in the code you posted.

web2solutions
Novice

Sep 18, 2010, 9:18 AM

Post #7 of 12 (1331 views)

Re: [FishMonger] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

How I define $server? in other scripts, not using OO, I use the same conection type and it works

thanks

FishMonger
Veteran

Sep 18, 2010, 9:51 AM

Post #8 of 12 (1325 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Try adding this line just before the CreateObject line

Code

my $Server = Win32::ASP->new;

web2solutions
Novice

Sep 18, 2010, 9:58 AM

Post #9 of 12 (1324 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

in this case it works, and I not defined $server, look:

Code

 
<%@ LANGUAGE = PerlScript%> 
<% 
use Win32::ASP; 
 
 
$acao=$Request->QueryString("acao")->item(); 
	 
sub conectar() 
{ 
	$conexao = $Server->CreateObject("ADODB.Connection"); 
	$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.imoveisemaguasclaras.com.br; DATABASE=imoveisemaguasclaras;UID=imoveisemaguasclaras;PWD=fuzzy24k; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;"); 
} 
sub desconectar() 
{ 
	$conexao->Close(); 
} 
 
if ($acao eq 'enviar') 
{ 
	$Response->{Buffer} = True; 
	conectar(); 
		 
		 
		 
		$mensagem=$Request->Form("mensagem")->Item(); 
		$celular="(61) 9177-2990"; 
	 
		$RS = $conexao->Execute( "SELECT * FROM tbl_clientes WHERE celular='$celular';" ); 
		if (! $RS->{EOF}) 
		{ 
			$i=0; 
			while ( ! $RS->{EOF} ) 
			{ 
				 
				print $RS->Fields("celular")->{Value}." enviado"; 
				print "<BR>"; 
				$Response->Flush(); 
				$i++; 
			$RS->MoveNext(); 
			}; 
		}else 
		{ 
			print "Năo há nenhum cliente com celular no banco de dados"; 
		}; 
		 
		$RS->Close(); 
		 
	desconectar(); 
}else 
{ 
%> 
	 
    <form action="<%=$nomepaginaatual%>?acao=enviar" method="POST" name="form" target="_self"> 
        <textarea name="mensagem" id="mensagem"><%= GetFormValue("mensagem") %></textarea> 
        <input name="enviar" type="submit" value="enviar"> 
</form> 
<% 
}; 
%>

(This post was edited by web2solutions on Sep 18, 2010, 10:07 AM)

web2solutions
Novice

Sep 18, 2010, 10:04 AM

Post #10 of 12 (1323 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

I added the connection in a sub{} and added my $Server = Win32::ASP->new; before

when I execute, I got:

PerlScript Error erro '80004005'

Can't locate auto/Win32/ASP/new.al in @INC (@INC contains: C:/Perl/site/lib C:/Perl/lib .) (in cleanup) Can't locate auto/Win32/ASP/new.al in @INC (@INC contains: C:/Perl/site/lib C:/Perl/lib .)

/extranet/perl/desktop2/source/funcoes.asp, linha 27

Line 27: my $Server = Win32::ASP->new;

Code

my $Server = Win32::ASP->new; 
sub conectar() 
{ 
	$conexao = $Server->CreateObject("ADODB.Connection"); 
	$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.web2.eti.br; DATABASE=romaimoveis;UID=romaimoveis;PWD=fuzzy24k; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;"); 
	if($conexao->Errors->{Count} > 0) { 
        print("erro na transaçăo com o banco"); 
        print($conexao->Errors(0)); 
	}  
}

(This post was edited by web2solutions on Sep 18, 2010, 10:06 AM)

web2solutions
Novice

Sep 18, 2010, 3:54 PM

Post #11 of 12 (1295 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

Observe that when a use the connection outside of package it the recordset works fine, but, on the end of file, I'm calling login method of desktop (with a recordset encapsulated) and I got errors when I execute the file:

http://localhost/extranet/perl/desktop2/source/desktopnew.asp

Error:

enviado
06199719680 enviado
enviado
enviado
PerlScript Error erro '80004005'

(in cleanup) Can't call method "CreateObject" on an undefined value

/extranet/perl/desktop2/source/desktopnew.asp, linha 68

---> desktopnew.asp

Code

<%@ LANGUAGE = PerlScript%> 
<% 
use Win32::ASP; 
use DBI; 
use Date::Day; 
use Win32::OLE; 
use Date::Language; 
use Business::BR::CPF; 
use Digest::MD5 qw(md5_hex); 
use JSON; 
use Win32::OLE::Const; 
 
 
sub conectar() 
{ 
	$conexao = $Server->CreateObject("ADODB.Connection"); 
	$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.web2.eti.br; DATABASE=romaimoveis;UID=romaimoveis;PWD=fuzzy24k; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;"); 
	if($conexao->Errors->{Count} > 0) { 
        print("erro na transaçăo com o banco"); 
        print($conexao->Errors(0)); 
	}  
} 
sub desconectar() 
{ 
	$conexao->Close(); 
} 
 
 
 
conectar(); 
 
 
		$RS = $conexao->Execute( "SELECT * FROM tbl_clientes WHERE ativo=1;" ); 
		if (! $RS->{EOF}) 
		{ 
			$i=0; 
			while ( ! $RS->{EOF} ) 
			{ 
				 
				print $RS->Fields("celular")->{Value}." enviado"; 
				print "<BR>"; 
				$Response->Flush(); 
				$i++; 
			$RS->MoveNext(); 
			}; 
		} 
		 
 
{package  Desktop; 
	 
		sub esta_logado { 
		   
		} 
		 
		sub login { 
			$usuario = $_[1]; 
			$senha = $_[0]; 
			$json = ""; 
 
			if(not defined($usuario) or not length($usuario)) 
			{ 
				$json = "{errors:[{id:'user', msg:'Campo obrigatório'}]}"; 
			} 
			elsif(not defined($usuario) or not length($usuario)) 
			{ 
				$json = "{errors:[{id:'pass', msg:'Campo obrigatório'}]}"; 
			}else 
			{ 
					$conexao = $Server->CreateObject("ADODB.Connection"); 
					$conexao->Open("DRIVER={PostGreSQL UNICODE};SERVER=pgsql.web2.eti.br; DATABASE=romaimoveis;UID=romaimoveis;PWD=fuzzy24k; OPTION=3; set lc_monetary=pt_BR; set lc_numeric=pt_BR; set lc_time=pt_BR; SET datestyle TO POSTGRES, DMY;"); 
					$sql="select login from tbl_usuarios WHERE login='$usuario';"; 
					$RS = $conexao->execute($sql); 
					if ($RS->{EOF}) 
					{ 
						$json = "{errors:[{id:'user', msg:'Usuario nao encontrado'}]}"; 
					}else 
					{ 
						$criptsenha = $senha; 
						$sql="select login,senha from tbl_usuarios WHERE login='$usuario' AND senha='$criptsenha';"; 
						$RS1 = $conexao->execute($sql); 
						if ($RS1->{EOF}) 
						{ 
							$json = "{errors:[{id:'pass', msg:'Senha incorreta'}]}"; 
						}else 
						{ 
							$sql="select login,senha from tbl_usuarios WHERE login='$usuario' AND senha='$criptsenha';"; 
							$RS2 = $conexao->execute($sql); 
							if ( ! $RS2->{EOF}) 
							{ 
								$usuarioid = $RS2->Fields("id")->{Value}; 
								$usuariotipo = $RS2->Fields("tipo")->{Value}; 
								$usuariologin = $RS2->Fields("login")->{Value}; 
								$usuarionome = $RS2->Fields("nome")->{Value}; 
								$usuariosenha = $RS2->Fields("senha")->{Value}; 
								$usuariopermissoes = $RS2->Fields("permissoes")->{Value}; 
								 
								## Gera cookie de login 
								$Response->{Cookies}{w2desktop_aplicativo}{user_logado} = true; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_nome} = $usuarionome; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_login} = $usuariologin; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_pass} = $usuariosenha; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_id} = $usuarioid; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_tipo} = $usuariotipo; 
								$Response->{Cookies}{w2desktop_aplicativo}{logon_time} = ""; 
								$Response->{Cookies}{w2desktop_aplicativo}{user_permissoes} = $usuariopermissoes; 
								$Response->{Cookies}{w2desktop_aplicativo}{NOMEAPLICACAO} = $software." ".$modelo." ".$versao; 
								 
								 
								 
								 
								 
								## retorna json para a RIA 
								$json = "{success:true, key:'', username:'$usuariologin', name:'$usuarionome', type:'$usuariotipo'}\n"; 
							}else 
							{ 
								$json = "{errors:[{id:'user', msg:'Falha ao efetuar login'}]}"; 
							} 
							$RS2->Close(); 
						} 
						$RS1->Close(); 
					} 
					$RS->Close(); 
			} 
			return $json; 
		} 
		 
		sub logout { 
			 
		} 
		 
}	 
 
 
print Desktop->login('eduardo', 'demo'); 
%>

could anybody help me?

(This post was edited by web2solutions on Sep 18, 2010, 3:56 PM)

web2solutions
Novice

Sep 18, 2010, 8:14 PM

Post #12 of 12 (1284 views)

Re: [web2solutions] ASP x PerlScript why not getting right value? [In reply to]	Can't Post

lol .... I got it .... I change ADO API to DBI, it's not that I wanted, but works.

Thanks you all

Search for (options)

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives


	MAIN INDEX	SEARCH POSTS	WHO'S ONLINE	LOG IN