File Coverage

blib/lib/Lemonldap/Portal/Script.pm

Criterion	Covered	Total	%
statement	0	82	0.0
branch	0	12	0.0
condition			n/a
subroutine	0	11	0.0
pod			n/a
total	0	105	0.0

package Lemonldap::Portal::Script;

our $VERSION = '0.1';

{

    package  Lemonldap::Portal::Script::Exchange;

    sub new {
        my $class = shift;
        my %args  = @_;
        my $self;
        $self = \%args;
        $self->{line} = [];
        bless $self, $class;
        return $self;
    }

    sub set_method {
        my $self  = shift;
        my $_line = shift;
        if ( $_line =~ /^GET/ ) {
            $self->{method} = 'GET';
        }
        else {
            $self->{method} = 'POST';

        }
    }

    sub set_ResponseCode {
        my $self  = shift;
        my $_line = shift;
        ( $self->{responsecode} ) = $_line =~ /(\d\d\d)/;
    }

    sub set_tirade {
        my $self      = shift;
        my $_table    = shift;
        my $_question = shift;
        $self->{$_table} = $_question;
    }

    sub set_status {
        my $self   = shift;
        my $_value = shift;
        $self->{require} = $_value;
    }

    sub add_string {
        my $self   = shift;
        my $_value = shift;
        push @{ $self->{line} }, $_value;
    }

    sub as_string {
        my $self = shift;
        my $a .= $self->{requete} . "\n";
        for ( @{ $self->{line} } ) {
            $a .= $_ . "\n";
        }
        return $a;
    }

    1;

    package Lemonldap::Portal::Script::Response;

    sub new {
        my $class = shift;
        my %args  = @_;
        my $self;
        $self                  = \%args;
        $self->{headers}       = [];
        $self->{headers_test}  = [];
        $self->{headers_model} = [];
        bless $self, $class;
        return $self;
    }

    sub add_header {
        my $self  = shift;
        my $_line = shift;
        my %STORE = ( 'content-type' => 1, );

        my %TEST_STORE = (
            'location'   => "%LOCATION%",
            'set-cookie' => "%SETCOOKIE%",
        );
        ( my $_header, my $_value ) = $_line =~ /(^.+?):\s(.+)/;

        $_value =~ s/^ +//;
        if ( $TEST_STORE{ lc($_header) } ) {
            push @{ $self->{headers_test} }, $_header . "#" . $_value;
            push @{ $self->{headers_model} },
              $_header . "#" . $TEST_STORE{ lc($_header) };
        }
        if ( $STORE{ lc($_header) } ) {
            push @{ $self->{headers} }, $_header . "#" . $_value;
        }

    }

    1;

    package Lemonldap::Portal::Script::Question;

    sub new {
        my $class = shift;
        my %args  = @_;
        my $self;
        $self                  = \%args;
        $self->{headers}       = [];
        $self->{headers_test}  = [];
        $self->{headers_model} = [];
        bless $self, $class;
        return $self;
    }

    sub add_header {
        my $self     = shift;
        my $_line    = shift;
        my %NO_STORE = (
            'accept-encoding' => 1,
            'keep-alive'      => 1,
            'connection'      => 1,
            'host'            => 1,
        );
        my %TEST_STORE = (
            'user-agent' => "%AGENT%",
            'cookie'     => "%COOKIE%",
        );
        ( my $_header, my $_value ) = $_line =~ /(^.+?):\s(.+)/;
        if ( !$_header ) {    ## it is value
            push @{ $self->{DATA} }, $_line;
            return;
        }

        return if $NO_STORE{ lc($_header) };
        $_value =~ s/^ +//;
        if ( $TEST_STORE{ lc($_header) } ) {
            push @{ $self->{headers_test} }, $_header . "#" . $_value;
            push @{ $self->{headers_model} },
              $_header . "#" . $TEST_STORE{ lc($_header) };
        }
        else {
            push @{ $self->{headers} }, $_header . "#" . $_value;
        }
    }

    1;

}
1;

__END__