diff --git a/webcgi/eurocampo/Makefile b/webcgi/eurocampo/Makefile new file mode 100755 index 000000000..c39b8c043 --- /dev/null +++ b/webcgi/eurocampo/Makefile @@ -0,0 +1,21 @@ +# Makefile + +# Decommentare il seguente per includere le informazioni di debug +#CFLAGS=-Wall -g + + +# Usare il seguente per non includere le informazioni di debug +CFLAGS=-Wall -O2 -fomit-frame-pointer +PGINCLUDE=/usr/local/pgsql/include +PGLIB=/usr/local/pgsql/lib +OBJDIR=../obj/ + + +all: cvs2sql + +$(OBJDIR)cvs2sql.o: cvs2sql.c + gcc $(CFLAGS) -c cvs2sql.c -o $(OBJDIR)cvs2sql.o -I$(PGINCLUDE) + +cvs2sql: $(OBJDIR)cvs2sql.o + gcc $(CFLAGS) -o cvs2sql $(OBJDIR)cvs2sql.o -lpq -L$(PGLIB) + diff --git a/webcgi/eurocampo/cvs2sql.c b/webcgi/eurocampo/cvs2sql.c new file mode 100755 index 000000000..ff9c9f6fd --- /dev/null +++ b/webcgi/eurocampo/cvs2sql.c @@ -0,0 +1,131 @@ +/* + CVS2SQL + Programma interfacciabile a CVS tramite loginfo, per registrare i commit su di un database POSTGRES. + L'applicazione dovra' essere eseguita sul server nel quale risiede il repository (Etabeta) + Le informazioni da registrare sulla tabella COMMITS, vengono reperite in 3 modi: + - dallo stdin per quanto riguarda il log file vero e proprio: [Release] [Descrizione] [Errori] [Files] + - variabile d'ambiente per l'autore ($USER) + - linea di comando per quanto riguarda il nome del modulo. + + Sarebbe bello farlo in C++ ma su etabeta gcc e' installato male e non funziona. + Altrettanto bello sarebbe potere usare cvs2sql presente nelle libwww: http://dev.w3.org/cvsweb/libwww/Library/cvs2sql + Ma per fare cosi' e' necessario scaricarle e compilarle. E per compilare un programmino del cavolo non voglio includere nel + repository tutta quella roba. + */ + +#include +#include + + +#define POSTGRES_HOST "mccoy" +#define POSTGRES_PORT "" +#define POSTGRES_DB "eurocampo" +#define DEFAULT_USER "Aga Informatica" +#define BUFSIZE 16384 + + + +void cvs2sql(char* modulo) +{ + FILE *fin=stdin; + int status; + char autore[20]; + char release[20]; + char buffer[BUFSIZE]; + char files[BUFSIZE/4]; + char descrizione[BUFSIZE/4]; + char errori [BUFSIZE/4]; + char committed_files[BUFSIZE/2]; + char *p1, *p2, *p3; + PGconn* pgc; + + + /* Sistema l'autore della modifica, prendendolo dalla variabile d'ambiente*/ + strcpy(autore,getenv("USER")); + if (strlen(autore) == 0) + strcpy(autore, "Aga Informatica"); + + /* Legge dallo stdin il log file, 16 KB sono abbastanza per un log...*/ + status = fread(buffer, 1, BUFSIZE, fin); + if (status < 0) + { + printf("Can't read from stdin\n"); + return; + } + /* Legge le informazioni sui files modificati, aggiunti, cancellati */ + strcpy(committed_files, ""); + p1 = strstr(buffer, " Files:"); + if (p1 != NULL) + { + int l; + p2 = strrchr(p1, '\n'); + p2++; + p1 = strstr(p2, "Log Message:"); + *p1 = '\0'; + l = (int) (p2 - p1); + strncpy(committed_files, p2, l); + p1 += 13; + } + /* Legge il paragrafo di release */ + p2 = strstr(p1 ? p1 : buffer,"[Release]"); + if (p2 != NULL) + { + p2++; + p1 = strchr(p2, '\n'); + *p1 = '\0'; + strcpy(release, p2); + p1++; + } + p2 = strstr(p1 ? p1 : buffer, "[Files]"); + if (p2 != NULL) + { + p2 += 7; + strncpy(files, p2, ); + } + p2 = strstr(p1 ? p1 : buffer, "[Descrizione]"); + if (p2 != NULL) + { + } + p2 = strstr(p1 ? p1 : buffer, "[Errori]"); + if (p2 != NULL) + { + } + + /* Apre la connessione sul database, inizia una transazione, bloccando la tabella dei progressivi per gestire la concorrenza */ + pgc = PQsetdb(POSTGRES_HOST, POSTGRES_PORT, NULL, NULL, POSTGRES_DB); + if (PQstatus(pgc)==CONNECTION_OK) + { + } + else + printf("FATAL ERROR: Can't open database %s: %s\n", POSTGRES_DB, PQerrorMessage(pgc)); + PQfinish(pgc); +} + + +int main(int argc, char* argv[]) +{ + if (argc == 2) + cvs2sql(argv[1]); + else + printf("Usage: cvs2sql \nWarning: $USER environment variable must also be set \nand a log file must be written on stdin.\n"); + exit(0); +} + + + + + + + + + + + + + + + + + + + diff --git a/webcgi/eurocampo/documentazione.doc b/webcgi/eurocampo/documentazione.doc index aafd4f8b5..f3a3dd4dc 100755 Binary files a/webcgi/eurocampo/documentazione.doc and b/webcgi/eurocampo/documentazione.doc differ diff --git a/webcgi/formazione/check_answers.cpp b/webcgi/formazione/check_answers.cpp index a0f048203..daf2ed84f 100755 --- a/webcgi/formazione/check_answers.cpp +++ b/webcgi/formazione/check_answers.cpp @@ -27,7 +27,10 @@ protected: void print_access_error(); bool load_corrector(); public: - Check_answers_Application() {_db = NULL;} + Check_answers_Application() + { + _db = NULL; + } virtual ~Check_answers_Application() {}; }; diff --git a/webcgi/formazione/defines.h b/webcgi/formazione/defines.h index 93804a157..47efa021a 100755 --- a/webcgi/formazione/defines.h +++ b/webcgi/formazione/defines.h @@ -1,52 +1,52 @@ - -#ifndef _DEFINES_H -#define _DEFINES_H - -#include -#include -#include -#include -#include -#include -#include - - -#define POSTGRES_HOST "localhost" -#define POSTGRES_PORT "" -#define POSTGRES_DB "corsi" -#define FAD_DIR "/corsi/" -#define FAD_ROOT "/disk2/html/corsi/corso_" -#define FAD_CGI FAD_DIR"cgi-bin/" -#define GET_MODULE_CGI FAD_CGI"get_module.cgi" -#define LOGIN_CGI FAD_CGI"login.cgi" -#define LOGOUT_CGI FAD_CGI"logout.cgi" -#define CHECK_ANSWERS_CGI FAD_CGI"check_answers.cgi" -#define MAXMODULES 64 -#define MAXQUESTIONS 20 -#define MAXANSWERS 5 -#define ERROR_FILE "__error" // File fittizio per segnalare gli errori - -static Rational ZERO(0); - -#ifdef __cplusplus -extern "C" { -#endif -void getword(char *word, char *line, char stop); -char *makeword(char *line, char stop); -char *fmakeword(FILE *f, char stop, int *cl); -char x2c(char *what); -void unescape_url(char *url); -void plustospace(char *str); -int rind(char *s, char c); -int getline(char *s, int n, FILE *f); -void send_fd(FILE *f, FILE *fd); -off_t fsize(const char* n); -char * itoa(int); -char * ltoa(long); -char * dtoa(double); -void trim(String& s); -#ifdef __cplusplus - } -#endif - -#endif + +#ifndef _DEFINES_H +#define _DEFINES_H + +#include +#include +#include +#include +#include +#include +#include + + +#define POSTGRES_HOST "localhost" +#define POSTGRES_PORT "" +#define POSTGRES_DB "corsi" +#define FAD_DIR "/corsi/" +#define FAD_ROOT "/disk2/html/corsi/corso_" +#define FAD_CGI FAD_DIR"cgi-bin/" +#define GET_MODULE_CGI FAD_CGI"get_module.cgi" +#define LOGIN_CGI FAD_CGI"login.cgi" +#define LOGOUT_CGI FAD_CGI"logout.cgi" +#define CHECK_ANSWERS_CGI FAD_CGI"check_answers.cgi" +#define MAXMODULES 64 +#define MAXQUESTIONS 20 +#define MAXANSWERS 5 +#define ERROR_FILE "__error" // File fittizio per segnalare gli errori + +static Rational ZERO(0); + +#ifdef __cplusplus +extern "C" { +#endif +void getword(char *word, char *line, char stop); +char *makeword(char *line, char stop); +char *fmakeword(FILE *f, char stop, int *cl); +char x2c(char *what); +void unescape_url(char *url); +void plustospace(char *str); +int rind(char *s, char c); +int getline(char *s, int n, FILE *f); +void send_fd(FILE *f, FILE *fd); +off_t fsize(const char* n); +char * itoa(int); +char * ltoa(long); +char * dtoa(double); +void trim(String& s); +#ifdef __cplusplus + } +#endif + +#endif diff --git a/webcgi/formazione/get_module.cpp b/webcgi/formazione/get_module.cpp index 64cac0dbf..c6940dfd0 100755 --- a/webcgi/formazione/get_module.cpp +++ b/webcgi/formazione/get_module.cpp @@ -90,7 +90,7 @@ void Get_module_Application::print_header(const char * title) cout << "" << endl; cout << "" << title << "" << endl; cout << "" << endl; - cout << "" << endl; + cout << "" << endl; cout << "" << endl; } @@ -214,10 +214,12 @@ void Get_module_Application::get_module() if (first_test){ cout << "

Questionario iniziale non implementato



" << endl; cout << "

Il questionario iniziale per il modulo selezionato non è presente.


"; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } else { cout << "

Modulo non implementato



" << endl; cout << "

I materiali didattici per il modulo selezionato non sono presenti.


"; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } break; case get_test: @@ -225,23 +227,27 @@ void Get_module_Application::get_module() print_header("Accesso al livello di test non consentito"); cout << "

Accesso al livello di test non consentito



" << endl; cout << "

L'utente " << _utente << " non ha i permessi necessari per accedere al livello di test richiesto oppure il test è già stato svolto.


" << endl; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } else { print_header("Questionario non ancora implementato"); cout << "

Questionario non ancora implementato



" << endl; cout << "

Il questionario per il modulo selezionato non è presente.


"; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } break; case get_lesson: if (filename == ERROR_FILE) { print_header("Accesso alla lezione non consentito"); cout << "

Accesso alla lezione non consentito



" << endl; - cout << "

L'utente " << _utente << " non ha i permesso necessari per accedere al livello di lezione richiesto.


" << endl; + cout << "

L'utente " << _utente << " non ha i permessi necessari per accedere al livello di lezione richiesto.


" << endl; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } else { print_header("Lezione non ancora implementata"); cout << "

Lezione non ancora implementata



" << endl; cout << "

La lezione per il modulo selezionato non è presente.


"; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; } break; } @@ -252,6 +258,7 @@ void Get_module_Application::get_module() print_header("Accesso al modulo non consentito"); cout << "

Accesso al modulo non consentito



" << endl; cout << "

L'utente "<< _utente << " non ha i permessi necessari per accedere al modulo indicato.


"; + cout << "

Per ritornare alla pagina iniziale del modulo premete il pulsante INDIETRO del vostro browser o cliccate qui.


"; print_footer(); } } diff --git a/webcgi/formazione/login.cpp b/webcgi/formazione/login.cpp index f450b1df0..35fa07120 100755 --- a/webcgi/formazione/login.cpp +++ b/webcgi/formazione/login.cpp @@ -108,13 +108,17 @@ void Login_Application::login() cout << "

Benvenuto/a, " << _realname << ".

" << endl; cout << "

Ecco l'elenco dei moduli disponibili, clicca sull'immagine relativa al modulo per entrare nell'area di formazione prescelta. Si ricorda che i moduli contraddistinti da una piccola spirale fanno parte delle lezioni avanzate.

" << endl; const int nt = _db->Tuples(); + if (nt > 0) { // Seleziona i moduli abilitati per costui cout << "
" << endl; int curr_module=0; for (int i=0; iGetValue(i, "modulenum"))-1; - if (_moduli.length() > mod_num+1 && _moduli[mod_num] == 'X') { // Se il modulo e' abilitato visualizza + const char *mod_name = _db->GetValue(i, "modulename"); + bool cafe; + cafe = (strncmp(mod_name,"cafe",4)==0); + if (_moduli.length() > mod_num+1 && _moduli[mod_num] == 'X' && (!cafe)) { // Se il modulo e' abilitato e non rappresenta una class cafe visualizza le icone relative const bool new_row = curr_module % 2 == 0; curr_module++; if (new_row) diff --git a/webcgi/formazione/logout.cpp b/webcgi/formazione/logout.cpp index 11f57b61d..96e2b0fc1 100755 --- a/webcgi/formazione/logout.cpp +++ b/webcgi/formazione/logout.cpp @@ -50,16 +50,30 @@ void Logout_Application::logout() command += "' AND logged='t'"; _db->ExecCommandOk(command); const int tuples = _db->Tuples(); - if (tuples > 0) { // E' loggato oppure no... + if (tuples > 0) + { // E' loggato oppure no... // Cosa deve fare: // Sistema le informazioni di logging dell'utente (anche sulla tabella ACCESSI) String progressivo; - progressivo = _db->GetValue(0, "progaccesso"); - command = "UPDATE UTENTI SET logged=0, logindate=null "; - command += " WHERE loginname='"; - command += _utente; - command += "'"; - _db->ExecCommandOk(command); // Aggiorna la tabella utenti + if (strncmp(_utente,"demo", 4)==0) + { +//Se l'utente è un utente dimostrativo cancella i dati relativi alle verifiche effettuate dalla tabella UTENTI + progressivo = _db->GetValue(0, "progaccesso"); + command = "UPDATE UTENTI SET logged=0, logindate=null , verifiche= '' "; + command += " WHERE loginname='"; + command += _utente; + command += "'"; + _db->ExecCommandOk(command); + } + else + { + progressivo = _db->GetValue(0, "progaccesso"); + command = "UPDATE UTENTI SET logged=0, logindate=null "; + command += " WHERE loginname='"; + command += _utente; + command += "'"; + _db->ExecCommandOk(command); // Aggiorna la tabella utenti + } command = "UPDATE ACCESSI SET logoutdate=current_timestamp WHERE loginname='"; command += _utente; command += "' AND progressivo="; diff --git a/webcgi/formazione/makefile b/webcgi/formazione/makefile index c3262b127..79fae2b02 100755 --- a/webcgi/formazione/makefile +++ b/webcgi/formazione/makefile @@ -9,6 +9,7 @@ CFLAGS=-Wall -O2 -fomit-frame-pointer PGINCLUDE=/usr/local/pgsql/include PGLIB=/usr/local/pgsql/lib INSTALLDIR=/disk2/html/corsi/cgi-bin +OBJDIR=../obj/ all: login.cgi logout.cgi get_module.cgi check_answers.cgi report.cgi html_parser score_corrector @@ -19,55 +20,55 @@ install: all install -m 750 -o nobody -g nobody -s check_answers.cgi $(INSTALLDIR) install -m 750 -o nobody -g nobody -s report.cgi $(INSTALLDIR) -util.o: util.cpp - gcc $(CFLAGS) -c util.cpp +$(OBJDIR)util.o: util.cpp + gcc $(CFLAGS) -c util.cpp -o $(OBJDIR)util.o -applicat.o: applicat.cpp applicat.h - g++ $(CFLAGS) -c applicat.cpp +$(OBJDIR)applicat.o: applicat.cpp applicat.h + g++ $(CFLAGS) -c applicat.cpp -o $(OBJDIR)applicat.o -login.o: login.cpp applicat.h - g++ $(CFLAGS) -c login.cpp -I$(PGINCLUDE) +$(OBJDIR)login.o: login.cpp applicat.h + g++ $(CFLAGS) -c login.cpp -I$(PGINCLUDE) -o $(OBJDIR)login.o -login.cgi: login.o applicat.o util.o - g++ $(CFLAGS) -o login.cgi login.o applicat.o util.o -lpq -lpq++ -L$(PGLIB) +login.cgi: $(OBJDIR)login.o $(OBJDIR)applicat.o $(OBJDIR)util.o + g++ $(CFLAGS) -o login.cgi $(OBJDIR)login.o $(OBJDIR)applicat.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) -logout.o: logout.cpp applicat.h - g++ $(CFLAGS) -c logout.cpp -I$(PGINCLUDE) +$(OBJDIR)logout.o: logout.cpp applicat.h + g++ $(CFLAGS) -c logout.cpp -I$(PGINCLUDE) -o $(OBJDIR)logout.o -logout.cgi: logout.o applicat.o util.o - g++ $(CFLAGS) -o logout.cgi logout.o applicat.o util.o -lpq -lpq++ -L$(PGLIB) +logout.cgi: $(OBJDIR)logout.o $(OBJDIR)applicat.o $(OBJDIR)util.o + g++ $(CFLAGS) -o logout.cgi $(OBJDIR)logout.o $(OBJDIR)applicat.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) -get_module.o: get_module.cpp applicat.h - g++ $(CFLAGS) -c get_module.cpp -I$(PGINCLUDE) +$(OBJDIR)get_module.o: get_module.cpp applicat.h + g++ $(CFLAGS) -c get_module.cpp -I$(PGINCLUDE) -o $(OBJDIR)getmodule.o -get_module.cgi: get_module.o applicat.o util.o - g++ $(CFLAGS) -o get_module.cgi get_module.o applicat.o util.o -lpq -lpq++ -L$(PGLIB) +get_module.cgi: $(OBJDIR)get_module.o $(OBJDIR)applicat.o $(OBJDIR)util.o + g++ $(CFLAGS) -o get_module.cgi $(OBJDIR)get_module.o $(OBJDIR)applicat.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) -check_answers.o: check_answers.cpp applicat.h - g++ $(CFLAGS) -c check_answers.cpp -I$(PGINCLUDE) +$(OBJDIR)check_answers.o: check_answers.cpp applicat.h + g++ $(CFLAGS) -c check_answers.cpp -I$(PGINCLUDE) -o $(OBJDIR)check_answers.o -check_answers.cgi: check_answers.o applicat.o util.o questionnaire.o - g++ $(CFLAGS) -o check_answers.cgi check_answers.o applicat.o questionnaire.o util.o -lpq -lpq++ -L$(PGLIB) +check_answers.cgi: $(OBJDIR)check_answers.o $(OBJDIR)applicat.o $(OBJDIR)util.o $(OBJDIR)questionnaire.o + g++ $(CFLAGS) -o check_answers.cgi $(OBJDIR)check_answers.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) -report.o: report.cpp applicat.h - g++ $(CFLAGS) -c report.cpp -I$(PGINCLUDE) +$(OBJDIR)report.o: report.cpp applicat.h + g++ $(CFLAGS) -c report.cpp -I$(PGINCLUDE) -o $(OBJDIR)report.o -report.cgi: report.o applicat.o util.o questionnaire.o - g++ $(CFLAGS) -o report.cgi report.o applicat.o questionnaire.o util.o -lpq -lpq++ -L$(PGLIB) +report.cgi: $(OBJDIR)report.o $(OBJDIR)applicat.o $(OBJDIR)util.o $(OBJDIR)questionnaire.o + g++ $(CFLAGS) -o report.cgi $(OBJDIR)report.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) -html_parser.o: html_parser.cpp applicat.h - g++ $(CFLAGS) -c html_parser.cpp +$(OBJDIR)html_parser.o: html_parser.cpp applicat.h + g++ $(CFLAGS) -c html_parser.cpp -o $(OBJDIR)html_parser.o -score_corrector.o: score_corrector.cpp applicat.h - g++ $(CFLAGS) -c score_corrector.cpp -I$(PGINCLUDE) +$(OBJDIR)score_corrector.o: score_corrector.cpp applicat.h + g++ $(CFLAGS) -c score_corrector.cpp -I$(PGINCLUDE) -o $(OBJDIR)score_corrector.o -questionnaire.o: questionnaire.cpp questionnaire.h - g++ $(CFLAGS) -c questionnaire.cpp +$(OBJDIR)questionnaire.o: questionnaire.cpp questionnaire.h + g++ $(CFLAGS) -c questionnaire.cpp -o $(OBJDIR)questionnaire.o -html_parser: html_parser.o applicat.o questionnaire.o util.o - g++ $(CFLAGS) -o html_parser html_parser.o applicat.o questionnaire.o util.o +html_parser: $(OBJDIR)html_parser.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o + g++ $(CFLAGS) -o html_parser $(OBJDIR)html_parser.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o -score_corrector: score_corrector.o applicat.o questionnaire.o util.o - g++ $(CFLAGS) -o score_corrector score_corrector.o applicat.o questionnaire.o util.o -lpq -lpq++ -L$(PGLIB) +$(OBJDIR)score_corrector: $(OBJDIR)score_corrector.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o + g++ $(CFLAGS) -o score_corrector $(OBJDIR)score_corrector.o $(OBJDIR)applicat.o $(OBJDIR)questionnaire.o $(OBJDIR)util.o -lpq -lpq++ -L$(PGLIB) diff --git a/webcgi/formazione/questionnaire.cpp b/webcgi/formazione/questionnaire.cpp index 9463ee7de..b92044944 100755 --- a/webcgi/formazione/questionnaire.cpp +++ b/webcgi/formazione/questionnaire.cpp @@ -332,20 +332,35 @@ void Questionnaire::dump_html(const String& corso, const int modulo, const char cout << "
" << endl; cout << "

" << _title << "

" << endl; cout << "
" << endl; - cout << "

Punteggio ottenuto nel test: " << dtoa((double)punteggio) ; - cout << " su di un massimo di " << itoa(_max_score) << "


" << endl; - cout << "

Le caselle di sinistra identificano le risposte corrette, quelle di destra le risposte fornite

" << endl; - cout << "

Ogni risposta che differisce dal correttore viene videnziata in rosso

" <Il punteggio ottenuto nel test corrisponde a: " << dtoa((double)punteggio) << "."; + cout << "

Ricordiamo che il punteggio avrebbe potuto assumere un valore compreso fra -" << itoa(_max_score) << " e " << itoa(_max_score) <<"


" << endl; + /*if (testnum == 'z') + { + String command; + command = "SELECT * FROM VERIFICHE WHERE loginname='"; + command += application._utente; + command += "' AND testnum='"; + command += prevtest; + command += "'"; + application._db->ExecCommandOk(command); + } + */ + cout << "

Le caselle selezionate nella colonna di sinistra identificano le risposte corrette, mentre la colonna di destra riporta le risposte da voi fornite

" << endl; + cout << "

Le risposte evidenziate in rosso corrispondono a risposte sbagliate da voi indicate come esatte.

" <Le risposte evidenziate in verde corrispondono a risposte esatte che voi non avete individuato.

" <Le risposte in nero corrispondono a risposte esatte da voi indicate come tali.

" <Di conseguenza le risposte in rosso e quelle in verde rappresentano l'insieme completo dei vostri errori.

" <
" << endl; cout << "
" << endl; // Senza il tag non visualizza i checkbox! for (i=0;i" << _questions[i].text << "

" << endl; // Test della domanda + cout << "

" << _questions[i].text << "

" << endl; // Testo della domanda for (j=0;j"; // Risposte dell'utente if (!is_right) // Se la risposta fornita non corrisponde a quella del correttore, evidenzia in rosso la risposta data. - cout << ""; - + if (wrong_checked) + cout << ""; + else + cout << ""; cout << _questions[i].answers[j].text; if (!is_right) cout << ""; diff --git a/webcgi/formazione/questionnaire.h b/webcgi/formazione/questionnaire.h index 857cee342..7162b403c 100755 --- a/webcgi/formazione/questionnaire.h +++ b/webcgi/formazione/questionnaire.h @@ -73,7 +73,7 @@ public: void reset(); Rational calc_score(); bool load(const String& s1, const String& s2); - void dump_html(const String& corso, const int modulo, const char testnum); - Questionnaire() { reset();} + void dump_html(const String& corso, const int modulo, const char testnum); + Questionnaire() { reset();} virtual ~Questionnaire() {}; }; diff --git a/webcgi/formazione/upload.pl b/webcgi/formazione/upload.pl new file mode 100755 index 000000000..267dc037b --- /dev/null +++ b/webcgi/formazione/upload.pl @@ -0,0 +1,128 @@ +#!/usr/bin/perl -w + +# Copyright (c) 1996 Steven E. Brenner +# $Id: upload.pl,v 1.1 2000-03-02 15:26:30 luca Exp $ + +require 5.001; +use strict; +require "./cgi-lib.pl"; +require "./HyperNews/.scripts/check_mod_user.pl"; + +MAIN: +{ + my (%cgi_data, # The form data + %cgi_cfn, # The uploaded file(s) client-provided name(s) + %cgi_ct, # The uploaded file(s) content-type(s). These are + # set by the user's browser and may be unreliable + %cgi_sfn, # The uploaded file(s) name(s) on the server (this machine) + $ret, # Return value of the ReadParse call. + $user, # User name from environment + $course, # Course name selected from user database + $basedir, # Base directory for download (per evitare i cheats) + $fn, # File per le note dell'utente + $fl, # nome del file in locale + $xn, + $ccc, + $i1, + $i2 + ); + + # When writing files, several options can be set.. + # Spool the files to the /tmp directory + #$basedir = "../upload/"; + $basedir = "../corso_"; + $user = $ENV{'REMOTE_USER'}; + $course = get_course($user); + $cgi_lib::writefiles = "/tmp"; + + + $basedir = "$basedir$course/upload/"; + $user = "$basedir$user"; + if (!-d $user) { + mkdir $user, 0755; + } + + $cgi_lib::writefiles = $user; + + # Limit upload size to avoid using too much memory + $cgi_lib::maxdata = 500000; + + # Start off by reading and parsing the data. Save the return value. + # Pass references to retreive the data, the filenames, and the content-type + $ret = &ReadParse(\%cgi_data,\%cgi_cfn,\%cgi_ct,\%cgi_sfn); + + # A bit of error checking never hurt anyone + if (!defined $ret) { + &CgiDie("Errore in lettura parametri del CGI"); + } elsif (!$ret or !defined $cgi_data{'upfile'} or !defined $cgi_data{'note'}) { + # Legge il file upload.htm dal direttorio dei servizi + # e lo restituisce così com'è + print "Content-type: text/html\n\n"; + $xn = "../servizi/upload.htm"; + open (FKL, $xn); + while (!eof(FKL)) { + $ccc = getc(FKL); + print $ccc; + } + close (FKL); + exit 1; + } + + if ($user eq '') { + &CgiDie("Utente non autorizzato\n", + "Si prega di effettuare ancora la validazione dell'utente.\n"); + } + + if (!-d $basedir) { + &CgiDie("Impossibile trovare il direttorio base per l'upload\n", + "Contattare il docente.\n"); + } + + if ($cgi_cfn{'upfile'} eq '') { + &CgiDie("Nome file non valido\n", + "Assicurarsi di aver fornito un nome file corretto.\n"); + } + + $fn = ">>$user/note.txt"; + open (FILE, $fn) || &CgiDie("Impossibile aprire il file delle note $fn\n"); + binmode (FILE); # write files accurately + print FILE "---- Nota ----\n"; + print FILE $cgi_data{'note'} ; +# print FILE "\n---- Fine nota ----\n"; + print FILE "\n"; + close (FILE); + + $i1 = rindex($cgi_cfn{'upfile'}, "\\"); + $i2 = rindex($cgi_cfn{'upfile'}, "/"); + if ($i2 > $i1) { + $i1 = $i2; + } + $fl = "$user/"; + if ($i1 > -1) { + $fl .= substr($cgi_cfn{'upfile'}, $i1+1); + } else { + $fl .= $cgi_cfn{'upfile'}; + } + + # Cambia nome + rename ($cgi_sfn{'upfile'}, $fl) ; + + # Now print the page for the user to see... + print &PrintHeader; + print &HtmlTop("Invio file"); + + + print <$cgi_cfn{'upfile'} e' stato ricevuto.
+Grazie. +
+EOT + + print &HtmlBot; + + + # The following lines are solely to suppress 'only used once' warnings + $cgi_lib::writefiles = $cgi_lib::writefiles; + $cgi_lib::maxdata = $cgi_lib::maxdata; + +} diff --git a/webcgi/formazione/util.cpp b/webcgi/formazione/util.cpp index 921b5b6df..3f919368d 100755 --- a/webcgi/formazione/util.cpp +++ b/webcgi/formazione/util.cpp @@ -1,166 +1,166 @@ -#include "defines.h" - -#define LF 10 -#define CR 13 - -static char __stringa[64]; - -char* itoa(int i) -{ - sprintf(__stringa, "%d", i); - return __stringa; -} - -char* ltoa(long l) -{ - sprintf(__stringa, "%ld", l); - return __stringa; -} - -char* dtoa(double d) -{ - sprintf(__stringa, "%6.4f", d); - return __stringa; -} - -void getword(char *word, char *line, char stop) { - int x = 0,y; - - for(x=0;((line[x]) && (line[x] != stop));x++) - word[x] = line[x]; - - word[x] = '\0'; - if(line[x]) ++x; - y=0; - - while((line[y++] = line[x++])); -} - -char *makeword(char *line, char stop) { - int x = 0,y; - char *word = (char *) malloc(sizeof(char) * (strlen(line) + 1)); - - for(x=0;((line[x]) && (line[x] != stop));x++) - word[x] = line[x]; - - word[x] = '\0'; - if(line[x]) ++x; - y=0; - - while((line[y++] = line[x++])); - return word; -} - -char *fmakeword(FILE *f, char stop, int *cl) { - int wsize; - char *word; - int ll; - - wsize = 102400; - ll=0; - word = (char *) malloc(sizeof(char) * (wsize + 1)); - - while(1) { - word[ll] = (char)fgetc(f); - if(ll==wsize) { - word[ll+1] = '\0'; - wsize+=102400; - word = (char *)realloc(word,sizeof(char)*(wsize+1)); - } - --(*cl); - if((word[ll] == stop) || (feof(f)) || (!(*cl))) { - if(word[ll] != stop) ll++; - word[ll] = '\0'; - return word; - } - ++ll; - } -} - -char x2c(char *what) { - register char digit; - - digit = (what[0] >= 'A' ? ((what[0] & 0xdf) - 'A')+10 : (what[0] - '0')); - digit *= 16; - digit += (what[1] >= 'A' ? ((what[1] & 0xdf) - 'A')+10 : (what[1] - '0')); - return(digit); -} - -void unescape_url(char *url) { - register int x,y; - - for(x=0,y=0;url[y];++x,++y) { - if((url[x] = url[y]) == '%') { - url[x] = x2c(&url[y+1]); - y+=2; - } - } - url[x] = '\0'; -} - -void plustospace(char *str) { - register int x; - - for(x=0;str[x];x++) if(str[x] == '+') str[x] = ' '; -} - -int rind(char *s, char c) { - register int x; - for(x=strlen(s) - 1;x != -1; x--) - if(s[x] == c) return x; - return -1; -} - -int getline(char *s, int n, FILE *f) { - register int i=0; - - while(1) { - s[i] = (char)fgetc(f); - - if(s[i] == CR) - s[i] = fgetc(f); - - if((s[i] == 0x4) || (s[i] == LF) || (i == (n-1))) { - s[i] = '\0'; - return (feof(f) ? 1 : 0); - } - ++i; - } -} - -void send_fd(FILE *f, FILE *fd) -{ - - char c; - - while (1) { - c = fgetc(f); - if(feof(f)) - return; - fputc(c,fd); - } -} - -off_t fsize(const char* n) -{ - struct stat statbuf; - stat(n, &statbuf); - return statbuf.st_size; -} - -void trim(String& s) -{ - const int l = s.length(); - int i,f,n; - f = 0; - n = 0; - for (i = l-1; i>=0; i--) - if (s[i] != ' ') - break; - if (i >= 0 && i < l-1) - { - f = i+1; - n = l-i-1; - } - s.del(f, n); -} +#include "defines.h" + +#define LF 10 +#define CR 13 + +static char __stringa[64]; + +char* itoa(int i) +{ + sprintf(__stringa, "%d", i); + return __stringa; +} + +char* ltoa(long l) +{ + sprintf(__stringa, "%ld", l); + return __stringa; +} + +char* dtoa(double d) +{ + sprintf(__stringa, "%6.2f", d); + return __stringa; +} + +void getword(char *word, char *line, char stop) { + int x = 0,y; + + for(x=0;((line[x]) && (line[x] != stop));x++) + word[x] = line[x]; + + word[x] = '\0'; + if(line[x]) ++x; + y=0; + + while((line[y++] = line[x++])); +} + +char *makeword(char *line, char stop) { + int x = 0,y; + char *word = (char *) malloc(sizeof(char) * (strlen(line) + 1)); + + for(x=0;((line[x]) && (line[x] != stop));x++) + word[x] = line[x]; + + word[x] = '\0'; + if(line[x]) ++x; + y=0; + + while((line[y++] = line[x++])); + return word; +} + +char *fmakeword(FILE *f, char stop, int *cl) { + int wsize; + char *word; + int ll; + + wsize = 102400; + ll=0; + word = (char *) malloc(sizeof(char) * (wsize + 1)); + + while(1) { + word[ll] = (char)fgetc(f); + if(ll==wsize) { + word[ll+1] = '\0'; + wsize+=102400; + word = (char *)realloc(word,sizeof(char)*(wsize+1)); + } + --(*cl); + if((word[ll] == stop) || (feof(f)) || (!(*cl))) { + if(word[ll] != stop) ll++; + word[ll] = '\0'; + return word; + } + ++ll; + } +} + +char x2c(char *what) { + register char digit; + + digit = (what[0] >= 'A' ? ((what[0] & 0xdf) - 'A')+10 : (what[0] - '0')); + digit *= 16; + digit += (what[1] >= 'A' ? ((what[1] & 0xdf) - 'A')+10 : (what[1] - '0')); + return(digit); +} + +void unescape_url(char *url) { + register int x,y; + + for(x=0,y=0;url[y];++x,++y) { + if((url[x] = url[y]) == '%') { + url[x] = x2c(&url[y+1]); + y+=2; + } + } + url[x] = '\0'; +} + +void plustospace(char *str) { + register int x; + + for(x=0;str[x];x++) if(str[x] == '+') str[x] = ' '; +} + +int rind(char *s, char c) { + register int x; + for(x=strlen(s) - 1;x != -1; x--) + if(s[x] == c) return x; + return -1; +} + +int getline(char *s, int n, FILE *f) { + register int i=0; + + while(1) { + s[i] = (char)fgetc(f); + + if(s[i] == CR) + s[i] = fgetc(f); + + if((s[i] == 0x4) || (s[i] == LF) || (i == (n-1))) { + s[i] = '\0'; + return (feof(f) ? 1 : 0); + } + ++i; + } +} + +void send_fd(FILE *f, FILE *fd) +{ + + char c; + + while (1) { + c = fgetc(f); + if(feof(f)) + return; + fputc(c,fd); + } +} + +off_t fsize(const char* n) +{ + struct stat statbuf; + stat(n, &statbuf); + return statbuf.st_size; +} + +void trim(String& s) +{ + const int l = s.length(); + int i,f,n; + f = 0; + n = 0; + for (i = l-1; i>=0; i--) + if (s[i] != ' ') + break; + if (i >= 0 && i < l-1) + { + f = i+1; + n = l-i-1; + } + s.del(f, n); +} diff --git a/webcgi/perlsyntax.txt b/webcgi/perlsyntax.txt new file mode 100755 index 000000000..d58ddfff1 --- /dev/null +++ b/webcgi/perlsyntax.txt @@ -0,0 +1,727 @@ + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + +NNNNAAAAMMMMEEEE + perlsyn - Perl syntax + +DDDDEEEESSSSCCCCRRRRIIIIPPPPTTTTIIIIOOOONNNN + A Perl script consists of a sequence of declarations and + statements. The only things that need to be declared in + Perl are report formats and subroutines. See the sections + below for more information on those declarations. All + uninitialized user-created objects are assumed to start + with a null or 0 value until they are defined by some + explicit operation such as assignment. (Though you can + get warnings about the use of undefined values if you + like.) The sequence of statements is executed just once, + unlike in sssseeeedddd and aaaawwwwkkkk scripts, where the sequence of + statements is executed for each input line. While this + means that you must explicitly loop over the lines of your + input file (or files), it also means you have much more + control over which files and which lines you look at. + (Actually, I'm lying--it is possible to do an implicit + loop with either the ----nnnn or ----pppp switch. It's just not the + mandatory default like it is in sssseeeedddd and aaaawwwwkkkk.) + + DDDDeeeeccccllllaaaarrrraaaattttiiiioooonnnnssss + + Perl is, for the most part, a free-form language. (The + only exception to this is format declarations, for obvious + reasons.) Comments are indicated by the "#" character, and + extend to the end of the line. If you attempt to use /* + */ C-style comments, it will be interpreted either as + division or pattern matching, depending on the context, + and C++ // comments just look like a null regular + expression, so don't do that. + + A declaration can be put anywhere a statement can, but has + no effect on the execution of the primary sequence of + statements--declarations all take effect at compile time. + Typically all the declarations are put at the beginning or + the end of the script. However, if you're using + lexically-scoped private variables created with _m_y_(_), + you'll have to make sure your format or subroutine + definition is within the same block scope as the my if you + expect to to be able to access those private variables. + + Declaring a subroutine allows a subroutine name to be used + as if it were a list operator from that point forward in + the program. You can declare a subroutine (prototyped to + take one scalar parameter) without defining it by saying + just: + + sub myname ($); + $me = myname $0 or die "can't get myname"; + + Note that it functions as a list operator though, not as a + unary operator, so be careful to use or instead of || + + + +25/Mar/96 perl 5.003 with 1 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + there. + + Subroutines declarations can also be loaded up with the + require statement or both loaded and imported into your + namespace with a use statement. See the _p_e_r_l_m_o_d manpage + for details on this. + + A statement sequence may contain declarations of + lexically-scoped variables, but apart from declaring a + variable name, the declaration acts like an ordinary + statement, and is elaborated within the sequence of + statements as if it were an ordinary statement. That + means it actually has both compile-time and run-time + effects. + + SSSSiiiimmmmpppplllleeee ssssttttaaaatttteeeemmmmeeeennnnttttssss + + The only kind of simple statement is an expression + evaluated for its side effects. Every simple statement + must be terminated with a semicolon, unless it is the + final statement in a block, in which case the semicolon is + optional. (A semicolon is still encouraged there if the + block takes up more than one line, since you may + eventually add another line.) Note that there are some + operators like eval {} and do {} that look like compound + statements, but aren't (they're just TERMs in an + expression), and thus need an explicit termination if used + as the last item in a statement. + + Any simple statement may optionally be followed by a + _S_I_N_G_L_E modifier, just before the terminating semicolon (or + block ending). The possible modifiers are: + + if EXPR + unless EXPR + while EXPR + until EXPR + + The if and unless modifiers have the expected semantics, + presuming you're a speaker of English. The while and + until modifiers also have the usual "while loop" semantics + (conditional evaluated first), except when applied to a + do-BLOCK (or to the now-deprecated do-SUBROUTINE + statement), in which case the block executes once before + the conditional is evaluated. This is so that you can + write loops like: + + do { + $line = ; + ... + } until $line eq ".\n"; + + See the do entry in the _p_e_r_l_f_u_n_c manpage. Note also that + the loop control statements described later will _N_O_T work + + + +25/Mar/96 perl 5.003 with 2 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + in this construct, since modifiers don't take loop labels. + Sorry. You can always wrap another block around it to do + that sort of thing. + + CCCCoooommmmppppoooouuuunnnndddd ssssttttaaaatttteeeemmmmeeeennnnttttssss + + In Perl, a sequence of statements that defines a scope is + called a block. Sometimes a block is delimited by the + file containing it (in the case of a required file, or the + program as a whole), and sometimes a block is delimited by + the extent of a string (in the case of an eval). + + But generally, a block is delimited by curly brackets, + also known as braces. We will call this syntactic + construct a BLOCK. + + The following compound statements may be used to control + flow: + + if (EXPR) BLOCK + if (EXPR) BLOCK else BLOCK + if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK + LABEL while (EXPR) BLOCK + LABEL while (EXPR) BLOCK continue BLOCK + LABEL for (EXPR; EXPR; EXPR) BLOCK + LABEL foreach VAR (LIST) BLOCK + LABEL BLOCK continue BLOCK + + Note that, unlike C and Pascal, these are defined in terms + of BLOCKs, not statements. This means that the curly + brackets are _r_e_q_u_i_r_e_d--no dangling statements allowed. If + you want to write conditionals without curly brackets + there are several other ways to do it. The following all + do the same thing: + + if (!open(FOO)) { die "Can't open $FOO: $!"; } + die "Can't open $FOO: $!" unless open(FOO); + open(FOO) or die "Can't open $FOO: $!"; # FOO or bust! + open(FOO) ? 'hi mom' : die "Can't open $FOO: $!"; + # a bit exotic, that last one + + The if statement is straightforward. Since BLOCKs are + always bounded by curly brackets, there is never any + ambiguity about which if an else goes with. If you use + unless in place of if, the sense of the test is reversed. + + The while statement executes the block as long as the + expression is true (does not evaluate to the null string + or 0 or "0"). The LABEL is optional, and if present, + consists of an identifier followed by a colon. The LABEL + identifies the loop for the loop control statements next, + last, and redo. If the LABEL is omitted, the loop control + statement refers to the innermost enclosing loop. This + may include dynamically looking back your call-stack at + + + +25/Mar/96 perl 5.003 with 3 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + run time to find the LABEL. Such desperate behavior + triggers a warning if you use the ----wwww flag. + + If there is a continue BLOCK, it is always executed just + before the conditional is about to be evaluated again, + just like the third part of a for loop in C. Thus it can + be used to increment a loop variable, even when the loop + has been continued via the next statement (which is + similar to the C continue statement). + + LLLLoooooooopppp CCCCoooonnnnttttrrrroooollll + + The next command is like the continue statement in C; it + starts the next iteration of the loop: + + LINE: while () { + next LINE if /^#/; # discard comments + ... + } + + The last command is like the break statement in C (as used + in loops); it immediately exits the loop in question. The + continue block, if any, is not executed: + + LINE: while () { + last LINE if /^$/; # exit when done with header + ... + } + + The redo command restarts the loop block without + evaluating the conditional again. The continue block, if + any, is _n_o_t executed. This command is normally used by + programs that want to lie to themselves about what was + just input. + + For example, when processing a file like _/_e_t_c_/_t_e_r_m_c_a_p. If + your input lines might end in backslashes to indicate + continuation, you want to skip ahead and get the next + record. + + while (<>) { + chomp; + if (s/\\$//) { + $_ .= <>; + redo unless eof(); + } + # now process $_ + } + + which is Perl short-hand for the more explicitly written + version: + + + + + + +25/Mar/96 perl 5.003 with 4 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + LINE: while ($line = ) { + chomp($line); + if ($line =~ s/\\$//) { + $line .= ; + redo LINE unless eof(); # not eof(ARGV)! + } + # now process $line + } + + Or here's a a simpleminded Pascal comment stripper + (warning: assumes no { or } in strings) + + LINE: while () { + while (s|({.*}.*){.*}|$1 |) {} + s|{.*}| |; + if (s|{.*| |) { + $front = $_; + while () { + if (/}/) { # end of comment? + s|^|$front{|; + redo LINE; + } + } + } + print; + } + + Note that if there were a continue block on the above + code, it would get executed even on discarded lines. + + If the word while is replaced by the word until, the sense + of the test is reversed, but the conditional is still + tested before the first iteration. + + In either the if or the while statement, you may replace + "(EXPR)" with a BLOCK, and the conditional is true if the + value of the last statement in that block is true. While + this "feature" continues to work in version 5, it has been + deprecated, so please change any occurrences of "if BLOCK" + to "if (do BLOCK)". + + FFFFoooorrrr LLLLooooooooppppssss + + Perl's C-style for loop works exactly like the + corresponding while loop; that means that this: + + for ($i = 1; $i < 10; $i++) { + ... + } + + is the same as this: + + + + + + +25/Mar/96 perl 5.003 with 5 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + $i = 1; + while ($i < 10) { + ... + } continue { + $i++; + } + + Besides the normal array index looping, for can lend + itself to many other interesting applications. Here's one + that avoids the problem you get into if you explicitly + test for end-of-file on an interactive file descriptor + causing your program to appear to hang. + + $on_a_tty = -t STDIN && -t STDOUT; + sub prompt { print "yes? " if $on_a_tty } + for ( prompt(); ; prompt() ) { + # do something + } + + + FFFFoooorrrreeeeaaaacccchhhh LLLLooooooooppppssss + + The foreach loop iterates over a normal list value and + sets the variable VAR to be each element of the list in + turn. The variable is implicitly local to the loop and + regains its former value upon exiting the loop. If the + variable was previously declared with my, it uses that + variable instead of the global one, but it's still + localized to the loop. This can cause problems if you + have subroutine or format declarations within that block's + scope. + + The foreach keyword is actually a synonym for the for + keyword, so you can use foreach for readability or for for + brevity. If VAR is omitted, $_ is set to each value. If + LIST is an actual array (as opposed to an expression + returning a list value), you can modify each element of + the array by modifying VAR inside the loop. That's + because the foreach loop index variable is an implicit + alias for each item in the list that you're looping over. + + Examples: + + for (@ary) { s/foo/bar/ } + + foreach $elem (@elements) { + $elem *= 2; + } + + for $count (10,9,8,7,6,5,4,3,2,1,'BOOM') { + print $count, "\n"; sleep(1); + } + + for (1..15) { print "Merry Christmas\n"; } + + + +25/Mar/96 perl 5.003 with 6 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + foreach $item (split(/:[\\\n:]*/, $ENV{TERMCAP})) { + print "Item: $item\n"; + } + + Here's how a C programmer might code up a particular + algorithm in Perl: + + for ($i = 0; $i < @ary1; $i++) { + for ($j = 0; $j < @ary2; $j++) { + if ($ary1[$i] > $ary2[$j]) { + last; # can't go to outer :-( + } + $ary1[$i] += $ary2[$j]; + } + # this is where that last takes me + } + + Whereas here's how a Perl programmer more confortable with + the idiom might do it: + + OUTER: foreach $wid (@ary1) { + INNER: foreach $jet (@ary2) { + next OUTER if $wid > $jet; + $wid += $jet; + } + } + + See how much easier this is? It's cleaner, safer, and + faster. It's cleaner because it's less noisy. It's safer + because if code gets added between the inner and outer + loops later on, the new code won't be accidentally + executed, the next explicitly iterates the other loop + rather than merely terminating the inner one. And it's + faster because Perl executes a foreach statement more + rapidly than it would the equivalent for loop. + + BBBBaaaassssiiiicccc BBBBLLLLOOOOCCCCKKKKssss aaaannnndddd SSSSwwwwiiiittttcccchhhh SSSSttttaaaatttteeeemmmmeeeennnnttttssss + + A BLOCK by itself (labeled or not) is semantically + equivalent to a loop that executes once. Thus you can use + any of the loop control statements in it to leave or + restart the block. (Note that this is _N_O_T true in eval{}, + sub{}, or contrary to popular belief do{} blocks, which do + _N_O_T count as loops.) The continue block is optional. + + The BLOCK construct is particularly nice for doing case + structures. + + SWITCH: { + if (/^abc/) { $abc = 1; last SWITCH; } + if (/^def/) { $def = 1; last SWITCH; } + if (/^xyz/) { $xyz = 1; last SWITCH; } + $nothing = 1; + } + + + +25/Mar/96 perl 5.003 with 7 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + There is no official switch statement in Perl, because + there are already several ways to write the equivalent. + In addition to the above, you could write + + SWITCH: { + $abc = 1, last SWITCH if /^abc/; + $def = 1, last SWITCH if /^def/; + $xyz = 1, last SWITCH if /^xyz/; + $nothing = 1; + } + + (That's actually not as strange as it looks once you + realize that you can use loop control "operators" within + an expression, That's just the normal C comma operator.) + + or + + SWITCH: { + /^abc/ && do { $abc = 1; last SWITCH; }; + /^def/ && do { $def = 1; last SWITCH; }; + /^xyz/ && do { $xyz = 1; last SWITCH; }; + $nothing = 1; + } + + or formatted so it stands out more as a "proper" switch + statement: + + SWITCH: { + /^abc/ && do { + $abc = 1; + last SWITCH; + }; + + /^def/ && do { + $def = 1; + last SWITCH; + }; + + /^xyz/ && do { + $xyz = 1; + last SWITCH; + }; + $nothing = 1; + } + + or + + SWITCH: { + /^abc/ and $abc = 1, last SWITCH; + /^def/ and $def = 1, last SWITCH; + /^xyz/ and $xyz = 1, last SWITCH; + $nothing = 1; + } + + + + +25/Mar/96 perl 5.003 with 8 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + or even, horrors, + + if (/^abc/) + { $abc = 1 } + elsif (/^def/) + { $def = 1 } + elsif (/^xyz/) + { $xyz = 1 } + else + { $nothing = 1 } + + A common idiom for a switch statement is to use foreach's + aliasing to make a temporary assignment to $_ for + convenient matching: + + SWITCH: for ($where) { + /In Card Names/ && do { push @flags, '-e'; last; }; + /Anywhere/ && do { push @flags, '-h'; last; }; + /In Rulings/ && do { last; }; + die "unknown value for form variable where: `$where'"; + } + + Another interesting approach to a switch statement is + arrange for a do block to return the proper value: + + $amode = do { + if ($flag & O_RDONLY) { "r" } + elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } + elsif ($flag & O_RDWR) { + if ($flag & O_CREAT) { "w+" } + else { ($flag & O_APPEND) ? "a+" : "r+" } + } + }; + + + GGGGoooottttoooo + + Although not for the faint of heart, Perl does support a + goto statement. A loop's LABEL is not actually a valid + target for a goto; it's just the name of the loop. There + are three forms: goto-LABEL, goto-EXPR, and goto-&NAME. + + The goto-LABEL form finds the statement labeled with LABEL + and resumes execution there. It may not be used to go + into any construct that requires initialization, such as a + subroutine or a foreach loop. It also can't be used to go + into a construct that is optimized away. It can be used + to go almost anywhere else within the dynamic scope, + including out of subroutines, but it's usually better to + use some other construct such as last or die. The author + of Perl has never felt the need to use this form of goto + (in Perl, that is--C is another matter). + + The goto-EXPR form expects a label name, whose scope will + + + +25/Mar/96 perl 5.003 with 9 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + be resolved dynamically. This allows for computed gotos + per FORTRAN, but isn't necessarily recommended if you're + optimizing for maintainability: + + goto ("FOO", "BAR", "GLARCH")[$i]; + + The goto-&NAME form is highly magical, and substitutes a + call to the named subroutine for the currently running + subroutine. This is used by _A_U_T_O_L_O_A_D_(_) subroutines that + wish to load another subroutine and then pretend that the + other subroutine had been called in the first place + (except that any modifications to @_ in the current + subroutine are propagated to the other subroutine.) After + the goto, not even _c_a_l_l_e_r_(_) will be able to tell that this + routine was called first. + + In almost all cases like this, it's usually a far, far + better idea to use the structured control flow mechanisms + of next, last, or redo instead of resorting to a goto. + For certain applications, the catch and throw pair of + eval{} and _d_i_e_(_) for exception processing can also be a + prudent approach. + + PPPPOOOODDDDssss:::: EEEEmmmmbbbbeeeeddddddddeeeedddd DDDDooooccccuuuummmmeeeennnnttttaaaattttiiiioooonnnn + + Perl has a mechanism for intermixing documentation with + source code. While it's expecting the beginning of a new + statement, if the compiler encounters a line that begins + with an equal sign and a word, like this + + =head1 Here There Be Pods! + + Then that text and all remaining text up through and + including a line beginning with =cut will be ignored. The + format of the intervening text is described in the _p_e_r_l_p_o_d + manpage. + + This allows you to intermix your source code and your + documentation text freely, as in + + =item snazzle($) + + The snazzle() function will behave in the most spectacular + form that you can possibly imagine, not even excepting + cybernetic pyrotechnics. + + =cut back to the compiler, nuff of this pod stuff! + + sub snazzle($) { + my $thingie = shift; + ......... + } + + Note that pod translators should only look at paragraphs + + + +25/Mar/96 perl 5.003 with 10 + + + + + +PERLSYN(1) Perl Programmers Reference Guide PERLSYN(1) + + + beginning with a pod diretive (it makes parsing easier), + whereas the compiler actually knows to look for pod + escapes even in the middle of a paragraph. This means + that the following secret stuff will be ignored by both + the compiler and the translators. + + $a=3; + =secret stuff + warn "Neither POD nor CODE!?" + =cut back + print "got $a\n"; + + You probably shouldn't rely upon the _w_a_r_n_(_) being podded + out forever. Not all pod translators are well-behaved in + this regard, and perhaps the compiler will become pickier. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +25/Mar/96 perl 5.003 with 11 + + + \ No newline at end of file