# File Object Utility
package xCGI::File;

use strict;
use warnings;

use overload '""' => sub{
    my $self = shift;
    $self->{iohandle}->seek(0,0);
    read( $self->{iohandle}, my $bin, $self->{content_length});
    return $bin;
};

sub new{
    my $class = shift;
    my $ref   = shift;
    bless $ref, $class;
}

# getter
sub AUTOLOAD{
    my $self = shift;
    return do{
        our $AUTOLOAD =~ /(\w+)$/;
        $self->{$1} || '';
    };
}

sub DESTROY{}
###########################################################################
package xCGI; # ersetzt das bisherige Perl-modul CGI.pm ###################

use strict;
use warnings;
use bytes;
require '/var/www/vhosts/rolfrost.de/files/fwlib/factory/dd.pm'; # Diagnostics

binmode STDIN;

sub new{
    my $class = shift;
    my $self = bless{ 
        CONTENT_LENGTH => $ENV{CONTENT_LENGTH} ? $ENV{CONTENT_LENGTH} : 0,
        CONTENT_TYPE   => $ENV{CONTENT_TYPE} ? $ENV{CONTENT_TYPE} : 'application/x-www-form-urlencoded', 
        QUERY_STRING   => $ENV{QUERY_STRING} ? $ENV{QUERY_STRING} : '',
        STDIN          => *STDIN,
        rawdata        => '',
        eav            => {},
        param          => {},
        json           => {}
    }, $class;
    
    $self->{CONTENT_TYPE_ORIGIN} = $self->{CONTENT_TYPE};
    # XHR hängt charset=UTF-8 an Content-Type
    $self->{CONTENT_TYPE} = [split(";" ,$self->{CONTENT_TYPE})]->[0];
    
    return $self;
}

# Public, lese Rohdaten aus dem
# Common Gateway STDIN 
sub rawdata{
    my $self  = shift;
    return unless $ENV{CONTENT_LENGTH};
    read(STDIN, my $rawdata, $ENV{CONTENT_LENGTH});
    return $rawdata;
}

# Public, Haupt Methode zur Herausgabe
# HTTP-Request-Parameter
sub param{
    my $self  = shift;
    my $pname = shift;
    
    return '' if $self->{CONTENT_TYPE} eq 'application/octet-stream';    

    if(! keys %{$self->{param}} ){ $self->_parse_rawdata  }

    # return options
    if( $pname ){
        if( ref $self->{param}{$pname} eq 'ARRAY' && scalar @{$self->{param}{$pname}} == 1){
            return $self->{param}{$pname}[0];
        }
        elsif(ref $self->{param}{$pname} eq 'ARRAY' && scalar @{$self->{param}{$pname}} > 1){
            return @{$self->{param}{$pname}}; 
        }
        elsif(ref $self->{param}{$pname} eq 'ARRAY' && scalar @{$self->{param}{$pname}} == 0){ return '' }
        else{
            return $self->{param}{$pname} ? $self->{param}{$pname} : (); 
        }
    }
    else{ 
        return keys %{$self->{param}} ? keys %{$self->{param}} : $ENV{QUERY_STRING} ? 1 : ''; 
    }
}

# hier werden die jeweiligen Layer geladen
sub _parse_rawdata{
    my $self = shift;
    # Verschiedene Content-Types im Request
    # erweiterbare Kontrollstruktur
    if( $self->{CONTENT_TYPE} eq 'multipart/form-data' ){
        require ParseMultipart;
        $self->{param} = ParseMultipart->parse_multipart( *STDIN );
    }
    elsif( $self->{CONTENT_TYPE} eq 'application/json' ){
        require JSON;
        $self->{json} = JSON->new->decode($self->rawdata);
        $self->{param} = $self->{json}{param};
    }
    elsif( $self->{CONTENT_TYPE} eq 'application/body+query' ){
        # QUERY_STRING mit Parametern + Message Body mit Binary
        $self->{param} = $self->qparse($self->{QUERY_STRING});
        $self->{STDIN} = *STDIN;
    }
    else{
        # Default Enctype
        # Parameter: Name => [Value], application/x-www-form-urlencoded
        $self->{param} = $ENV{CONTENT_LENGTH} ? do{
            read(STDIN, my $buffer, $ENV{CONTENT_LENGTH});
            $self->qparse($buffer);
        } : $self->qparse($ENV{QUERY_STRING});

        # proprietäre Erweiterung für diesen Enctype
        # Feldnamen sind strukturiert so dass ein EAV
        # auf den namen abgebildet ist
        # z.B. person.firstname=, person.lastname=

        return unless $self->{tryeav};
        foreach my $parametername( keys %{$self->{param}} ){
            $self->_stacker([split /\./, $parametername], $self->{param}{$parametername});
        }
    }
}

# Referenzen aufstocken
sub _stacker{
    my $self = shift;
    my $aref = shift;
    my $val = shift;
    
    my $hash = $self->{eav};
    my $last = pop @$aref;
    foreach my $el(@$aref){
        $hash = $hash->{$el} ||= {};
    }
    $hash->{$last} = $val;
}

# Versuche eine EAV Struktur in den Parameternamen zu erkennen
sub tryeav{
    my $self = shift;
    $self->{tryeav} = 1;
}

# Public und unabhängig verwendbar
# application/x-www-form-urlencoded
sub qparse{
    my $self    = shift;
    my $rawdata = shift || '';
    my $setparam = shift || 0;
    my %param = ();
    # Punkte in Parameternamen erlauben
    my @pie = split /[;&]/, $rawdata;
    foreach my $p(@pie){
        my ($pname, $val) = split(/=/, $p, 2);
        next unless $pname;
        next unless defined $val;
        $val =~ s/\+/ /g;
        $val =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
        push @{$param{$pname}}, $val;
    }
    # overload attribute param
    if($setparam){
        %{$self->{param}} = (%{$self->{param}}, %param);
    }
    return \%param;
}

# Getter via AUTOLOAD
# Methodname => Attribute
sub AUTOLOAD{
    my $self = shift;
    my $name = do{
        our $AUTOLOAD =~ /(\w+)$/;
        $1;
    };
    return $self->{$name};
}
sub DESTROY{}
1;#########################################################################

__END__
application/x-www-form-urlencoded # handelsübliche Parameter, Default
multipart/form-data               # FileUpload
multipart/c-eav                   # cEAV.js und cEAV.pm
multipart/eav                     # Binär EAV, EAV.js und EAVHandle.pm
application/octet-stream          # Bytesequenzen
application/json
application/xml

Wenn multipart/eav oder multipart/c-eav gibt es die entity 'param'
und damit Parameter als Hash (Schlüssel => Wert)


$query_string =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;