[Roma.pm] huge script!Help!

Flavio Poletti flavio at polettix.it
Mon Oct 8 00:39:42 PDT 2007


Ciao,

   questa mailing list è prevalentemente in italiano, quindi non c'è
bisogno di passare all'inglese (anche se non c'è problema).

Personalmente, non ho molta voglia di dare un'occhiata al tuo codice. Le
ragioni sono molteplici:

1. è enorme, e probabilmente il problema sta in un punto ben definito. Se
dici che "connetti()" non viene mai chiamata, perché non provare a levare
buona parte del resto? Più è piccolo il pezzo di codice su cui chiedi di
dare un'occhiata, maggiore sarà la quantità di gente che sarà disposta a
darcela.

2. Il codice non è indentato in maniera decente e si fa *molta* fatica a
leggerlo. Potresti ribattere che si fa molta fatica anche a scriverlo...
ma chi è che deve faticare? :) Inoltre, esistono dei tool che fanno
l'indentazione in maniera automatica, prova ad esempio a cercare perltidy.

3. Il tuo script non utilizza né strict né warnings, e le ragioni per cui
dovrebbe farlo sono qui:
http://www.polettix.it/cgi-bin/wiki.pl/Programming/Dammi_una_mano
Magari non è roba tua, quindi non ne hai colpa, ma fare debugging su
qualcosa del genere è un incubo che non auguro a nessuno, ossia non
abbiamo colpa nemmeno noi.

4. Hai fatto cross-posting
(http://groups.google.com/group/comp.lang.perl.misc/browse_thread/thread/326b9d719cd6290d
http://qaix.com/perl-web-programming/576-227-huge-cgi-help-pop3-client-read.shtml)
e sarebbe stato utile indicarlo, visto che già altra gente ha dato
un'occhiata al tuo script.

Magari altri vorranno comunque darti indicazioni, prendi questi commenti
come dei suggerimenti per farti dare più retta in futuro :)

Ciao,

   Flavio.


> Hi dude! I have an orrible trouble with this poor cgi: is a client
> pop3 web based gateway.The function "connetti()" never been called and
> i don't know why!!The functions in the bottom of the script
> load,save,restore the state of the session by save the
> user,pass,host,id in a file.if you try to execute the script all stop
> when you click on the submit button.
> I hope there is a good soul who help me.
>
> There is the code:
>
> #!/usr/bin/perl -w
>
> use Mail::POP3Client;
> use CGI qw(:all);
> #use CGIBook::Error;
> #use HTML::Template;
>
> local $MAX_FILES = 1000;
> local $DATA_DIR  = 'usr/lib/cgi-bin';
>
> my $q = new CGI;
> my $this_script_name = 'popGem.cgi';
> my $id = get_id($q);
> my $action = ( $q->param("action") ) || 'start';
>
> if ( $action eq "start") {
>
> start($q,$id);
> }
>
> if ( $action eq "connetti" ) {
>
> connetti($q,$id);
> }
>
> sub start {
> my ($q ,$id) = @_;
> print
>         $q-> header(),
>         $q-> start_html(-title => "PopGem pop3 web based reader"),
>         $q-> start_form(-action => $this_script_name ,-method =>
> "post"),
>         $q-> table(
>                  {-border => "1"},
>                   $q->caption("PopGem pop3 web based reader!"),
>                   $q->Tr(
>                         $q-> th("Nome Utente:"),
>                         $q-> th( textfield(-name => "user_name",-size =>
> "30") )
>                         ),
>                   $q-> Tr(
>                         $q-> th("Password:"),
>                         $q-> th( password_field(-name => "password",-size
> =>
> "30") )
>                         ),
>                   $q-> Tr(
>                         $q-> th("Nome Server:"),
>                         $q-> th( textfield(-name => "domain_name",-size =>
> "30") )
>                         ),
>                   $q-> Tr(
>                         $q-> th({-rowspan => "2"},
>                         $q-> submit(-value => "connetti") )
>                         ),
>                 $q->hidden(
>               -name     => "id",
>               -default  => $id,
>               -override => 1
>                         ),
>                 $q->hidden(
>               -name     => "action",
>               -default  => "connetti",
>               -override => 1
>                         )
>                         ),
>         $q-> end_form(),
>         $q-> end_html();
>         save_state($q);
> }
>
> sub connetti {
>
> my ($q,$id) = @_;
> my $user_name   = param('user_name');
> my $password    = param('password');
> my $domain_name = param('domani_name');
> #per ogni messaggio che è presente nella mailbox stampo una riga di
> una tabella
> #con le informazioni utili: mittente,oggetto,ecc...
>
> my $pop = new Mail::POP3Client ( USER         => $user_name,
>                                  PASSWORD     => $password,
>                                  HOST         => $domain_name,
>                                  AUTH_MODE    => 'PASS' );
>
> for ($i = 1; $i <= $pop->Count(); $i++) {
>
> foreach my $message ( $pop->Head($i) ){
>
> my $date    = ($message =~ /^Date:\s+/i);
> my $from    = ($message =~ /^From:\s+/i);
> my $to      = ($message =~ /^To:\s+/i);
> my $subject = ($message =~ /^Subject:\s+/i);
> print      $q-> header(),
>            $q-> start_html(-title => "Ecco i messaggi"),
>            $q-> table(
>                  {-border => "1"},
>                   $q->caption("Informazioni del messaggio $i:"),
>                   $q->Tr(
>                         $q-> th("Date:"),
>                         $q-> th("From:"),
>                         $q-> th("To:"),
>                         $q-> th("Subject:")
>                         ),
>                   $q->Tr(
>                         $q-> th("$date"),
>                         $q-> th("$from"),
>                         $q-> th("$to"),
>                         $q-> th("$subject")
>                         )
>                         ),
>            $q-> end_html();
>         $q-> save_state($q);
> }
> }
> }
>
> sub get_id {
>     my $q = shift;
>     my $id;
>
>     my $unsafe_id = $q->param( "id" ) || '';
>     $unsafe_id =~ s/[^\dA-Fa-f]//g;
>
>     if ( $unsafe_id =~ /^(.+)$/ ) {
>         $id = $1;
>         load_state( $q, $id );
>     }
>     else {
>         $id = unique_id(  );
>         $q->param( -name => "id", -value => $id );
>     }
>
>     return $id;
> }
>
> # Loads the current CGI object's default parameters from the saved
> state
> sub load_state {
>     my( $q, $id ) = @_;
>     my $saved = get_state( $id ) or return;
>
>     foreach ( $saved->param ) {
>         $q->param( $_ => $saved->param($_) ) unless defined $q-
>>param($_);
>     }
> }
>
> # Reads a saved CGI object from disk and returns its params as a hash
> ref
> sub get_state {
>     my $id = shift;
>     my $session = session_filename( $id );
>     local *FILE;
>
>     -e $session or return;
>     open FILE, $session or die "Cannot open $session: $!";
>     my $q_saved = new CGI( \*FILE ) or
>         error( $q, "Unable to restore saved state." );
>     close FILE;
>
>     return $q_saved;
> }
>
> # Saves the current CGI object to disk
> sub save_state {
>     my $q = shift;
>     my $session = session_filename( $id );
>     local( *FILE, *DIR );
>
>     # Avoid DoS attacks by limiting the number of data files
>     my $num_files = 0;
>     opendir DIR, $DATA_DIR;
>     $num_files++ while readdir DIR;
>     closedir DIR;
>
>     # Compare the file count against the max
>     if ( $num_files > $MAX_FILES ) {
>         error( $q, "We cannot save your request because the directory
> " .
>                    "is full. Please try again later" );
>     }
>
>     # Save the current CGI object to disk
>     open FILE, ">> $session" or return die "Cannot write to $session:
> $!";
>     $q->save( \*FILE );
>     close FILE;
> }
>
> # Separated from other code in case this changes in the future
> sub session_filename {
>     my $id = shift;
>     return "/$DATA_DIR/$id";
> }
>
> sub unique_id {
>     # Use Apache's mod_unique_id if available
>     return $ENV{UNIQUE_ID} if exists $ENV{UNIQUE_ID};
>
>     require Digest::MD5;
>
>     my $md5 = new Digest::MD5;
>     my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT};
>     # Note this is intended to be unique, and not unguessable
>     # It should not be used for generating keys to sensitive data
>     my $id = $md5->md5_base64( time, $$, $remote );
>     $id =~ tr|+/=|-_.|;  # Make non-word chars URL-friendly
>     return $id;
> }
> _______________________________________________
> Roma mailing list
> Roma at pm.org
> http://mail.pm.org/mailman/listinfo/roma




More information about the Roma mailing list