File Coverage

blib/lib/CGI/Test/Input/Custom.pm

Criterion	Covered	Total	%
statement	18	38	47.3
branch	0	2	0.0
condition	0	2	0.0
subroutine	6	13	46.1
pod	4	4	100.0
total	28	59	47.4

package CGI::Test::Input::Custom;

our $VERSION = '0.03';

use strict;
use warnings;
use Carp;
use Encode qw(encode);

use base 'CGI::Test::Input';

sub _firstdef {
    defined && return $_ for @_;
    undef;
}

sub new {
    my ($class, %args) = @_;
    my $this = bless {}, $class;
    $this->_init;
    $this->{_ctic_mime_type} = _firstdef(delete $args{-mime_type}, 'application/octet-stream');
    $this->{_data_decoded} = _firstdef(delete $args{-content}, '');
    $this->{_encoding} = _firstdef(delete $args{-encoding}, 'utf8');
    %args and croak "unsupported constructor argument(s) ".join(', ', keys %args);
    $this->{stale} = 1;
    $this;
}

*make = \&new;

for (qw(widget field file file_now)) {
    my $m = "add_$_";
    no strict 'refs';
    *$m = sub { croak "method '$m' is not supported by ".__PACKAGE__." objects" };
}

sub set_mime_type {
    my ($this, $type) = @_;
    $this->{_ctic_mime_type} = $type;
}

sub mime_type { shift->{_ctic_mime_type} }

sub _build_data {
    my $this = shift;
    encode($this->{_encoding}, $this->{_data_decoded})
}

sub add_content {
    my $this = shift;
    $this->{_data_decoded} .= join('', @_);
    $this->{stale} = 1;
}



1;
__END__