Δημιουργία Action φόρμας

Ο κώδικας που ακολουθεί δημιουργεί ένα πρόγραμμα σε γλώσσα perl για την αποστολή των αποτελεσμάτων μιας φόρμας με email και για την ταυτόχρονη αποθήκευσή τους σε ένα delimited αρχείο κειμένου το οποίο μπορεί στη συνέχεια μπορεί εύκολα να εισαχθεί σε μια βάση δεδομένων.

#!/usr/bin/perl -wT
use strict;
# Oi aparaithtes metablhtes gia kathe perl programma. (To -T einai aparaithto mono gia CGI)

use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
my $q = new CGI;

$| = 1;
print "Content-type: text/html\n\n";
open (STDERR, ">&STDOUT");
# Me ta parapano kano redirect ta lathi sthn othonh toy browser
# kai den meno se ayto to asxeto Premature end of script headers:

#############################################
# Variable Declaration
#############################################

my $name;
my $mail;
my $text;
# Ta stoixeia poy dinei o xrhsths.

my $subject;
# To subject toy mail poy lambanei o diaxeirisths ths formas.

my $reply;
# H apanthsh poy tha lambanei opoios symplhronei th forma.

my $mymail = 'gepiti@gepiti.com';
# To mail paralabhs ton mhnymaton

my $content = '';
# Ta stoixeia poy edose o xrhsths formarismena gia apothikeysh sto sxetiko arxeio.

my $savefile = '/VH/www.eeei.gr/html/eexiseminar/user1.txt';
# To arxeio apothikeyshs ton dedomenon.

#############################################
# Kyrios programma
#############################################

&print_start_page;

if ($q->param()) {
     &set_variables;
     if (defined($name)) {
          $content .= $name . '|';
      }
      else {
           $content .= 'noname' . '|';
      }
      if (defined($mail)) {
           $content .= $mail . '|';
      }
      else {
           $content .= 'nomail' . '|';
      }

      if (defined($text)) {
           $content .= $text;
      }
      else {
           $content .= 'notext' . '|';
      }
      &send_html_mail($mymail, $subject, $content);
      $content =~ s/\s+/ /g;

      open (DATAFILE, ">>", $savefile) or die "can't open $savefile $!";
# open (DATAFILE, ">>:utf8", $savefile) or die "can't open $savefile $!";
# Kodikas gia apothikeysh unicode text.
      print DATAFILE "$content\n";
      close(DATAFILE);

# binmode STDOUT, ":utf8";
# Kodikas gia output se unicode.
      print "<div align=center><h2>Thank You</h2>";
      print "$reply</div>";
}
&print_end_page;

#############################################
# Yporoytines
#############################################

sub print_start_page {
print header (-charset=>'ISO-8859-7',
-expires=>'-1d');

print "<html><head><meta http-equiv=\"expires\" content=\"now\"><meta http-equiv=Content-Type content=\"text/html; charset=windows-1253\"><title>Test form</title></head>";
print "<body bgcolor=\"white\">";
}

sub print_end_page {
# Oi footers telous ths web selidas
print "</body></html>";

}

sub send_html_mail {
# Routina apostolhs email.
use MIME::Lite;

      my $to = shift;
      my $subject = shift;
      my $content2 = shift;
      my $from = 'gepiti@gepiti.com';
      my $ServerName = 'localhost';

my $message = MIME::Lite->new(From => $from, To=>$to, 'Reply-To' => $from, 'Return-Path' => $from, Sender => $from, Type => 'text/html; charset=windows-1253', Subject => $subject, Data => $content2 );

$message->send('smtp',"$ServerName");
}

sub set_variables {
# Dino times stis metablhtes gia na mporo meta na tis diaxeiristo. Epishs diaxeirizomai
# (etoimazo) diafora stoixeia

      $name = $q->param('name');
      $name =~ s/\|/ /g;
# utf8::decode($name);
# Kodikas gia input se unicode text.
      $mail = $q->param('mail');
      $mail =~ s/\|/ /g;
      $text = $q->param('text');
      $text =~ s/\|/ /g;
# Diagrafetai o delimiter oste an kapoios xrhsths ton exei prosthesei sto keimeno toy
# na mhn mperdeytei h efarmogh.
      $subject = $q->param('subject');
      $reply = $q->param('reply');
}

Τρέχουσα Ενότητα: Perl

Φιλικά - συνεργαζόμενα sites: Left Handed Products