WEB DB PRESS Vol.1 65

Size: px

Start display at page:

Download "WEB DB PRESS Vol.1 65"

そうけいれい
5 years ago
Views:

1 WEB DB PRESS Vol.1

2 WEB DB PRESS Vol.1 65

3 Powered by mod_perl, Apache & MySQL my $input; my %form; read STDIN, $input, $ENV{'CONTENT_LENGTH'}; foreach my $key_and_value (split /&/, $input) { my ($key, $value) = split /=/,$key_and_value; $form{$key} = $value; } use CGI; my $query = CGI->new; WEB DB PRESS Vol.1

4 $query->param('name'); <HTML> <BODY> <FORM method="post" action="sample.cgi"> <INPUT type="text" name="comment"> <SELECT name="language"> <OPTION value="perl">perl <OPTION value="python">python <OPTION value="ruby">ruby </SELECT> </FORM> </BODY> </HTML> print $query->param('comment'); # it's "cool" #!/usr/bin/perl use CGI; my $query = CGI->new; print $query->param('comment'); print $query->param('language'); END $obj = CGI->new; $obj->param; $obj->param(name); = $obj->param; my $value = $obj->param($name); $obj->header; $obj->header( $obj->header(content_type); -type => 'image/gif', $obj->header(list); -expires => '+1m', ); $obj->redirect(url); $obj->cookie(list) my $cookie = $obj->cookie( -name => 'session_id', -value => 'id_strings', -expires => '+1d', ); print $obj->header(-cookie => $cookie); WEB DB PRESS Vol.1 67

5 Powered by mod_perl, Apache & MySQL $handle = DBI->connect($data_ my $handle = DBI->connect($data_source, source, $username, $passwd); $username, $passwd, { RaiseError => 1, AutoCommit => 0 }); $state = $handle->prepare(sql); $state->execute; $state->execute(list); $state = $handle->do(sql); $record = $state->fetchrow_arrayref; $handle->commit; my $handle = DBI->connect($data_source, $username, $passwd, { RaiseError => 1, AutoCommit => 0, $handle->rollback; }); eval { $handle->do(q{ DELETE FROM table WHERE status = 'DONE' }); }; if ($@) { $handle->rollback; # clean up code } else { $handle->commit; } $handle->disconnect; WEB DB PRESS Vol.1

6 my $state = $handle->prepare(q{ SELECT column1, column2 FROM table }); use DBI; my $handle = DBI->connect($data_source, $username, $password); dbi:drivername:database_name dbi:drivername:database_name@hostname:port dbi:drivername:database_name;host=hostname;port=port my $state = $handle->prepare(q{ SELECT name, , age FROM table WHERE age ==? }); $state->execute(); $state->execute($age); while (my $record = $state->fetchrow_arrayref) { print 'Name: ', $record->[0]; print ' ', $record->[1]; print 'Age: ', $record->[2]; } WEB DB PRESS Vol.1 69

7 Powered by mod_perl, Apache & MySQL $handle->disconnect(); #!/usr/bin/perl use DBI; my $handle = DBI->connect( 'dbi:mysql:customer', 'user', 'password' ); my $state = $handle->prepare(q{ INSERT INTO language (name, version, url) VALUES (?,?,?) }); while (my $line = <>) { chomp $line; $state->execute(split /\t/, $line); } $handle->disconnect; END WEB DB PRESS Vol.1

8 #!/usr/bin/perl use DBI; my $handle = DBI->connect( 'dbi:mysql:customer', 'user', 'password' ); my $state = $handle->prepare(q{ SELECT name, version, url FROM language }); $state->execute; while (my $record = $state->fetchrow_arrayref) { printf "%s, %s, %s\n", $record->[0], # name $record->[1], # version $record->[]; # url } $handle->disconnect; END use Apache::Session::DB_File; my %session; tie %session, 'Apache::Session::DB_File', $session_id, { FileName => '/var/sessions.db', LockDirectory => '/var/lock/sessions', }; tie %hash, CLASS_NAME; tie %hash, CLASS_NAME, $session_id, use Apache::Session::MySQL; tie %session, 'Apache::Session::MySQL', \%option; $session_id, { DataSource => 'dbi:mysql:sessions', }; $hash{_session_id}; tied(%hash)->delete; untie %hash; WEB DB PRESS Vol.1 71

9 Powered by mod_perl, Apache & MySQL $session{name} = 'value'; print $session{name}; print $session{_session_id}; untie %session; $session{last_access} = time; untie %session; WEB DB PRESS Vol.1

10 #!/usr/bin/perl use Apache::Session::DB_File; use CGI; my $query = CGI->new; my $session_id = $query->cookie(-name => 'session_id'); my %session tie %session, 'Apache::Session::DB_File', $session_id, { FileName => '/var/sessions.db', LockDirectory => '/var/lock/sessions', }; ++$session{access}; my $html = << HTML_BODY ; <HTML> <BODY> Your Access: $session{access} </BODY> </HTML> HTML_BODY my $state_cookie = $query->cookie( -name => 'session_id', -value => $session{_session_id}, ); print $query->header(-cookie => $state_cookie); print $html; END <HTML> <BODY> <TMPL_VAR name=list_name> <TMPL_LOOP name=language> Name: <TMPL_VAR name=name> URL: <TMPL_VAR name=url> <HR> </TMPL_LOOP> </BODY> </HTML> $html->param('language' => [ { NAME => 'Perl', URL => ' }, { NAME => 'Python', URL => ' }, { NAME => 'Ruby', URL => ' }, ]); use HTML::Template; my $html = HTML::Template->new( filename => '/path/to/template.html' ); WEB DB PRESS Vol.1 7

11 Powered by mod_perl, Apache & MySQL $html->param('list_name' => ''); print $html->output; <HTML> <BODY> Name: Perl URL: <HR> Name: Python URL: <HR> Name: Ruby URL: <HR> </TMPL_LOOP> </BODY> </HTML> #!/usr/bin/perl use HTML::Template; my $directory = $ARGV[0] './'; my $html = HTML::Template->new( filename => 'directory.html' ); my $file_list = []; opendir DIR, $directory; while (my $filename = readdir DIR) { { NAME => $filename, SIZE => -s $filename, }; } $html->param(filelist => $file_list); $html->param(path => $directory); print $html->output; END <HTML> <HEAD><TITLE><TMPL_VAR name=path></title></head> <BODY> <TABLE> <TR> <TH>Name</TH> <TH>Size</TH> </TR> <TMPL_LOOP name=filelist> <TR> <TD><A href="<tmpl_var name=name>"><tmpl_var name=name></a></td> <TD><TMPL_VAR name=size></td> </TR> </TMPL_LOOP> </TABLE> </BODY> </HTML> 74 WEB DB PRESS Vol.1

12 > ftp User: anonymous 1 Anonymous login ok, send your complete e- mail address as password. Password: your@ .address ftp> cd /CPAN/modules/by-module/Apache ftp> ls mod_perl-*.tar.gz mod_perl-1.21.tar.gz mod_perl-1.22.tar.gz mod_perl-1.2.tar.gz mod_perl-1.24.tar.gz ftp> ftp> get mod_perl-1.24.tar.gz ftp> quit > cd /usr/local/src > gzip -cd mod_perl-1.24.tar.gz tar xvf - mod_perl-1.24/ mod_perl-1.24/t/ mod_perl-1.24/t/docs/... > cd mod_perl-1.24 > perl Makefile.PL Configure mod_perl with../apache_1..14/src? [y] y Shall I build httpd in../apache_1..14/src for you? [y] y... WEB DB PRESS Vol.1 75

13 Powered by mod_perl, Apache & MySQL > make # cd../apache_1..14/src # cp -p httpd /usr/local/apache/bin/ > make test > su - Password: xxxxxxxxx # make install > perl Makefile.PL APACI_ARGS="--enablemodule=rewrite,--disable-module=userdir" AllowOverride None Options None Order allow,deny Allow from all <Directory "/usr/local/apache/cgi-bin"> </Directory> <Directory "/usr/local/apache/cgi-bin"> SetHandler perl-script PerlHandler Apache::Registry AllowOverride None Options +ExecCGI Order allow,deny Allow from all PerlSendHeader Off </Directory> 76 WEB DB PRESS Vol.1

14 <Directory "/usr/local/apache/cgi-bin"> SetHandler perl-script PerlHandler Apache::Registry PerlModule Apache::DBI AllowOverride None Options +ExecCGI Order allow,deny Allow from all PerlSendHeader Off </Directory> <Directory "/usr/local/apache/cgi-bin"> SetHandler perl-script PerlHandler Apache::PerlRun AllowOverride None Options +ExecCGI Order allow,deny Allow from all PerlSendHeader Off </Directory> Apache/mod_perl-1.24.tar.gz tar.gz Apache/Apache-Session-1.5.tar.gz Template-2.0.tar.gz WEB DB PRESS Vol.1 77

15 Powered by mod_perl, Apache & MySQL > gzip -cd package.tar.gz tar xvf - > cd package/ > perl Makefile.PL > make > make test > perl Makefile.PL PREFIX=/path/to/install/directory > make > make test > make install > su - Password: xxxxxxxxxx # make install > perldoc ModuleName 78 WEB DB PRESS Vol.1

3 Powered by mod_perl, Apache & MySQL use Item; my $item = Item->new( id => 1, name => ' ', price => 1200,

WEB DB PRESS Vol.1 79 3 Powered by mod_perl, Apache & MySQL use Item; my $item = Item->new( id => 1, name => ' ', price => 1200, http://www.postgresql.org/http://www.jp.postgresql.org/ 80 WEB DB PRESS