view Lib/Engine/CGI.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

use strict;
package Engine::CGI;
use base 'CGI';
use Encode;
use Common;

BEGIN {
    DeclareProperty Expires => ACCESS_ALL;
}

my $query;

sub Query {
    $query = new Engine::CGI unless $query;
    return $query;
}


my $fcgi_loaded = 0;
sub Accept {
    my ($self) = shift;
    require CGI::Fast unless $fcgi_loaded;
    $fcgi_loaded = 1;
    
    my $fquery = CGI::Fast->new();
    $query = $fquery ? $self->new($fquery) : undef;
    return $query;
}

sub as_list {
    return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
}

sub header {
    my ($this,%args) = @_;
    
    $args{'-cookies'} = [as_list($args{'-cookies'}), values %{$this->{'cookies_list'}}] if $this->{'cookies_list'};
    $args{'-expires'} = $this->{$Expires} || 'now';
    
    $this->SUPER::header(%args);
}

sub SetCookies {
    my ($this,@cookies) = @_;
    
    foreach (@cookies) {
        $this->{'cookies_list'}{$_->name} = $_;
    }
}

sub param {
    my ($this) = shift;
    my $charset = $this->charset or die new Exception("Encoding is not defined");
    if (wantarray) {
        return map { Encode::is_utf8($_) ? $_ : Encode::decode($charset,$_,Encode::LEAVE_SRC) } $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
    } else {
        my $val = $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
        return (Encode::is_utf8($val) ? $val : Encode::decode($charset,$val,Encode::LEAVE_SRC));
    }
}

sub param_raw {
    my $this = shift;
    return $this->SUPER::param(@_);
}

1;