Exemples de CGI en perl

Script minimal

#!/usr/bin/perl

use CGI;

$cgi=new CGI;

print $cgi->header;
print $cgi->start_html('hello world !');
print $cgi->h1('hello world !');
print $cgi->end_html;

Formulaire

C'est le script qui sert à la fois de formulaire et de réponse au formulaire.

#!/usr/bin/perl

use CGI ':standard';

print header;
print start_html('Gestion de formulaire'),
    h1('Gestion de formulaire'),
    start_form,
    "Quel est votre nom ? ",textfield('name'),
    p,
    "Que voulez-vous sur votre pizza?",
    p,
    checkbox_group(-name=>'toppings',
                   -values=>['fromage','tomate','jambon','chamapigons','oeuf','pepperoni'],
                   -defaults=>['fromage','tomate']),
    p,
    "Livraison ? ",
    popup_menu(-name=>'delivery',
               -values=>['a domicile','sur place',]),
    p,
    submit,
    end_form,
    hr;

if (param()) {
    print 
        "Votre nom est: ",em(param('name')),
        p,
        "Vous avez choisi: ",em(join(", ",param('toppings'))),
        p,
        "Livraison : ",em(param('delivery')),
        hr;
}

print end_html;

Écrire dans un fichier

Outil indispensable pour le livre d'or et le système de vote

Il faut noter qu'un même script CGI peut être exécuté par deux utilisateurs du site web en même temps, donc lorsque le script doit écrire dans un fichier, il faut penser à verrouiller ce fichier jusqu'à ce que la modification du fichier soit terminée. On peut utiliser pour celà un fichier verrou : lorsque le fichier existe c'est que le verrou est posé...

Les fonctions de verrou

Elles prennent un paramètre, qui est le nom du fichier de verrrou. La première pose le verrou, la seconde le relache.

sub get_file_lock
  {
  local ($lock_file) = @_;
  local ($timeout);

  $timeout=20;    # in seconds
  while (-e $lock_file && (stat($lock_file))[9]+$timeout>time)
  { sleep(1);}
                              
  open(LOCK_FILE, ">$lock_file") || die "Can't open $lock_file:$!);
}                           }

sub release_file_lock
  {
  local ($lock_file) = @_;

  close(LOCK_FILE);
  unlink($lock_file);
  }

Le code qui utilise le verrou

my $file = "filename";       # specify the filename to open
open FH, "+<$file" or die "Cannot open $file: $!";
get_file_lock("verrou");     # wait for exclusive lock
## from here to the close FH, we have critical region
## be sure to minimize this time

## get current content
seek FH, 0, 0;               # rewind to beginning
my @content = <FH>;          # get current content

<Change your @content lines here>

## write new list, and release file
seek FH, 0, 0;               # rewind again
truncate FH, 0;           # empty the file
print FH @content;           # print the new content

## release file
close FH;
# unlock
release_file_lock("verrou");

Note : ce système de verrou n'est pas complètement parfait (inutile d'entrer dans les détails) mais presque. Allez voir cette page pour plus d'infos.

Compteur

(source complet) Ce compteur n'utilise pas le module CGI. Il faut mettre dans la page concernée le code HTML <IMG SRC="/cgi-bin/compteur.pl">, ou bien <IMG SRC="/cgi-bin/compteur.pl?page1.txt"> pour avoir des compteurs différents sur chaque page

Attention : le fichier de compteur doit être inscriptible par le CGI.

Note : ce script CGI devrait utiliser un verrou pour bien fonctionner...

#!/usr/bin/perl

$fichiercompteur='count.txt';
@referers=('.unice.fr');

if (length($ENV{'QUERY_STRING'}) > 1) {
  $fichiercompteur=$ENV{'QUERY_STRING'} ;
}
## Vérifie que l'appel vient bien de votre site ##
&verifie_referer;
## INITIALISATION ##
&init;
## Augmente le compteur de 1 ##
&incremente_compteur;
## Construction de l'image à renvoyer, format xbm ##
&creation_bitmap;
## Envoi de l'image ##
&renvoi_bitmap;
1;

#######################################################
sub renvoi_bitmap {
  print ("Content-type: image/x-xbitmap\n\n");  #x-xbitmap
... #ecrit l'image contenue dans @bytes au format xbm
}                                              # et voilà, l'image est créée
#######################################################
sub creation_bitmap {
... # place dans @bytes une image du nombre $nbvisites
}
#######################################################
sub incremente_compteur {
  if (-e $fichiercompteur) {                  # si le fichier compteur existe
    open(COMPTEUR,"$fichiercompteur")
      || die("Impossible d\'ouvrir $fichiercompteur : $!\n");
    $nbvisites = <COMPTEUR>;
    chop $nbvisites;     # enlève le retour à la ligne en fin de ligne
    close(COMPTEUR);     # ferme le fichier
  } else {               # le fichier n'existe pas encore
    $nbvisites = 0;
  }

  $nbvisites++;        # incrémente le nombre de visites
  open(COMPTEUR,">$fichiercompteur")
    || die ("impossible d\'ouvrir $fichiercompteur: $!\n");
  print (COMPTEUR "$nbvisites     \n"); # ecrit le nouveau nb de visites ou
                                        # créé le fichier s'il n'existait pas
  close(COMPTEUR);     # ferme le fichier
}
#######################################################
sub init {
... #initialisation de variables contenant les images des chiffres
}
###############################################
sub verifie_referer {
  if (@referers && $ENV{'HTTP_REFERER'}) {
    foreach $referer (@referers) {
      if ($ENV{'HTTP_REFERER'} =~ /$referer/) {
        $ref = 1;
        last;
      }
    }
  }
  else {
    $ref = 1;
  }
  if ($ref != 1) {die('bad referer');}
}