Lemonldap::Portal::Script - Perl extension for Lemonldap websso framework

  use Lemonldap::Portal::Script
  $exchange = Lemonldap::Portal::Script::Exchange->new( numero => $cp, requete => $line );
  $question = Lemonldap::Portal::Script::Question->new();
  $response = Lemonldap::Portal::Script::Response->new();

 $line means a line of dialog file recording.

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; version 2 dated June, 1991.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  A copy of the GNU General Public License is available in the source tree;
  if not, write to the Free Software Foundation, Inc.,
  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

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__
# Below is stub documentation for your module. You'd better edit it!

The complet_parsing_example.pl extends the previous example , with the generation of perl program able to connect at web site. You can use LWP and Template modules for this.

This example generates 3 things :

With Question / Response


$question = Lemonldap::Portal::Script::Question->new();
$response = Lemonldap::Portal::Script::Response->new();

        $self->{headers}       = [];
        $self->{headers_test}  = []; # force header to get a value 
        $self->{headers_model} = []; # use partern 

   add_header { # this method  add  headers  exept if their are present in NO_STORE hash.
                # Headers in TEST_STORE are replaced by the patern after subtitution 
        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%",
        );

=cut