package Alice;
use base qw/Class::Accessor::Fast/;

use strict;
use warnings;
use CGI::Carp qw/fatalsToBrowser/;

#use FindBin::libs;
use Dumpvalue;
use YAML;
use HTTP::Engine;
use CGI::Session;
use Tenjin;
use Cache::Memcached;

our $VERSION = '0.01';

__PACKAGE__->mk_accessors(qw/controller action session sid cache dbh req config headers status html user/);

=head1 NAME

Alice - Tiny Web Application Framework

=head1 SYNOPSIS

  ## Sample Application
  package SampleApp;
    use base qw/Alice/;

    use strict;
    use warnings;
    use CGI::Carp qw/fatalsToBrowser/;

    use SampleApp::Schema;

  1;

  ## Your CGI Script
  #!/usr/bin/perl -w

  use strict;
  use warnings;
  use CGI::Carp qw/fatalsToBrowser/;

  use lib qw(../lib);
  use SampleApp;

  # Server exec
  SampleApp->new->start;

  1;


=head1 DESCRIPTION

This module provide make tiny Web Application.

Root/
  conf/
    config.yaml
  lib/
    SampleApp/
      Controller/
        Main.pm
        ...
      Schema/
        User.pm
        ...
      View/
        Main/
          index.html
          test.html
          ...
      Schema.pm
    SampleApp.pm
  public/
    js/
    css/
    images/
    cgi.pl
    index.html
    ...
  script/
    server.pl
  test/
    test.pl
    ...
  tmp/
    debug/
    log/
    session/

=head1 METHODS

=over 4

=item new

=cut

# インスタンス生成
sub new {
  my $class = shift;
  my %args = @_;
  
  # 細かいローカル変数代り
  $args{data} = {};
  
  return bless \%args, $class;
}

=item start

=cut

# フロント
sub start {
  my $self = shift;
  my %args = @_;
  
  # 設定ファイル読み込み
  $self->config(YAML::LoadFile('../conf/config.yaml'));
  
  # モード切り替えるか？
  if (defined($args{mode}) && ($args{mode} eq 'CGI' || $args{mode} eq 'Test')) {
    $self->config->{engine}->{interface}->{module} = $args{mode};
  }
  
  # 主な処理はココで
  $self->config->{engine}->{interface}->{request_handler} = sub {
    # ヘッダの定義
    $self->status(200);
    $self->headers(HTTP::Headers->new);
    
    # HTTP::Engine::Request
    $self->req(shift);
    
    # デコードなどここで行う
    _decode($self->req);
    
    # ルーティングを行う
    {
      my $override_routing = 'main'->can('routing') ? 1 : 0;
      my @routing = $override_routing ? &main::routing($self->req->uri->path) : $self->routing($self->req->uri->path);
      $self->controller($routing[0]);
      $self->action($routing[1]);
    }
    
    # キャッシュ
    if (defined($self->config->{memcached})) {
      $self->cache(Cache::Memcached->new($self->config->{memcached}));
    }
    
    # セッションID取得
    if (defined($self->req->cookie('SessionId')) && $self->req->cookie('SessionId') =~ /^SessionId=([\w]+?);/) {
      $self->sid($1);
    }
    
    # コントローラで色々操作
    my $controller_file = '../lib/'.ref($self).'/Controller/'.$self->controller.'.pm';
    if (-e $controller_file) {
      my $controller = ref($self).'::Controller::'.$self->controller;
      my $action = $self->action;
      
      eval("use $controller");
      if ($@) {
        $self->error('Can not use Control File');
      }
      else {
        if ($controller->can($action)) {
          # DB接続
          my $db_config = $self->config->{database};
          if ($db_config->{schema}) {
            $self->dbh($db_config->{schema}->connect($db_config->{dsn}, $db_config->{user}, $db_config->{pass}));
          }
          
          # 事前処理
          my $beforeAction = 'beforeAction';
          if ($controller->can($beforeAction)) {
            $controller->$beforeAction($self);
          }
          
          # コントローラで処理実行
          $controller->$action($self);
          
          # 事後処理
          my $afterAction = 'afterAction';
          if ($controller->can($afterAction)) {
            $controller->$afterAction($self);
          }
          
          # debug
          #Dumpvalue->new->dumpValue($self);
          
          # テンプレート描画
          my $template_path = '../lib/'.ref($self).'/View/';
          my $template_file = $self->controller.'/'.$self->action.'.html';
          if (-e $template_path.$template_file) {
            # ビューで使う変数追加(設定系、クエリ、セッションデータ)
            $self->set('global', $self->config->{global});
            $self->set('req', $self->req);
            $self->set('session', $self->session);
            $self->set('user', $self->user);
            
            $self->html(Tenjin::Engine->new({ path => [$template_path] })->render($template_file, $self->{data}));
          }
          else {
            $self->error('Template file does not exists.');
          }
        }
        else {
          $self->error('not active action.');
        }
      }
    }
    else {
      $self->error("Controller file does not exists: $controller_file");
    }
    
    # 終了画面(Label)
    ResponsePhase:
    
    # ヘッダをセット
    $self->headers->header('content-type' => 'text/html;charset=utf-8');
    
    # レスポンスを返す
    return HTTP::Engine::Response->new(
      headers => $self->headers,
      status  => $self->status,
      body    => $self->html,
    );
  };
  
  if (defined($args{mode}) && $args{mode} eq 'Test') {
    HTTP::Engine->new($self->config->{engine})->run($args{req});
  }
  else {
    HTTP::Engine->new($self->config->{engine})->run;
  }
}

=item error

=cut

# エラー処理
sub error {
  my($self, $text) = @_;
  
  my $template_file = '../lib/'.ref($self).'/View/Error/index.html';
  if (-e $template_file) {
    $self->set('req', $self->req);
    $self->set('error_msg', $text);
    
    $self->html(Tenjin::Engine->new->render($template_file, $self->{data}));
  }
  else {
    die("Error File does not exists\nError Message: $text\n");
  }
  
  goto ResponsePhase;
}

=item redirect

=cut

# リダイレクト処理
sub redirect {
  my($self, $uri) = @_;
  
  $self->headers->header('location' => $uri);
  $self->status(301);
  
  goto ResponsePhase;
}

=item set

=cut

# ビューに渡すハッシュ生成
sub set {
  my($self, $key, $args) = @_;
  
  $self->{data}->{$key} = $args;
}

=item log

=cut

# ログ出力
sub log {
  my($self, $text) = @_;
  
  my @date = (localtime(time))[5,4,3];
  open my $log_file, '>>', '../tmp/log/'.($date[0]+1900).'-'.($date[1]+1).'-'.$date[2].'.dat';
  print $log_file ($date[0]+1900).'-'.($date[1]+1).'-'.$date[2].' ::: '.(caller).' ::: '.$text.$/;
  close $log_file;
}

=item routing

=cut

# ルーティングの規約(デフォルト用, 基本的にserver.plとかで上書きする)
sub routing {
  my($self, $path) = @_;
  
  # error case
  if ($path =~ m{^/(application|error)}) {
    die('routing error');
  }
  # /:controller/:action
  elsif ($path =~ m{^/([\w]+?)/([\w]+)}) {
    return(ucfirst($1), $2);
  }
  # /:controller/index
  elsif ($path =~ m{^/([\w]+)}) {
    return(ucfirst($1), 'index');
  }
  # /main/index
  else {
    return('Main', 'index');
  }
}

=item _decode

=cut

# デコード処理
sub _decode {
  my $req = shift;
  
  # is $req->param ...?
  for my $key($req->parameters) {
    next if ref $req->param($key) and ref $req->param($key) ne 'ARRAY';
    for (ref $req->param($key) ? @$req->param($key) : ($req->param($key))) {
      utf8::decode($_);
      
      # auto escape?
#      $_ =~ s/&/&/g;
#      $_ =~ s/</&lt;/g;
#      $_ =~ s/>/&gt;/g;
#      $_ =~ s/"/&quot;/g;
#      $_ =~ s/'/&#39;/g;
#      $_ =~ s/\\//g;
    }
  }
}

=back

=head1 AUTHOR

Yuki Anai <yuki@cpan.org>

=head1 COPYRIGHT

This program is free.

=cut

1;