Foro - Perl en Español

Saludos, soy nuevo en el mundo Perl, tengo una tarea que me pusieron y he estado buscando información pero no la he captado bien. Tengo esta subrutina que tengo que desbloquearla, es una practica con 50 % de la nota. Ayuda, por favor:

sub LockDBFile {

open (MyLOCK, ">$cgi_path/tmp/db.lock");

flock (MyLOCK, LOCK_EX) || die("$!");
$lock->unlock;

}

sub UnlockDBFile {

close(MyLOCK);

}

Bienvenido a los foros de Perl en Español, nehemias.

¿Qué significa "desbloquear" una subrutina?

Gracias, mi hermano, esto es un éxito.

Desbloquear significa anularle el bloqueo, anular el código, hacerlo infuncional, espero haberme explicado.

Felicito al dueño de este foro que es un visionario. Está excelentemente organizado y no hay muchas opciones latinas de calidad, la mayoría de foros están en inglés.

Lo siento, pero sigo sin entenderlo.

Lo que entiendo con "infuncional", o "anular el código", es que deje de funcionar... lo que entonces ya sí que no entiendo nada.

Lo de "bloqueo" puede estar relacionado con las operaciones que hay dentro de la subrutina, que hace uso de la función flock(), para bloquear el acceso al archivo "$cgi_path/tmp/db.lock", pero "desbloquear" quizás haga referencia a que tenemos dos funciones que hacen referencia a un mismo gestor de archivo: MyLOCK, y que lo que nos piden es que ese gestor no sea global.

En fin, que sigo sin entender qué hay que hacer.

¿Puedes darnos un ejemplo o un enlace, en la Wikipedia, al concepto al que te refieres?

Esta es la tarea que nos puso el profesor dejame tratar de explicartelo despues del codigo completo

### *** *** ###
sub OutPut {

open (TEMPLATE, "$docs_path/main-template/default.html") || die($!);

@Template = <TEMPLATE>;

close(TEMPLATE);

foreach $line(@Template) {

$line =~ s/<\!Content_will_print_here>/$my_page/;

$line =~ s/<\!ProgramTitle>/$ProgramTitle/;

$line =~ s/<\!KeyWords>/$KeyWords/;

$line =~ s/<\!MetaDesc>/$Meta_Description/;

$line =~ s/<\!DynamicTitle>/$MyDynTitle/;

$out_lines .= $line;

}

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

print $out_lines;

exit;

} # End Sub
### *** *** ###

sub LockDBFile {

open (MyLOCK, ">$cgi_path/tmp/db.lock");

flock (MyLOCK, LOCK_EX) || die("$!");

}

sub UnlockDBFile {

close(MyLOCK);

}

### *** *** ###
sub parse {

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

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

if ($ENV{'REQUEST_METHOD'} eq "GET") {$FORM = $ENV{'QUERY_STRING'}; }

elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$FORM,$ENV{'CONTENT_LENGTH'}); }

@FORM = split(/[&;]/,$FORM);

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

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

($key, $val) = split(/=/,$FORM[$i],2);

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

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

$val =~ s/`//g;

$val =~ s/<!--(.|\n)*-->//g;

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

$FORM{$key} .= $val;

}

return scalar(@FORM);

} # End sub parse

$copy_w = qq(<Meta>);

### *** *** ###
sub ProcessCode {

$FORM{'JMAIL_Session'} =~ s/\W//g;

$in = $FORM{'JMAIL_Session'};$FORM{'JMAIL_Session'} = substr($in,4,1);$FORM{'JMAIL_Session'} .= substr($in,12,1);$FORM{'JMAIL_Session'} .= substr($in,20,1);$FORM{'JMAIL_Session'} .= substr($in,28,1);$FORM{'JMAIL_Session'} .= substr($in,36,1);$FORM{'JMAIL_Session'} .= substr($in,44,1);$FORM{'JMAIL_Session'} =~ tr/GKEUDXSYCH/0123456789/;

if ($FORM{'JMAIL_Session'} ne $FORM{'JMAIL_Code'}) { &BadCode("The code you entered is incorrect."); }

}

sub GenSession {

#$MyCode = qq(<Font Class="CodeBG"> );

$myphrases = q(AzbC,FrYh,HHyZ,MoIy,YYxI,JhTd,KKyR,OpUd,UyTT,OjUh,KCtR,IItG,KKtQ,GQPm,HTre,JYTH,AeKy,MyRe);

@myphrases=split(/,/, $myphrases);

$myphrases3 = q(ZzC,Mrh,CyZ,TIy,XxI,Bhd,WKR,Ppd,KyT,Mjh,DCR,WIG,PKQ,VQm,STe,AYH,OKy,HRe);

@myphrases3=split(/,/, $myphrases3);

$mycolors = qq(red,green,blue,black,orange,grey,pink,purple,cyan,FDCE42,800040,8000FF,808000,215F57,63381D,2C4954);

@colors=split(/,/, $mycolors);

srand; $r = rand (time); $r =~ s/\.\d+//; $r = substr($r,0,6); @R = split(//, $r); $p = rand $#myphrases; $p =~ s/\.\d+//;

foreach $ranno(@R) {$c = rand($#colors)+1; $c =~ s/\.\d+//; $MyCode .= qq(<Font Class="Code" face="Comic Sans MS" size="4" Color="$colors[$c]">$ranno</Font> ); $FormCode .= qq(<Font Class="Code" face="Comic Sans MS" size="4" Color="$colors[$c]">&nbsp;$ranno&nbsp;</Font> );}

foreach $digit(@R) {$p = rand $#myphrases; $p =~ s/\.\d+//; $out .= $myphrases[$p]; $out .= $digit; $u = rand $#myphrases3; $u =~ s/\.\d+//; $out .= $myphrases3[$u];}

$p = rand $#myphrases; $p =~ s/\.\d+//;$out .= $myphrases[$p]; $u = rand $#myphrases; $u =~ s/\.\d+//;$out .= $myphrases3[$u]; $out =~ tr/0123456789/GKEUDXSYCH/;

#$MyCode .= " <Font>";

} # End Sub
### *** *** ###

sub GenCode {

&GenSession();

$MyHcode = qq(<Input Type=Hidden Name="JMAIL_Session" Value="$out">);

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

print qq(document.write\('$MyCode$MyHcode'\););

exit;

} # End Sub
### *** *** ###

sub GetCode {

&GenSession();

$MyHcode = qq(<Input Type=Hidden Name="JMAIL_Session" Value="$out">);

$FormCode .= qq(<Input Type=Hidden Name="JMAIL_Session" Value="$out"> );

} # End Sub
### *** *** ###


sub CDeSession {

$in = $FORM{'0_Session'};$FORM{'0_Session'} = substr($in,4,1);$FORM{'0_Session'} .= substr($in,12,1);$FORM{'0_Session'} .= substr($in,20,1);$FORM{'0_Session'} .= substr($in,28,1);$FORM{'0_Session'} .= substr($in,36,1);$FORM{'0_Session'} .= substr($in,44,1);$FORM{'0_Session'} =~ tr/GKEUDXSYCH/0123456789/;

if ($FORM{'0_Session'} ne $FORM{'0_Code'}) { &BadCode("The code you entered is incorrect."); }

} # End Sub

OK el profesor monto un programa en un servidor estableciendonos que tenia un bloqueo para que no pudiese usarse en otro ip o dominio, el nos dijo que esta programacion que puse arriba cuando postie es la que bloquea, el codigo que evita que pueda generarse otra base de datos para que funcione el 2do programa instalado en el otro dominio y que la tarea es hacer que funcione en el otro dominio, te repito sus palabras quien haga que funcione tiene los 50 puntos del trabajo practico final.

Dijo algo que nos reimos todos, analicen y estudien que eso es muy facil, SIIIII para el ese abusador, ninguno de los 20 estudiantes ha podido resolverlo, por eso pido su ayuda, si necesitan otra informacion del programa avisemme



### *** *** ###

¡Madre mía, qué programa! Bueno, no es un programa entero, desde luego.

Pero la forma de programar es, más o menos, de 1996. Hoy en día se puede hacer lo mismo con la tercera parte de código.

En cuanto al problema, yo también lo veo fácil. Bueno, como estamos en el foro Avanzado, la respuesta es que tienes que personalizar la base de datos de bloqueo, en el open(). En este momento, se escribe en un sitio fijo, que es el archivo $cgi_path/tmp/db.lock. Eso impide la ejecución de otra instancia de este cgi (sé que es un cgi porque hay una línea con un "Content-Type"). Entonces, lo que hay que hacer es personalizar ese archivo, para que cada petición sea independiente.

Lo que puedes hacer es modificar el nombre del bloqueo con algo que venga personalizado por el usuario o por la petición o por la sesión. Por ejemplo, $FORM{'JMAIL_Session'}. O incluso un simple $$, que equivale al PID del proceso, te vale para generar un bloqueo distinto cada vez. Ese valor se lo agregas o metes dentro del nombre del archivo de bloqueo, y listo.

Pero también me hablas de dominios, entonces la misión es generar un archivo de bloqueo por cada dominio. El nombre del dominio lo sacas de las variables de entorno que el servidor web pasa al CGI. Por ejemplo, $ENV{HTTP_HOST} Más información