package ParseMultipart;

# Sequentieller Parser f. Enctype="multipart/form-data"

use strict;
use warnings;
use IO::String;
use bytes;

# Pub. KlassenMethode incl. Konstruktor
sub parse_multipart{
    my $class    = shift;
    my $handle   = shift || *STDIN;
    binmode $handle;

    # Lese den Boundary String direkt aus dem Handle
    my $boundary = <$handle>;

    # hier wird die Instanz erstellt
    my $self = bless{
        stdin    => IO::String->new(),
        param    => {},
        boundary => $boundary
    }, $class;
    
    return eval{
        $self->_readin($handle);
        $self->_parse_multipart();    
        $self->{param};
    }
}

# Private Method, MainLoop
sub _parse_multipart{
    my $self = shift;
    my $stdin = $self->{stdin};
    $stdin->seek(0,0);

    # fifo zum Ermitteln der Leerzeile
    my @fifo = ('','','','');
    my $header = '';
    # main-loop, gehe in Schritten von 1 byte
    while( read($stdin, my $byte, 1) ){
        shift @fifo;
        push @fifo, $byte;
        $header .= $byte;
        if( join('', @fifo) eq "\r\n\r\n" ){
            # hier sind wir auf der ersten Leerzeile
            $self->_parse_part($header);
            $header = '';
            @fifo = ('','','','');
            next;
        }
    }
}

# Parse eine einzelne Komponente
sub _parse_part{
    my $self = shift;
    my $head = shift;
    
    my $in   = $self->{stdin};
    my $boundary = $self->{boundary};
    
    # nun lese die binary
    my $tmp = IO::String->new;
    # boundary detection
    my @fifo = split('', $boundary);
    while( read($in, my $byte, 1)  ){
        shift @fifo;
        push @fifo, $byte;
        $tmp->print($byte);
        last if join('', @fifo) eq $boundary;
    }

    my $content = '';
    $tmp->truncate( $tmp->tell() - length($boundary) - 2 );
    $tmp->seek(0,0);
    while(read($tmp, my $buffer, 1024)){
        $content .= $buffer;
    }    

    $tmp->seek(0,0);

    # parse header Angaben 
    my $content_type = do{
        $head =~ /Content-Type: ?(.*)/s;
        $1 ? unpack "A*", pack "A*", $1 : '';
    };
    my $name = do{
        $head =~ /name="(.*?)"/s;
        $1 ? $1 : '';
    };
    my $filename = do{
        $head =~ /filename="(.*?)"/s;
        $1 ? $1 : '';
    };

    push @{$self->{param}{$name}}, $filename ? {
        name           => $name,
        content_type   => $content_type,
        filename       => $filename,
        iohandle       => $tmp,
        content_length => length($content),
    } : $content;
}



# Lege eine Kopie der Daten aus dem übergebenen Handle an
# kopiere in das eigene Handle
sub _readin{
    my $self = shift;
    my $handle = shift;
    while( read($handle, my $buffer, 1024) ){ $self->{stdin}->print($buffer) }
}


1;#########################################################################
__END__


SYNOPSIS
==========

require ParseMultipart;
my $param = ParseMultipart->parse_multipart(*STDIN) or die $@;


Beispiel:
=========
<form method="POST" Enctype="multipart/form-data">
    <input type="file" name="file" multiple>
    <input type="submit" name="load" value="Dateien Hochladen">
    <input type="hidden" name='key' value='aged45jhiz8dn62'>
</form>

Das liefert untenstehende Datenstruktur:
========================================
Hochgeladen wurden 2 Dateien

 $VAR1 = {
          'file' => [
                      {
                        'content_length' => 27226,
                        'content_type' => 'image/png',
                        'filename' => 'tabbar-solid-bg@2x.png',
                        'iohandle' => bless( \*Symbol::GEN1, 'IO::String' ),
                        'name' => 'file'
                      },
                      {
                        'content_length' => 7168,
                        'content_type' => 'application/octet-stream',
                        'filename' => 'Thumbs.db',
                        'iohandle' => bless( \*Symbol::GEN2, 'IO::String' ),
                        'name' => 'file'
                      }
                    ],
          'load' => [
                      'Dateien Hochladen'
                    ],
          'key' => [
                     'aged45jhiz8dn62'
                   ]
        };
        

Wichtig für Win32 !!!!
=======================
binmode STDIN;