view Lib/Engine/CGI.pm @ 90:dc1da0389db7

Small improvements in the abstract object class Added support for a class data, documentation Additional tests for the new functionality
author wizard
date Mon, 26 Apr 2010 03:10:03 +0400
parents 16ada169ca75
children 76515373dac0
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;