MVCの練習 perl

---index.cgi-----
#!/usr/local/bin/perl

use strict;

use Controller;

Controller->new->dispatch('index');# Sledge風にしてみました。
----Controller.pm -----

package Controller;
use strict;
use CGI;
use Model;
use View;
use Error qw(:try);

sub new {
my $class = shift;
my $self = {};
bless $self, $class;
}

sub dispatch {
my $self = shift;
my $page = shift||'index';
print "Content-Type: text/html;\n\n";
try {
my $q = new CGI;
my $color = $q->param('color')||'white';
my $model = new Model($color);
my $view = new View;
if ($model->get_RGB){
$view->hit_page($page,$model->get_RGB);
}else{
$view->not_found_page($page);
}
}catch Error with {
my $e = shift;
warn "system error: " . $e->text;
} finally {
;
}

}
1;

----Modal.pm-----

package Model;
use strict;

sub new {
my $class = shift;
my $self = {};
$self->{color} = shift;
bless $self, $class;
}


sub get_RGB {
my $self = shift;
if ($self->{color} eq "white"){
return "#FFFFFF";
}else{
return "";
}
}


1;

----View.pm------
package View;
use strict;

sub new {
my $class = shift;
my $self = {};
bless $self, $class;
}

sub not_found_page {
my ($self, $str) = @_;
print $str,"not found\n"
}

sub hit_page{
my ($self, $page,$str) = @_;
my $out = sprintf("page :%s, str :%s\n",$page,$str);
print $out;
}

1;

---

apache の設定サンプル

<Files *.pl>
Options ExecCGI
allow from all
SetHandler perl-script
PerlHandler Apache::Registry
PerlModule Apache::DBI
PerlInitHandler Apache::StatINC
PerlSendHeader Off
PerlSetEnv TMPDIR /tmp
</Files>

CPAN（シーパン）のインストール

perl -MCPAN -e shell

よく忘れるので。。ここに書いておきます。

Template Toolkit CGI.pmの例

use strict;
use Template;
use CGI;
my $q = CGI->new;
print "Content-type: text/html\n\n";

my $output;
my $template = Template->new({
OUTPUT => \$output,
TRIM =>1,
});

$template->process(
'fillin.html',
{
apr =>$q,
},
) or print $template->error;
print $output;

-----
[% USE FillInForm %]
[% FILTER fillinform fobject => apr %]

<!-- this form becomes sticky -->
<form action="foo" method="POST">
<input type="text" name="foo">
<input value="" type="hidden" name="bar">
<input value="foo" type="radio" checked name="baz">
<input value="bar" type="radio" name="baz">
</form>
[% END %]

パラメータの値をそのまま Template Toolkit

#!/usr/local/bin/perl

use strict;
use Template;
use CGI;
my $q = CGI->new;
print "Content-type: text/html\n\n";
my $output;
my $template = Template->new({
OUTPUT => \$output,
TRIM =>1,
});


$template->process(
'sample2.html',
{ cgi =>$q,
},
) or print $template->error;

print $output;




$q->param("money","dollar");

-----template---

[% cgi.param('money') %]

ハッシュからURLパラメータ perl

my %hash = ();
$hash{test} = 1;
$hash{test2} = 21;
$hash{test3} = 31;

my $parameter = join '&', map {"$_=$hash{$_}"} keys %hash;
print $parameter; # test2=21&test3=31&test=1

Perl データベースへのアクセスのサンプル

最近ではDBIx::Class や Class::DBIでデータベースをアクセスすることが多く。直接ＳＱＬを書くこともすくなくなりましたが、基本のサンプルを書いておきます。
そのままでは動きません。

my $dbh=DBI->connect(DBI,{PrintError=>0,AutoCommit=>1}) or die ;

my $sql=qq[SELECT id ,name FROM user WHERE age=? AND area=?];#プレースホルダを使用
@bind=(17,14);
$sth = $dbh->prepare($sql)|| die $dbh->errstr;
$sth->execute(@bind);
if ($sth->errstr ne ""){ # DBエラー
#エラー処理
}
while( ( $login_id, $login_name ) = $sth->fetchrow_array() ) {
}
$sth->finish;
$dbh->disconnect;

abstract サンプル Perl アブストラクトメソッド

親クラスで定義したメソッドを呼ばず、子クラスでのメソッドが呼ばれます。
---Foo.pm-----

package Foo;

sub new{
my $pkg = shift;
my $hash= {};
bless $hash,$pkg;
}

sub sub1{
my $self = shift;
$self->sub2;
}

sub sub2{
my $self = shift;
print "this is abstract\n";

}


1;
---Foo2.pm (Fooの子クラス)-----
package Foo2;

use base qw(Foo);

sub sub2{
my $self = shift;
print "Foo2 sub2\n";
}


1;
--- main.pl (実行スクリプト)---

#!/usr/local/bin/perl
use Foo2;

my $f = Foo2->new;
$f->sub1;

__END__

--- 実行結果
Foo2 sub2

ハッシュに関数を入れてみる perl

携帯向けサイトなどで使えそうな感じですね。

my %controller = (
i => \&i_page,
e => \&e_page,
y => \&y_page,
);

my $ca = "i";

$controller{$ca}->("iii") if $ca eq "i";
$controller{$ca}->("eee","test2")if $ca eq "e";
$controller{$ca}->("yyy") if $ca eq "y";


sub i_page{
my $str = shift;
print $str;
}

sub e_page{
my ($str,$str2) = @_;
print $str,$str2;
}

sub y_page{
my $str = shift;
print $str;
}

時間の比較 Time::PieceとDate::Calc perl

use Time::Piece;
use Date::Calc qw(Delta_DHMS);


my $start = localtime;
sleep 3;
my $end = localtime;
my $diff = $end - $start;
# my $diff = $start - $end;
print $diff,"\n";


my @df =Delta_DHMS($start->year,$start->mon,$start->mday,$start->hour,$start->min,$start->sec,
$end->year,$end->mon,$end->mday,$end->hour,$end->min,$end->sec);

$" = ',';# カンマ区切りで出力
print "@df\n";

Perl でPHPのようにリンクに自動的にセッションパラメータを付ける

HTML::StickyQueryをつかえば可能です。

ただしPHPではFormにも自動的にhiddentタグでセッションを渡すことができますが、
この部分は手動で行う必要があります。

タイムアウトをさせない

$|=1;#バッファリング制御
my $interval = 10;

eval {
local $SIG{ALRM} = sub { # ALRM シグナルをキャッチした
print "\n";
alarm $interval;
};
alarm $interval;
# 重たい処理をここでする
sleep 10;
};
alarm 0;
if ($@) {
die "$@";
}

$|=0;#バッファリング制御 元に戻す

指定の配列のランダム

my @id =(0,1,2,3,4,5,6,7,8,9);
my @ret;
for (1..@id) {
push @ret, splice(@id, int(rand(@id)), 1);
}
print @ret;

クラスとメソッドを一度に呼ぶサンプル Perl

---- Game.pm ------
package Game;

use strict;
use Carp qw(croak);

sub new{
my $class = shift;
my $name = shift || croak ('set name');
bless{
name => $name,
},$class;
}

sub name{
my $self = shift;
$self->{name};
}


1;

__END__

---- Player.pm -----
package Player;

use strict;
use Carp qw(croak);
use Game;

sub new{
my $class = shift;
my $self = {};
bless $self, $class;
}

sub run{
my $self = shift;
print $self->game->name;

}

sub game{
my $self = shift;
unless (defined $self->{game}){
$self->{game}= Game->new('race');
}
return $self->{game};
}

1;

__END__



---- index.cgi------
#!/usr/bin/perl
use Player;
use strict;

Player->new->run;

Javascript 選択文字の取得

function getText()
{
var txt = '';
if (window.getSelection)
{
txt = window.getSelection();
}
else if (document.getSelection)
{
txt = document.getSelection();
}
else if (document.selection)
{
txt = document.selection.createRange().text;
}
else return;
document.getElementById("msg").innerHTML = txt;
}

HTML エスケープシーケンス

＆=&
＜=<
＞=>
”="

Ajaxを使わない 処理中の表示

#!/usr/bin/perl
use strict;
$=1;#バッファリング制御
print 'Content-Type: text/html', "\n\n";
my $html = <<__HTML__;
<html>
<head>
</head>
<body>
<img src="./img/indicator_remembermilk_orange.gif"> <-- 処理中をあらわす画像-->
</body>
</html>
__HTML__
print $html;
sleep 10;# 重い(長い)処理
$=0;#バッファリング制御
my $js = <<__JAVASCRIPT__;
<script language="JavaScript">
<!--location.href='test.html'// -->
</script>
__JAVASCRIPT__
print $js;
__END__

無名ハッシュを配列で管理

my $ref_steps = &get_steps();

# 配列をデリファレンス @$ref_steps -->@{$ref_steps}
foreach my $sp (@$ref_steps) {
print sprintf("%s file %d 行\n", $sp->{file},$sp->{steps});
}


sub get_steps{
my @list; my $i=1;
　 for my $key ( qw(hoge hoge2 hoge3) ) {
push (@list, { file=>$key,steps=>$i });
$i++;
　 }
　　 return \@list;
}

ファイルの出力

open( DL, $file );

print <DL>;

close( DL );
一度変数を入れたりするとテキストデータでない場合、

取り出したデータが壊れたりすることがある。

パーセントの計算

sub count_rate {
my ($numerator,$denominator) = @_;
if ( $numerator > 0 && $denominator > 0){
return sprintf("%.1f",($numerator / $denominator)*100);
}else{
return 0;
}
}

perl 経過時間 秒

my $start_sec= time;# 終了時間の取得
my $end_sec = time;# 終了時間の取得
my $finish_time = $end_sec - $start_sec;
my $finish_minute = int($finish_time / 60);# 分の取得
my $finish_sec = $finish_time % 60;
print sprintf("%d分%d秒",$finish_minute,$finish_sec);

perl uploadInfo

cgi->uploadInfo($fh)->{'Content-Type'}

mozillaではtsvファイルはapplication/octet-streamとなる

ajax prototype.js を使った「処理中」のメッセージ表示

<script type="text/javascript" src="./prototype.js"></script>
<script type="text/javascript">
//<![CDATA[
function progressMessage(){
$("status").innerHTML = 'Please Wait..' ;
}

function upload(){
var filename = $F('filename');
var param = 'filename=' + filename ;
var url = "./upload.cgi";
new Ajax.Request(url, {method: 'post', parameters: param, onComplete: result, onLoading: progressMessage});
}
function result(req){
$("status").innerHTML = req.responseText ;

}
//]]>
</script>
</head>
<body>

<form >
<input type="button" value="実行" onclick="upload()"/>
</form>
<span id="status"></span>

-----
#!/usr/bin/perl

sleep 5; # 重い処理のつもり

print "Content-type: text/html;charset=Shift_JIS\n\n";

print "Thank you";

Perl Template::Toolkit の例

for ( my $key = 1; $key <= 10; $key++ ) {
push (@list, { pattern =>"pattern".$key, hoge=>$key, hoge2=>'hoge'} );
}

$self->stash->{list}= \@list;

-------
[% FOREACH r = list %] 　[% r.pattern html %]　[% r.hoge html %] [% r.hoge2 html %] [% END %]

perl 置換

$mailbody = "<TO>さん、げんき？<TO>さん、私は元気です。";

$mailbody =~ s/<TO>/$to/g;

use Benchmark

4 wallclock secs ( 1.77 usr + 1.28 sys = 3.05 CPU) @ 57.05/s (n=174)

4 wallclock secs 処理全体にかかった秒数
@57.05 1秒間に処理した回数 57.05回処理した。

ハッシュ 参照渡し

#!/usr/bin/perl

my %data=();
sub1(\%data);
foreach $key ( sort keys %data ) {
　　print "$key:$data{$key} \n";
}

sub sub1{
　　my ($x) = @_;
　　for ($i = 0; $i <= 10 ; $i++)
　　{
　　$x->{$i} = $i;
　　}
}

Perl 配列 参照渡しのサンプル

#!/usr/bin/perl

my @array = ();

sub1(\@array);
print @array;

sub sub1{
　my ($x) = @_;
　for ($i = 0; $i <= 10 ; $i++)
　{
　$x->[$i] = $i;
　}
}

perl スカラー変数 配列変数 ハッシュ変数

スカラー変数 $s
配列変数 @a
ハッシュ変数 %h

携帯サイト開発に必要なツール

PsQREdit
QR コード作成ツール。URLを携帯に送るときに使用。携帯3キャリアとも使っているが読み取れないことはない。

ウェブコンテンツビューア
Yahooケイタイ向け公式のエミレータ。ユーザID（端末ID）とユーザエージェントUseragentを設定し送信することができる。

iモードHTMLシミュレータII
ユーザエージェントUseragentが自由に指定ができない。ただし、プロキシー先の設定ができるのでProxomitronというソフトを使用することでユーザエージェントすることができる。

Openwave® SDK 6.2K
AU用公式エミレータ

Firefox のuseragentswitcher
ユーザエージェントUseragentが自由に指定できる。携帯コンテンツ固有のHTMLタグでうまく表示できないことがある。

Perl オブジェクト指向 Class 継承

HogeA.pm
package HogeA;
use strict;
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
sub hoge {
my $self = shift;
print "Hoge::hoge\n";
}
1;


HogeB.pm
package HogeB;
use strict;
use base qw(HogeA);
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
sub hogehoge{
print "hogehoge\n";
}
1;

---sample.pl
use strict;
use HogeB;
my $b = HogeB->new();
$b->hoge;

ISAも使えます。

use vars

use strict
を使った場合のグローバル変数をするときにつかう。
最新のバージョンではoursが推奨されますが Classの中で定義した方がよりベータ

Data::Pageのサンプル Template Toolkit

1..2 3 4 5 6 7 8 9 10 11 12 ..28
のようなページ支援の例


[% FOREACH num = [pager.first_page .. pager.last_page] %]
[% IF pager.current_page - pager.first_page > 5 && num == pager.first_page %]
<a href="hoge?page=[% num %]">[% num %]</a>..
[% END %]
[% IF num <= (pager.current_page + 5 ) && num >= (pager.current_page - 5 ) %]
[% IF num == pager.current_page %]<b>[% num %]</b>
[% ELSE %]<a href="hoge?page=[% num %]">[% num %]</a>[% END %]
[% END %]
[% IF (pager.last_page - pager.current_page) > 5 && num == pager.last_page %]
..<a href=hoge?page=[% num %]">[% num %]</a>
[% END %]
[% END %]

Template::Plugin::FillInFormの使い方

--temp.html--



[% USE FillInForm %]

[% FILTER fillinform fdat => fdat1 %]

<form action="http://www.blogger.com/aaa" method="post">

<input type="text" name="hoge">

</form>

[% END %]



--- perl ----

#!/usr/local/bin/perl



use strict;

use Template;



my %values = (

hoge => 'hoge1',

);



my $output;

my $template = Template->new({

OUTPUT => \$output,

TRIM =>1,

});





$template->process(

'temp.html',

{ fdat1 =>\%values,

},

) or print $template->error;



print $output;







--- 実行結果

 

Template-Toolkit

サンプル

任意でconfigの指定ができる。
PRE_PROCESS　ヘッダファイルの指定
POST_PROCESS　フッタファイルの指定
INCLUDE_PATH　テンプレートファイルの置く場所の指定
OUTPUT　出力の制御（詳細は後のURLを参照）
TRIM　改行などの削除（詳細は後のURLに書かれたBLOCKとINCLUDEの説明を参照）

例
my $output;
my $template = Template->new({
PRE_PROCESS => 'header.html',
POST_PROCESS => 'footer.html',
INCLUDE_PATH => '/home/hoge/temp',
OUTPUT => \$output,
TRIM =>1,
});

$template->process(
'sample.html',
);

print $output;


http://www.template-toolkit.org/docs/plain/Manual/Config.html 

hello 

php configure

./configure --with-apxs2=/usr/local/apache2/bin/apxs --enable-mbstring --enable-mbregex --enable-zend-multibyte --with-pgsql=/usr/local/pgsql

PHP の携帯電話向けのセッション設定

php.ini
session.use_trans_sid =1
上記設定でOK


http://www.yc.musashi-tech.ac.jp/~yamada/doc/php/0802.html

bloggerの cookie

blogger の認証にはcookieを有効にしないとログインできない

PATH_INFO による静的なページ

-------path_info.php-----------
$query = getenv ("PATH_INFO");
echo $query;
echo "
";

$var = split ("[/\.]", $query);
print_r ($var);
?>


--------------------------------
.htaccess

ForceType application/x-httpd-php

--------------------------------

引用元

http://blog.su-jine.com/archives/2004/08/_path_info_1.html

mod_rewrite install DSO

cd /usr/local/src/apache_1.3.XX/src/modules/standard
/usr/local/apache/bin/apxs -c mod_rewrite.c
/usr/local/apache/bin/apxs -i mod_rewrite.so

psql

リモートマシンからアクセスするには,${PGDATA}/postgresql.confで
tcpip_socket = 1

として,TCP/IPでのアクセスを許可する.そして,${PGDATA}/pg_hba.confで
host all 127.0.0.1 255.255.255.255 trust


#psql -h マシンBのIPアドレス -U ユーザ名 -l

Information Services - The List

Information Services - The List

:: Cepheid :: - ImageMagick

:: Cepheid :: - ImageMagick

PHP によるHTTPクライアント

http://www.spencernetwork.org/memo/tips-3.php

画像コピーの禁止

イメージツールバーを出現させない方法


macの場合、画像をドラッグ＆ドロップ対応


ImageMagick

Annotate()

mod_rewrite 2

/usr/local/apache/bin/apxs -c /usr/local/src/apache_1.3.29/src/modules/standard/mod_rewrite.c
/usr/local/apache2/bin/apxs -i mod_rewrite.so



.htaccess
----------------------------------------------------------
Options +FollowSymLinks

RewriteEngine on

#RewriteRule ^([a-zA-Z0-9]+)/$ ./index.html?p=$1
#RewriteRule ^([a-zA-Z0-9]+)/index.htm$ ./index.html?p=$1
#RewriteRule ^([a-zA-Z0-9]+)/index.html$ ./index.html?p=$1
RewriteRule ^([a-zA-Z0-9]+)$ ./index.html?p=$1

mysql

/usr/local/mysql/bin/mysqladmin version

/usr/local/mysql/bin/mysqlshow

/usr/local/mysql/bin/mysql -u root -p

phpMyAdmin UTF-8

phpMyAdmin

インストール

cp config.sample.inc.php config.inc.php

$cfg['blowfish_secret'] = 'hogehoge'; ここに適当な文字列を追加

うまく動かない場合　#2002 - The server is not responding (or the local MySQL server's socket is not correctly configured

//$cfg['Servers'][$i]['host'] = 'localhost';
$cfg['Servers'][$i]['host'] = '127.0.0.1';
のように変更すると動くときもある。

日本語のコードを　ＵＴＦ８　にする場合
config.inc.php　
$cfg['DefaultLang'] = 'utf-8';
$cfg['DefaultCharset'] = 'utf-8';
$cfg['AllowAnywhereRecoding'] = FALSE; ＜＜こっちがいいみたい
$cfg['AllowAnywhereRecoding'] = TRUE; でもOKだがその場合、なんでも可となるので
UTF-8のみなら要らない

$cfg['Servers'][$i]['user'] = 'root'; // MySQL user
$cfg['Servers'][$i]['password'] = '';
$cfg['Servers'][$i]['host'] = 'localhost';
$cfg['PmaAbsoluteUri'] = 'http://www.+++.com/phpMyAdmin/';


libraries/select_lang.lib.php
以下をコメントアウト

/** * * 2004-02-15 rabus: Deactivated the code temporarily:
* We need to allow UTF-8 in order to be MySQL 4.1 compatible!
// Disable UTF-8 if $cfg['AllowAnywhereRecoding'] has been set to FALSE.
if (!isset($cfg['AllowAnywhereRecoding']) !$cfg['AllowAnywhereRecoding']) {
　　$available_language_files = $available_languages;
　　 $available_languages = array();
　　 foreach ($available_language_files AS $tmp_lang => $tmp_lang_data) {
　　 if (substr($tmp_lang, -5) != 'utf-8') {
　　 $available_languages[$tmp_lang] = $tmp_lang_data;
　　 }
　　 } // end while
　　 unset($tmp_lang, $tmp_lang_data, $available_language_files);
} // end if
* */

mod_vhost_alias

実際にはfind . -name mod_vhost_alias.c で探してみてください。

DSOとして後から追加
/usr/local/apache/bin/apxs -c mod_vhost_alias.c
/usr/local/apache/bin/apxs -i mod_vhost_alias.so

mod_vhost_alias.soが見事にlibexecの下におる

VirtualDocumentRootが使える

VirtualDocumentRoot /var/www/vhosts/%0/
をhttp.confの最後に追加するだけ。

すると、「www.hoge.com」でアクセスされた場合「/var/www/vhosts/www/