[Ajuda] em script Perl

NightscreaM

NightscreaM

Power Member
Boas gente ;)

precisava aqui de uma juda num script cgi que tenho que fazer, ainda estou um bocado nabo nisto.. ele está a ter 4 problemas de compilação. O comando de debug perl -w está a indicar as seguintes linhas:

error while executing the error handler: $@[Sat Jan 5 22:57:41 2013] rest.cgi: syntax error at rest.cgi line 60, near ""error" :"
[Sat Jan 5 22:57:41 2013] rest.cgi: syntax error at rest.cgi line 63, near "else"
[Sat Jan 5 22:57:41 2013] rest.cgi: syntax error at rest.cgi line 69, near "}"
[Sat Jan 5 22:57:41 2013] rest.cgi: syntax error at rest.cgi line 86, near "}"
[Sat Jan 5 22:57:41 2013] rest.cgi: Execution of rest.cgi aborted due to compilation errors.

Já verifiquei e não consigo entender onde está o problema, se pudessem dar uma vista de olhos era muito bom :) Segue o script, os erros estão comentados :

Código: 
  #!/usr/bin/perl -w
  
   use CGI;
   use DBI;
   use warnings;
   use JSON;
   use Digest::MD5 qw(md5 md5_hex md5_base64);
   use String::Random;
   use CGI::Carp qw(fatalsToBrowser);
  $CGI::HEADERS_ONCE = 1;
  BEGIN {
     sub carp_error {
        my $error_message = shift;
        my $q = CGI->new;
        print $q->start_html( "Error" ),
               $q->h1( "Error" ),
                $q->p( "Sorry, the following error has occurred: " );
               $q->p( $q->i( $error_message ) ),
                $q->end_html;
        }
      CGI::Carp::set_message( \&carp_error );
}

$cgi = CGI->new;
$request = $ENV{'PATH_INFO'};
if ($request =~ m/register/){
       register();
}

sub register {
        if (length ($ENV{'QUERY_STRING'}) > 0) {
                $BUFFER = $ENV{'QUERY_STRING'};
                @pairs = split(/&/,$buffer);
                foreach $pair (@pairs){
                                ($name, $value) = split(/=/,$pair);
                                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                                $in{$name}= $value;
                }
        }
        $nick=$in{'nick'};
        $key=$in{'key'};

        $db="up060316074";
        $host="localhost";
        $dbh = DBI-> connect("DBI:mysql:database=$db:host=$host","adsasd","asdasd") or die "Can't                       connect to database: $DBI::errstr\n";
        my $json = {};
        my $statement= qq{SELECT * FROM Users WHERE nick=?};
        my $sth= $dbh->prepare($statement) or die $dbh->errstr;
        $sth->execute($nick) or die $sth->errstr;
        (@data)=$sth->fetchrow_array();
        if (@data) {
                $pw=$data[1];
                $slt=$data[2];
                $enc = $key . $slt;
                $realpw=md5_hex($enc);
                if ( $pw eq $realpw ) {
                        $json = {};
                }
                else {
                        $json = {"error" : "Nome ja registado" };                                                      #LINHA60 -- ERRO1
                }
        }
        else {                                                                                                                   #LINHA63 -- ERRO2
                insertNick();
        }
        print $cgi->header(-type => "application/json" , -charset => "utf-8");
        print $json;
        #$dbh ->disconnect;
}                                                                                                                                  #LINHA 69 -- ERRO3               

sub insertNick {
        my $statement = qq{INSERT INTO Users(nick, pass, salt) VALUES(?, ?, ?)};
        my $foo = new String::Random;
        my $salt = $foo->randpattern("CcCn");
        my $calcpass = $key . $salt;
        my $pass = md5_hex($calcpass);
        my $sth= $dbh->prepare($statement) or die $dbh->errstr;
        $sth->execute($nick, $pass, $salt);

        my $json = {};

        print $cgi->header(-type => "application/json" , -charset => "utf-8");
        print $json;

        #$dbh ->disconnect;
}                                                                                                                                      #LINHA 86 -- ERRO4
 
Última edição:
Já há muito tempo que não programo em Perl, mas parece-me que a sintaxe que usas para criar o hash na linha 60 não existe. Em python usa-se ':' para os dicionários, em Perl é '=>' (como tens mais abaixo, aliás).
 
nfk disse:
Já há muito tempo que não programo em Perl, mas parece-me que a sintaxe que usas para criar o hash na linha 60 não existe. Em python usa-se ':' para os dicionários, em Perl é '=>' (como tens mais abaixo, aliás).
Clicar para expandir...

Exacto. Outro pormenor, quando fazes:
Código: 
$json = { "error" => "Nome ja registado" }
Estás a criar uma referência para um hash anónimo. Até pode ser isso que queiras, mas pelo o vejo do teu código, o que pretendes é mesmo um hash como valor:
Código: 
%json = ( "error" => "Nome ja registado" )
Basta mudares os {} para () e o $ para % no my $hash.
 
Obrigado por responderem :)

Ainda não fui testar o que sugeriram pq o servidor onde tenho o script está down, mas ja percebi que a sintaxe estava mal.

Agora, o que eu quero retornar é mesmo um objector JSON, ou seja { "chave" : "valor" }, ou se estiver vazio simplesmente {}...
 
NightscreaM disse:
Obrigado por responderem :)

Ainda não fui testar o que sugeriram pq o servidor onde tenho o script está down, mas ja percebi que a sintaxe estava mal.

Agora, o que eu quero retornar é mesmo um objector JSON, ou seja { "chave" : "valor" }, ou se estiver vazio simplesmente {}...
Clicar para expandir...

TW em MIERSI? :P

Para imprimir fazes assim:

$j = new JSON;
print $j -> encode({error => "Nome já registado"});

Para chamar uma subrotina acho que tens de fazer assim:

&inserirNick

Cumps
 
Última edição:
Inicie sessão ou registe-se para poder participar.
Back
Topo