Root.pmさらし。

自由研究だし、問題ないだろう。
こんなの書いてます。
＃Tab = 8 spacesなのか。

package troublecode::Controller::Root;

use strict;
use warnings;
use base 'Catalyst::Controller';
#use Catalyst 'FormValidator';

#
# Sets the actions in this controller to be registered with no prefix
# so they function identically to actions created in MyApp.pm
#
__PACKAGE__->config->{namespace} = '';

=head1 NAME

troublecode::Controller::Root - Root Controller for troublecode

=head1 DESCRIPTION

[enter your description here]

=head1 METHODS

=cut

=head2 default

=cut

sub begin : Private {
	my ( $self, $c ) = @_;
	
	__PACKAGE__->config( uploadtmp => './' );				# troublecode.ymlに書くべきか
	$c->stash->{'title'}	= "トラブルコード管理データベース";
	$c->forward('get_localtime');
}

sub default : Private {
	my ( $self, $c ) = @_;

	my @it	= troublecode::Model::CDBI::Machinelist->retrieve_all;
	$c->stash->{'it'}		= \@it;
	$c->stash->{'subtitle'}	= 'トップページ';
	$c->stash->{'template'}	= 'index.tt';
}

# 機種名リストの登録・修正
sub regist_machine : Path('regist/machine') {
	my ( $self, $c ) = @_;
	my @old_data;
	
	if(
		$c->req->param('machine')		ne "" &&
		$c->req->param('registrant')	ne ""
	){	# 登録情報があれば、登録してトップページにもどる
		if(@old_data = troublecode::Model::CDBI::Machinelist->search(
			machine		=> $c->req->param('machine')
			)
		){
			# 機種名が既存だったら、何もしない
		}
		else{
			troublecode::Model::CDBI::Machinelist->insert({
				machine		=> $c->req->param('machine'),
				registrant	=> $c->req->param('registrant'),
				time		=> $c->stash->{'time'}
			});
			
			# ログ記録
			$c->stash->{'registrant'}	= $c->req->param('registrant');
			$c->stash->{'changelog'}	= '[regist/machine] add ' . $c->req->param('machine');
			$c->forward('save_log');
		}
		$c->res->redirect('/');
		return 0;
	}
	else{	# 登録情報がなければ、機種登録画面を表示
		
		$c->stash->{'subtitle'}	= '機種登録';
		$c->stash->{'template'}	= 'regist_m.tt';
	}
}

# コードリストの登録・修正
sub regist_code : Path('regist/code') {
	my ( $self, $c ) = @_;
	my @old_data;
	
	$c->forward('check_condition', [1]);		# b. 登録要件を満たしているかどうか
	$c->forward('check_existing_code', [1]);	# a. 既存コードがあるかないか
	$c->forward('regist', [$c->stash->{'existing'}, $c->stash->{'condition'}, 1]);	# 無名のリストのリファレンスで引数わたすよ。
	$c->res->redirect('/show/code?machine=' . $c->req->param('machine')) if ($c->stash->{'registration'} eq 'done');	# なんかダサい
}

# コードリストの表示
sub show_code : Path('show/code') {
	my ( $self, $c ) = @_;
	
	$c->stash->{'machine'}	= $c->req->query_parameters->{'machine'};
	
	my @datalist	= sort bycode troublecode::Model::CDBI::Codelist->search( machine => $c->stash->{'machine'} );
	$c->stash->{'datalist'}	= \@datalist;
	$c->stash->{'subtitle'}	= '[' . $c->stash->{'machine'} . ']トラブルコード一覧';
	$c->stash->{'template'}	= 'codelist.tt';
}

# コード詳細の表示
sub show_code_detail : Path('show/code/detail') {
	my ( $self, $c ) = @_;
	
	$c->stash->{'machine'}	= $c->req->query_parameters->{'machine'};
	
	my @datalist	= sort bycode troublecode::Model::CDBI::Codelist->search(
		machine		=> $c->req->param('machine'),
		main		=> $c->req->param('main1'),
		sub			=> $c->req->param('sub1'),
		state		=> 'REGISTED'
	);
	$c->stash->{'datalist'}	= \@datalist;
	$c->stash->{'subtitle'}	= '[' . $c->stash->{'machine'} . ']トラブルコード一覧';
	$c->stash->{'template'}	= 'show_detail.tt';
}

# 変更履歴の表示
sub show_log : Path('show/log') {
	my ( $self, $c ) = @_;
	
	my @it	= sort bytime troublecode::Model::CDBI::Changelog->retrieve_all;
	$c->stash->{'it'}		= \@it;
	$c->stash->{'subtitle'}	= '変更履歴';
	$c->stash->{'template'}	= 'changelog.tt';
}

# CSVファイルからのデータ取り込み
sub import : Global {
	my ( $self, $c ) = @_;
	my $filename;
	my $target;
	my $upload;
	my ( $main, $sub, $content );
	my @data;
	my $i = 0;
	
	$upload = $c->request->upload('import');
	
	if( $c->req->param('form_submit') eq 'yes' ){
		# データ登録
		$i++;
		while($c->req->param('main'.$i) ne ""){
			$c->forward('check_condition', [$i]);		# b. 登録要件を満たしているかどうか
			$c->forward('check_existing_code', [$i]);	# a. 既存コードがあるかないか
			$c->forward('regist', [$c->stash->{'existing'}, $c->stash->{'condition'}, $i]);
			$i++;
		}
		$c->res->redirect('/show_c?machine=' . $c->req->param('machine'));
		return 0;
	}
	else{
		# 内容確認ページを表示
		
#		$upload		= $c->request->upload('import');
		unless($upload && $c->req->param('registrant') ne ""){
			$c->res->redirect('/show_c?machine=' . $c->req->param('machine'));
			return 0;
		}
		if( $filename = $upload->filename ){
			# このあたりのファイル処理は、Catalyst::Manual::Cookbook 参照
			# http://www.tcool.org/catalyst/Cookbook.html
			$target	= "./tmp/$filename";
			$upload->copy_to($target);
			$c->stash->{'machine'}	= $c->req->param('machine');
			open(FILE, $target) || die "$targetが開けませんでした";
			while(<FILE>){
				($main, $sub, $content) = split(/\t/, $_);
				$data[$i] = {	# 無名のハッシュのリファレンスを渡す。これぞPerlだ。
					main		=> $main,
					sub			=> $sub,
					content		=> $content,
					client		=> $c->req->param('registrant'),
					registrant	=> $c->req->param('registrant'),
				};
				$i++;
			}
			close(FILE);
		}
		unlink $upload->tempname;
		$c->stash->{'data'}		= \@data;
		
		$c->stash->{'subtitle'}	= 'インポートデータ一覧';
		$c->stash->{'template'}	= 'import.tt';
	}
}

# 現在時刻の取得
sub get_localtime : Private {
	my ( $self, $c ) = @_;
	
	my ($sec, $min, $hour, $day, $mon, $year, $wday) = localtime(time);
	$c->stash->{'time'} = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $day, $hour, $min, $sec);
}

# コードの登録有無
sub check_existing_code : Private {
	my ( $self, $c, $i ) = @_;
	my @old_data;
	
	if(@old_data = troublecode::Model::CDBI::Codelist->search(
		machine		=> $c->req->param('machine'),
		main		=> $c->req->param('main'.$i),
		sub			=> $c->req->param('sub'.$i),
		state		=> 'REGISTED')
	){
		$c->stash->{'existing'}			= "exist";
		$c->stash->{'old_data'}			= \@old_data;
		$c->stash->{'machine'}			= $c->req->param('machine'.$i);
		$c->stash->{'main'.$i}			= $c->req->param('main'.$i);
		$c->stash->{'sub'.$i}			= $c->req->param('sub'.$i);
		$c->stash->{'content'.$i}		= $old_data[0]->get('content');
		$c->stash->{'detail'.$i}		= $old_data[0]->get('detail');
		$c->stash->{'cause'.$i}			= $old_data[0]->get('cause');
		$c->stash->{'maintenance'.$i}	= $old_data[0]->get('maintenance');
		$c->stash->{'test_method'.$i}	= $old_data[0]->get('test_method');
		$c->stash->{'client'.$i}		= $old_data[0]->get('client');
		$c->stash->{'registrant'.$i}	= $old_data[0]->get('registrant');
		$c->stash->{'detect'.$i}		= $old_data[0]->get('detect');
		$c->stash->{'mode'.$i}			= "";
#		$c->stash->{'memory'.$i}		= $old_data[0]->get('memory');
		$c->stash->{'cancel'.$i}		= $old_data[0]->get('cancel');
#		$c->stash->{'regist_time'.$i}	= $old_data[0]->get('regist_time');
#		$c->stash->{'state'.$i}			= "REGISTED";
	}
	else{
		$c->stash->{'existing'}			= "not";	# Use of uninitialized value in string ne at ...対策で入れてみたけど、外した模様
	}
}

# 登録内容が要件をみたしているか
# Validatorの使い方は↓このへん参照
# http://search.cpan.org/~markstos/Data-FormValidator-4.50/lib/Data/FormValidator.pm
# http://search.cpan.org/~markstos/Data-FormValidator-4.50/lib/Data/FormValidator/Results.pm
sub check_condition : Private {
	my ( $self, $c, $i ) = @_;
	
	$c->form(
		optional			=> ["content$i", "detail$i", "cause$i", "maintenance$i", "test_method$i", "mode$i", "cancel$i", "detect$i", "state$i"],
		required			=> ["main$i", "sub$i", "machine", "client$i", "registrant$i", "memory$i"],
		constraint_method_regexp_map	=> {
			qr/^main$i$/		=>	qr/^[A-Za-z][A-Za-z0-9]$/,	# 半角英数2桁					NOT NULL
			qr/^sub$i$/			=>	qr/^[A-Za-z0-9]{2}$/,		# 半角英数2桁					NOT NULL
			qr/^machine$/		=>	qr/^[\w-]{1,32}$/,			# 文字列(VARCHAR(32)			NOT NULL
#			qr/^content$i$/		=>	,							# 文字列(TEXT)
#			qr/^detail$i$/		=>	,							# 文字列(TEXT)
#			qr/^cause$i$/		=>	,							# 文字列(TEXT)
#			qr/^maintenance$i$/	=>	,							# 文字列(TEXT)
#			qr/^test_method$i$/	=>	,							# 文字列(TEXT)
#			qr/^client$i$/		=>	,							# 文字列(TEXT)					NOT NULL
#			qr/^registrant$i$/	=>	,							# 文字列(TEXT)					NOT NULL
			qr/^detect$i$/		=>	qr/^[\w]{1,32}$/,			# 文字列(VARCHAR(32)			
#			qr/^mode$i$/		=>	,							# 文字列(VARCHAR(45)			reserved
			qr/^memory$i$/		=>	qr/YES|NO/,					# ENUM('YES', 'NO')				NOT NULL
			qr/^cancel$i$/		=>	qr/^\w\w-\w\w$/				# MM-SS
#			qr/^regist_time$i$/	=>	,							# DATETIME(自動入力)
#			qr/^state$i$/		=>	qr/REGISTED|DELETED/		# ENUM('REGISTED', 'DELETED')	NOT NULL
#			qr/^change_time$i$/	=>	,							# DATETIME(自動入力)
		}
	);
	# とりあえず今はチェックにひっかかたら、問答無用「アウト。出直して来い」仕様
	
	$c->stash->{'condition'}	= ($c->form->has_missing || $c->form->has_invalid) ? "not" : "meet";
	foreach my $item ($c->form->invalid){
		# ここ使って、「この入力欄、内容おかしいですよ」が表示できるようになる、ハズ。
		$c->stash->{system_message} .= " $item";
	}
	
	# エラー発生時の修正入力のため、フォーム値を継承
	$c->stash->{'machine'}				= $c->req->param('machine');
	$c->stash->{'main'			. $i}	= $c->req->param('main'			. $i);
	$c->stash->{'sub'			. $i}	= $c->req->param('sub'			. $i);
	$c->stash->{'content'		. $i}	= $c->req->param('content'		. $i);
	$c->stash->{'detail'		. $i}	= $c->req->param('detail'		. $i);
	$c->stash->{'cause'			. $i}	= $c->req->param('cause'		. $i);
	$c->stash->{'maintenance'	. $i}	= $c->req->param('maintenance'	. $i);
	$c->stash->{'test_method'	. $i}	= $c->req->param('test_method'	. $i);
	$c->stash->{'client'		. $i}	= $c->req->param('client'		. $i);
	$c->stash->{'registrant'	. $i}	= $c->req->param('registrant'	. $i);
	$c->stash->{'detect'		. $i}	= $c->req->param('detect'		. $i);
	$c->stash->{'mode'			. $i}	= "";
#	$c->stash->{'memory'		. $i}	= $c->req->param('memory'		. $i);
	$c->stash->{'cancel'		. $i}	= $c->req->param('cancel'		. $i);
#	$c->stash->{'regist_time'	. $i}	= $c->stash->{'time'};
#	$c->stash->{'state'			. $i}	= "REGISTED";
}

# コードの登録
sub regist : Private {
	my ( $self, $c, $existing, $condition, $i ) = @_;
	my @machine_data;
	
	if( $existing eq "exist" && $condition eq "meet" )
	# a1+b1 既存コード有＋登録要件有 -> modify and regist
		{
			$c->stash->{old_data}->[0]->set( state => 'CHANGED' );
			$c->stash->{old_data}->[0]->set( change_time	=> $c->stash->{time} );
			$c->stash->{system_message} = '更新しました。';
			troublecode::Model::CDBI::Codelist->insert({
				machine		=> $c->req->param('machine'),
				main		=> $c->req->param('main'		. $i),
				sub			=> $c->req->param('sub'			. $i),
				content		=> $c->req->param('content'		. $i),
				detail		=> $c->req->param('detail'		. $i),
				cause		=> $c->req->param('cause'		. $i),
				maintenance	=> $c->req->param('maintenance'	. $i),
				test_method	=> $c->req->param('test_method'	. $i),
				client		=> $c->req->param('client'		. $i),
				registrant	=> $c->req->param('registrant'	. $i),
				detect		=> $c->req->param('detect'		. $i),
				mode		=> "",
				memory		=> $c->req->param('memory'		. $i),
				cancel		=> $c->req->param('cancel'		. $i),
				regist_time	=> $c->stash->{'time'},
				state		=> "REGISTED"
			});
			@machine_data = troublecode::Model::CDBI::Machinelist->search(machine	=> $c->req->param('machine'));
			$machine_data[0]->set( time => $c->stash->{'time'} );
			$c->stash->{'machine'}	= $c->req->param('machine');
			$c->stash->{'registration'} = 'done';
			$c->stash->{'template'}	= 'index.tt';
			
			# ログ記録
			$c->stash->{'registrant'}	= $c->req->param('registrant' . $i);
			$c->stash->{'changelog'}	= '[regist/code] modify '
										. $c->req->param('machine')
										. ':'
										. $c->req->param('main' . $i)
										. '-' . $c->req->param('sub' . $i);
			$c->forward('save_log');
		}
	if( $existing eq "exist" && $condition ne "meet" )
	# a1+b2 既存コード有＋登録要件無 -> 登録画面
		{
			$c->stash->{'machine'}	= $c->req->param('machine');
			$c->stash->{'subtitle'}	= '[' . $c->stash->{'machine'} . ']コード登録';
			$c->stash->{'template'}	= 'regist_c.tt';
		}
	if( $existing ne "exist" && $condition eq "meet" )
	# a2+b1 既存コード無＋登録要件有 ->            regist
		{	
			$c->stash->{system_message} = '新規登録しました。';
			troublecode::Model::CDBI::Codelist->insert({
				machine		=> $c->req->param('machine'),
				main		=> $c->req->param('main'		. $i),
				sub			=> $c->req->param('sub'			. $i),
				content		=> $c->req->param('content'		. $i),
				detail		=> $c->req->param('detail'		. $i),
				cause		=> $c->req->param('cause'		. $i),
				maintenance	=> $c->req->param('maintenance'	. $i),
				test_method	=> $c->req->param('test_method'	. $i),
				client		=> $c->req->param('client'		. $i),
				registrant	=> $c->req->param('registrant'	. $i),
				detect		=> $c->req->param('detect'		. $i),
				mode		=> "",
				memory		=> $c->req->param('memory'		. $i),
				cancel		=> $c->req->param('cancel'		. $i),
				regist_time	=> $c->stash->{'time'},
				state		=> "REGISTED"
			});
			@machine_data = troublecode::Model::CDBI::Machinelist->search(machine	=> $c->req->param('machine'));
			$machine_data[0]->set( time => $c->stash->{'time'} );
			$c->stash->{'machine'}	= $c->req->param('machine');
			$c->stash->{'registration'} = 'done';
			$c->stash->{'template'}	= 'index.tt';
			
			# ログ記録
			$c->stash->{'registrant'}	= $c->req->param('registrant' . $i);
			$c->stash->{'changelog'}	= '[regist/code] add '
										. $c->req->param('machine')
										. ':'
										. $c->req->param('main' . $i)
										. '-' . $c->req->param('sub' . $i);
			$c->forward('save_log');
		}
	if( $existing ne "exist" && $condition ne "meet" )
	# a2+b2 既存コード無＋登録要件無 -> 登録画面
		{
			$c->stash->{'machine'}	= $c->req->param('machine');
			$c->stash->{'subtitle'}	= '[' . $c->stash->{'machine'} . ']コード登録';
			$c->stash->{'template'}	= 'regist_c.tt';
		}
}

# コードの削除
sub delete_code : Path('delete/code') {
	my ( $self, $c ) = @_;
	
	$c->forward('check_existing_code', [1]);	# a. 既存コードがあるかないか
	$c->stash->{old_data}->[0]->set( state => 'CHANGED' );
	$c->stash->{old_data}->[0]->set( change_time	=> $c->stash->{time} );
	$c->stash->{system_message} = '更新しました。';
	
	# ログ記録
	$c->stash->{'registrant'}	= $c->req->param('registrant1');
	$c->stash->{'changelog'}	= '[regist/code] delete '
								. $c->req->param('machine')
								. ':'
								. $c->req->param('main1')
								. '-' . $c->req->param('sub1');
	$c->forward('save_log');
	$c->stash->{'template'}	= 'codelist.tt';
	$c->res->redirect('/show_c?machine=' . $c->req->param('machine'));
	return 0;
}

# sort用関数(トラブルコード順にそろえるよ)
sub bycode : Private {
	$a->get('main') cmp $b->get('main') ||
	$a->get('sub') cmp $b->get('sub');
}

# sort用関数(日付順にそろえるよ)
sub bytime : Private {
	$b->get('time') cmp $a->get('time');
}

# ログ保存
sub save_log : Private {
	my ( $self, $c ) = @_;
	
	troublecode::Model::CDBI::Changelog->insert({
		time		=> $c->stash->{'time'},
		registrant	=> $c->stash->{'registrant'},
		content		=> $c->stash->{'changelog'}
	});
}

# 派生機種への一括コピー
sub duplicate : Global {
	my ( $self, $c ) = @_;
	my @machine_list;
	my @code_list;
	
	if(@machine_list = troublecode::Model::CDBI::Machinelist->search(
		machine		=> $c->req->param('machine')
		)
	){
		# 機種名が既存だったら、何もしない。お帰りはこちら。
		$c->stash->{'subtitle'}	= 'トップページ';
		$c->stash->{'template'}	= 'index.tt';
		$c->stash->{'system_message'} .= "copy_from読み込み失敗";
		$c->res->redirect('/');
		return 0;
	}
	else{
		troublecode::Model::CDBI::Machinelist->insert({
			machine		=> $c->req->param('machine'),
			registrant	=> $c->req->param('registrant'),
			time		=> $c->stash->{'time'}
		});
	}
	
	if(@code_list = troublecode::Model::CDBI::Codelist->search(
		machine		=> $c->req->param('copy_from'),
		state		=> 'REGISTED')
	){
		foreach my $data (@code_list){
			troublecode::Model::CDBI::Codelist->insert({
				machine		=> $c->req->param('machine'),
				main		=> $data->get('main'),
				sub			=> $data->get('sub'),
				content		=> $data->get('content'),
				detail		=> $data->get('detail'),
				cause		=> $data->get('cause'),
				maintenance	=> $data->get('maintenance'),
				test_method	=> $data->get('test_method'),
				client		=> $c->req->param('registrant'),
				registrant	=> $c->req->param('registrant'),
				detect		=> $data->get('detect'),
				mode		=> $data->get('mode'),
				memory		=> $data->get('memory'),
				cancel		=> $data->get('cancel'),
				regist_time	=> $c->stash->{'time'},
				state		=> "REGISTED"
			});
#			$c->stash->{'system_message'} .= ": " . $data->get('main');
		}
	}
	else{
			$c->stash->{'system_message'} .= "copy_from読み込み失敗";
	}
	$c->stash->{'subtitle'}	= 'トップページ';
	$c->stash->{'template'}	= 'index.tt';
	$c->res->redirect('/');
	return 0;
}

=head2 end

Attempt to render a view, if needed.

=cut 

sub end : ActionClass('RenderView') {
	my ( $self, $c ) = @_;
#	$c->stash->{system_message} = 'system_message';
#	$c->stash->{'end_message'} = "endを通過";
	foreach my $plugin ($c->registered_plugins){
		$c->stash->{'plugins'}	.= " $plugin,";
	}
	$c->forward('troublecode::View::TT');
}

=head1 AUTHOR

Catalyst developer

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__END__
# idea
済　一覧から指定して修正
済　CSVからのインポート
済　他機種からの一括コピー
・　CSVへのエクスポート
　　→これでいいんじゃね
　　　◆bricklife.weblog.*: Webアプリから２行でExcelファイルを出力する方法
　　　　http://www.bricklife.com/weblog/000051.html
済　入力内容のチェック
→　ページデザインの整理(これまともにやろうとすると、クラス図かかないとだめか？)
・　入力内容のサニタイズ
済　/show_cからコードを指定して修正するのができなくなってる
済　空欄のままファイル読み込みすると止まる
・　ユーザー認証
・　機種串刺しの一覧表示
・　読み込みファイルがバリデーションでひっかかると処理がとまる？
済　/show/codeとか/regist/machineみたいな区切りにすべきか
・　formをttファイルに直書きしてるけど、もしかしてform生成pluginを使うのが当世風？
済　$c->registered_pluginsの実験
・　登録・修正・削除系を管理ページに独立？
・　実データの登録(これがめんどくさい…
済　更新履歴の保存

全文検索⇒MySQLのFULLTEXTを使う方法があるけど、めんどくさい？
		ブラウザのSearch使ってくれというのはダメか。ダメだよなぁ。


/index		: 機種一覧の表示
　link→/show_c
/show_c		: 機種ごとのコード一覧の表示
　link→/regist_c
/regist_c	: コードの登録
　link→/index
/regist_m	: 機種の登録
/show_m		: /indexと同じなので廃止