シンプルなWebアプリなCGIを書いてみる２ : blog.nomadscafe.jp

前回「シンプルなWebアプリなCGIを書いてみる」をかいてから、時間かかったけど、とりあえず自分にフレンドリーなCGIフレームワークをつくってみた。2回ほど仕事で作るCGIに使っただけで、機能も貧弱だけどアウトプット主義で公開。ネタは前回と同じ郵便番号を入力するCGI。

郵便番号を入力するCGI 002

入力する情報が増えたのと確認画面がでるようになったのが進歩。いままでCGIが複雑化するので嫌いだった確認画面がフレームワークのおかげで簡単になったのでいれた。

CGIのソースコードはこうなった。
index.cgi

#!/usr/bin/perl

use strict;

MyCGI::SimpleWebApp::Zip002->new()->run();

package MyCGI::SimpleWebApp::Zip002;

use strict;
use base qw(CGI::SAF);

sub setup{
	my $self = shift;
	$self->register_run_mode('confirm','reg');
	$self->header_props(
		-charset=>'EUC-JP',
		-expires=>'now',
		-pragma=>'no-cache',
		-cache_control=>'no-cache'
	);
	$self->html_fillin_props(
		ignore_fields=>['mode']
	);
}

sub do_default{
	my $self = shift;
	$self->template('index.tmpl.html');
	$self->fillin(1);
}

sub do_confirm{
	my $self = shift;
	$self->validate;
	if($self->alert){
		return $self->forward('default');
	}
	$self->template('index_confirm.tmpl.html');
	$self->fillin(1);
}

sub do_reg{
	my $self = shift;
	$self->validate;
	if($self->alert){
		return $self->forward('default');
	}
	$self->template('index_reg.tmpl.html');	
}

sub validate{
	my $self=shift;
	$self->alert("郵便番号が正しく入力されていません") unless $self->param('zip') =~ /^?d{7}$/;
	$self->alert("性別が入力されていません") unless $self->param('sex') =~ /^[12]$/;
	$self->param('sexj',{1=>"男性",2=>"女性"}->{$self->param('sex')}) if(defined $self->param('sex'));
}

1;

実際のCGIの部分は、

MyCGI::SimpleWebApp::Zip002->new()->run();

の部分だけなんだけど、アプリケーションの動作をするクラスもCGIに直接書いている。
かなり短縮して書くパターンで書いているので、あまり紹介に適さないCGIになってしまっているが、CGI::Applicationを参考にSledgeのいいところを入れた感じで、アプリケーションクラスが書けていると思う。
フレームワークのモジュールCGI::SAFを継承して、setupでrun_modeを登録、headerやfillinformのオプションを設定。
デフォルトのrun_modeはdefaultに固定なので、do_defaultを書く。do_default内ではSledgeのようにtemplateを自動で選択はしないので、templateを設定。fillinをする場合は1をセット。これで済みます。前回の配列@errはalertメソッドとなって埋め込まれています。HTML::Templateへも自動で反映されます。入力不足があった場合、

sub do_reg{
	my $self = shift;
	$self->alert("郵便番号が正しく入力されていません") unless $self->param('zip') =~ /^?d{7}$/;
	if($self->alert){
		#エラーなのでフォームに戻る
		return $self->forward('default');
	}
}

と書けます。ずいぶん見通しもよくなりました。

フレームワークのソースは以下。SAFはSmall or Simple Application Frameworkの略。
動作に必要なモジュールは、CGI.pmとClass::Accessor。
欲しいモジュールは、HTML::TemplateとHTML::FillInForm。
CGI::ApplicationとSledgeをかなり参考にしました。

package CGI::SAF;

use strict;
use CGI;
use Carp;
use base qw(Class::Accessor);

__PACKAGE__->mk_accessors(qw(current_run_mode user_req_mode finish fillin template));

sub new{
	my($class,$query)=@_;
	$query=CGI->new() unless $query;
	return undef unless(ref($query) =~ /^CGI/);	
	my $self = {
		_query=>$query,
		_run_modes=>["default"],		
		_alert_array=>[],
		current_run_mode=>"default",
		user_req_mode=>"",
		finish=>undef,
		fillin=>undef,
		template=>undef,
		_html_fillin_props=>{
			fobject=>$query
		},
		_html_template_props=>{
			die_on_bad_params=>0,
			loop_context_vars=>1,
			associate=>$query
		},
		_rediret_header_props=>{},
		_header_props=>{}
		
	};
	bless($self,$class);
	$self->init();
	$self->setup();
	return $self;
}

sub _run_modes{shift->{_run_modes}}
sub _alert_array{shift->{_alert_array}}
sub query{shift->{_query};}
sub param{shift->query->param(@_);}

sub register_run_mode{
	push(@{shift->_run_modes},@_);
}


sub error{
	my $self = shift;
	local $Carp::CarpLevel=$Carp::CarpLevel+1;
	Carp::croak @_;
}

sub header_props{
	my($self,%args) = @_;
	foreach my $key (keys %args){
		if(defined $args{$key}){
			$self->{_header_props}->{$key}=$args{$key};
		}else{
			delete $self->{_header_props}->{$key}
		}
	}
	return $self->{_header_props};
}

sub response{
	my($self,$body,%args) = @_;
	$self->header_props(%args);
	print $self->query->header(%{$self->header_props});
	print $body;
	$self->finish(1);
}

sub redirect_header_props{
	my($self,%args) = @_;
	foreach my $key (keys %args){
		if(defined $args{$key}){
			$self->{_rediret_header_props}->{$key}=$args{$key};
		}else{
			delete $self->{_rediret_header_props}->{$key}
		}
	}
	return $self->{_rediret_header_props};
}

sub redirect{
	my($self,$str,%args) = @_;
	$self->redirect_header_props(%args);
	require URI;
	my $uri = URI->new_abs($str,$self->query->url());
	$self->{_rediret_header_props}->{"-uri"}="$uri";
	print $self->query->redirect(%{$self->redirect_header_props});
	$self->finish(1);
}

sub html_template_props{
	my($self,%args) = @_;
	foreach my $key (keys %args){
		if(defined $args{$key}){
			$self->{_html_template_props}->{$key}=$args{$key};
		}else{
			delete $self->{_html_template_props}->{$key}
		}
	}
	return $self->{_html_template_props};
}

sub html_template{
	my($self,$template,%args)=@_;	
	$self->param('alert_array',$self->_alert_array);
	if(ref($template) eq "SCALAR"){
		$self->{_html_template_props}->{scalarref}=$template;
	}else{
		$self->{_html_template_props}->{filename}=$template;
	}
	$self->html_template_props(%args);
	require HTML::Template;
	return HTML::Template->new(%{$self->html_template_props()});
}

sub html_fillin_props{
	my($self,%args) = @_;
	foreach my $key (keys %args){
		if(defined $args{$key}){
			$self->{_html_fillin_props}->{$key}=$args{$key};
		}else{
			delete $self->{_html_fillin_props}->{$key}
		}
	}
	return $self->{_html_fillin_props};
}

sub html_fillin{
	my($self,$html,%args)=@_;
	$self->{_html_fillin_props}->{scalarref}=?$html;
	$self->html_fillin_props(%args);
	require HTML::FillInForm;
	my $fif = HTML::FillInForm->new();
	return $fif->fill(%{$self->html_fillin_props()});
}

sub make_output_content{
	my $self = shift;
	my $template = $self->template;
	return $self->error("template not found?n") unless $template;
	my $tmpl=$self->html_template($template);
	my $html=$tmpl->output;
	if($self->fillin){
		$html=$self->html_fillin($html);
	}
	return $html;
}

sub alert{
	my $self = shift;
	$self->push_alert(@_);
	return $self->have_alert();
}
sub push_alert{
	my $self=shift;
	push(@{$self->_alert_array},map {{val=>$_}} @_);
}
sub have_alert{
	my $self = shift;
	return ($#{$self->_alert_array} > -1) ? 1 : 0;
}

sub forward{
	my($self,$rm)=@_;
	$rm = "default" unless $rm;
	my %hash = map{$_=>1} @{$self->_run_modes};
	$self->error("Not defined such run mode '$rm'?n") unless exists $hash{$rm};
	$self->current_run_mode($rm);
	my $run_mode = "do_" . $rm;	
	return $self->$run_mode();
}

sub run{
	my $self = shift;
		
	my $body;
	eval{
		$self->prerun();
		
		return if $self->finish;
		
		my $rm = $self->mode_fixer();
		$rm = "default" unless $rm;
		$self->user_req_mode($rm);
		
		#do something
		$self->forward($rm);

		return if $self->finish;
		
		#create output content unless finish
		$body=$self->make_output_content();
	};
	if($@){
		$body=$self->do_error($@);
	}
	
	return if $self->finish;
	
	$body = "" unless defined $body;
	
	print $self->query->header(%{$self->header_props});
	print $body;
}




sub init{}
sub setup{}
sub prerun{}

sub mode_fixer{
	shift->param('mode');
}

sub do_default{
	my $self = shift;
	return $self->response("CGI Simple Application");
}


sub do_error{
	my $self=shift;
	return $self->response(@_);
}


1;

仕事に使えるポータビリティの高い状態を維持しつつ便利で楽なものをもうすこし考えてみようと思います。

blog.nomadscafe.jp

かぜぶろの日記とWeb ApplicationとPerlとLinux

シンプルなWebアプリなCGIを書いてみる２