#    This source code file is part of the "mod_survey" package.
#
#    Copyright (C) 2004  Joel Palmius
#
#    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; either version 2 of the License, or
#    (at your option) any later version.
#
#    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.
#
#    You should have received a copy of the GNU General Public License
#    along with this program (probably in a file named "LICENSE.txt" or the like);
#    if not, write to:
#
#    Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#!/usr/bin/perl

package Survey::Upload;
use strict;

use CGI;

sub new
{
    my ($self) = {};
    bless($self);

    $self->parseMultipart();

    my ($repository) = $ENV{_SURVEY_SYSBASE};
    if (!$repository =~ m/\/$/)
    {
        $repository .= "/";
    }

    $repository .= "upload/";
    if (!-e $repository)
    {
        mkdir($repository);
    }

    my ($query)    = new CGI;
    my ($filename) = $query->param('filename');
    my ($fh)       = $query->upload('filename');

    if (index($filename, "/") > -1)
    {
        my (@parts) = split(/\//, $filename);
        $filename = pop(@parts);
    }

    $self->{FILENAME} = $repository . $filename;

    print "<!-- " . $self->{FILENAME} . " -->\n";
    my ($buffer);

    open(OUTFILE, ">" . $self->{FILENAME});
    while ($buffer = <$fh>)
    {
        print OUTFILE $buffer;
    }

    close(OUTFILE);

    return $self;
}

sub parseMultipart
{
    my ($self) = shift;

    my ($qs) = $ENV{"QUERY_STRING"};
    my ($ct) = $ENV{"CONTENT_TYPE"};

    print "<!-- $ct -->\n";

    my ($crap, $boundary) = split(/boundary=/, $ct, 2);

    my ($boundary1) = $boundary . "--";

    print "<!-- $boundary -->\n";

    #$boundary .= "--";

    print "<!-- " . index($qs, $boundary) . " -->\n";

    my (@chunks) = split(/$boundary1/, $qs);

    my ($c);

    foreach $c (@chunks)
    {
        print "<!--\n\n$c\n\n-->\n";
    }

}
1;