test
[technostate.git] / cgi / persons.cgi
1 #!/usr/bin/perl -Tw
2 # $Id: persons.cgi,v 1.9 1999-04-22 06:24:57 ivan Exp $
3 # Copyright (c) 1999 Ivan Kohler.  All rights reserved.
4 # This program is free software; you can redistribute it and/or modify it under
5 # the same terms as perl itself
6
7 use strict;
8 use vars qw ( $data_source $user $password $table @fields
9               $cgi $dbh
10             );
11 use subs qw( print_form );
12 use CGI qw(tr th td);
13 use CGI::Carp qw(fatalsToBrowser);
14 use DBI;
15
16 $data_source = "DBI:mysql:technostate";
17 $user = "agent";
18 $password = "t3chno";
19
20 $table = "PERSONS";
21 @fields = qw( PERSON_ID NAME EMAIL AFFILIATION HOMEPAGE );
22
23 $cgi = new CGI;
24
25 $dbh = DBI->connect( $data_source, $user, $password )
26   or die "Cannot connect: ". $DBI::errstr;
27
28 unless ( $cgi->param('magic') ) { #first time through
29
30   my $sth = $dbh->prepare( "SELECT * FROM $table" )
31     or die $dbh->errstr;
32   my $rv = $sth->execute;
33   die $sth->errstr unless $rv;
34
35   print $cgi->header( '-expires' => 'now' ),
36         $cgi->start_html('Person listing'),
37         $cgi->h1('Person listing'),
38   ;
39
40   unless ( $sth eq '0E0' ) {
41
42     my @columns = @{ $sth->{'NAME'} };
43
44     print $cgi->start_table,
45           $cgi->tr(
46             map {
47               $cgi->th($_)
48             } @columns
49           )
50     ;
51
52     my %hash = ();
53     my $hashref = undef;
54     while ( $hashref = $sth->fetchrow_hashref ) {
55       %hash = %{$hashref};
56       $hash{'EMAIL'} = '<A HREF="mailto:'. $hash{'EMAIL'}. '">'.
57                           $hash{'EMAIL'}. "</A>";
58       $hash{'HOMEPAGE'} = 'http://'. $hash{'HOMEPAGE'}
59         unless $hash{'HOMEPAGE'} =~ /^http\:\/\//;
60       $hash{'HOMEPAGE'} = '<A HREF="'. $hash{'HOMEPAGE'}. '">'.
61                           $hash{'HOMEPAGE'}. "</A>";
62       print $cgi->tr( map { $cgi->td( $hash{$_} ) } @columns );
63     }
64     print $cgi->end_table;
65
66   }
67
68   $cgi->param('magic', 'new_form');
69   print '<P><A HREF="', $cgi->self_url, '">Add new person</A>';
70   print $cgi->end_html;
71
72   exit;
73
74 } elsif ( $cgi->param('magic') eq 'new_form' ) {
75   $cgi->param('PERSON_ID', 0);
76   $cgi->param('magic', 'process_form');
77   &print_form( $cgi, "Add person" );
78   exit;
79 } elsif ( $cgi->param('magic') eq 'process_form' ) {
80
81   my $field;
82   foreach $field ( @fields ) {
83     if ( $cgi->param( $field ) ) {
84       $cgi->param( $field ) =~ /^(.*)$/;
85       my $param = $1 || 0;
86       if ( (DBI::looks_like_number($param))[0] ) {
87         $cgi->param( $field, $param );
88       } else {
89         $cgi->param( $field, $dbh->quote($param) );
90       }
91     }
92   }
93   my $statement = "INSERT INTO $table ( ".
94                   join(', ', @fields ).
95                   ' ) VALUES ( '.
96                   join( ', ', map { $cgi->param($_) } @fields ).
97                   ' )'
98   ;
99   my $sth = $dbh->prepare($statement)
100     or die $dbh->errstr;
101   my $rv = $sth->execute;
102   die $sth->errstr unless $rv;
103
104   my $url = $cgi->url;
105   $url =~ s/^\/[\/]+$//;
106   print $cgi->redirect($url);
107 }
108
109 sub print_form {
110   my $cgi = shift;
111   my $action = shift;
112   print $cgi->header,
113         $cgi->start_html($action),
114         $cgi->h1($action),
115         $cgi->start_form,
116         $cgi->hidden( -name => 'PERSON_ID' ),
117         "Name: ", $cgi->textfield( -name => 'NAME' ), "<BR>", 
118         "Email: ", $cgi->textfield( -name => 'EMAIL' ), "<BR>", 
119         "Affiliation: ", $cgi->textfield( -name => 'AFFILIATION' ), "<BR>",
120         "Homepage: ", $cgi->textfield( -name => 'HOMEPAGE' ), "<BR>",
121         $cgi->hidden( -name => 'magic'),
122         $cgi->submit('Submit'),
123         $cgi->end_form,
124         $cgi->end_html;
125   ;
126 }