#    This source code file is part of the "mod_survey" package.
#
#    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::Session;
use strict;

use Survey::SessionArg;
use Survey::Language;

use CGI qw/:standard/;
use CGI::Cookie;

sub new
{
    my ($crap, $r) = @_;
    my $self = {};

    $self->{SARGUMENT} = Survey::SessionArg->new();

    $self->{ERROR}     = 0;
    $self->{ERRORCODE} = 0;

    if ($ENV{"_SURVEY_SENSIBLE"} eq "0")
    {
        $self->{REPOSITORY} = $ENV{"_SURVEY_SYSBASE"} . "session\\";
    }
    else
    {
        $self->{REPOSITORY} = $ENV{"_SURVEY_SYSBASE"} . "session/";
    }

    $self->{VALUES}       = {};
    $self->{CREATIONTIME} = localtime();

    bless($self);

    if (!$r)
    {

        # Assume created outside mod_perl, ie from console prompt
        return $self;
    }

    if (!-e $self->{REPOSITORY})
    {
        system "mkdir " . $self->{REPOSITORY};    # May need windows compat fix
    }

    if (!-r $self->{REPOSITORY})
    {
        $self->{ERROR}     = lprint("Session repository does not exist, and was not possible to create");
        $self->{ERRORCODE} = 1;
    }

    my ($needToCreateNewSession) = 1;

    # See if user already got a session id
    my (%cookies) = parse CGI::Cookie($ENV{HTTP_COOKIE});

    my ($csid) = undef;
    if (defined($cookies{"session-id"}))
    {
        $csid = $cookies{"session-id"}->value;
    }

    # Contingency: If not set in cookie, try argument string
    my ($qsid) = $self->{SARGUMENT}->ArgByName("session-id");

    # Prefer cookie over argument string
    my ($sid) = $csid || $qsid;

    if ($sid)
    {
        $self->{SESSION_ID} = $sid;
        my ($filename) = $self->{REPOSITORY} . $self->{SESSION_ID};
        if (-e $filename)
        {
            $needToCreateNewSession = 0;
            $self->readFromDisk();
        }
    }

    # Create the session-id attribute if needed
    if ($needToCreateNewSession)
    {
        $self->{SESSION_ID} = $self->getAKey();
    }

    # We want to update the cookie no matter what
    my ($sessionCookie) = new CGI::Cookie(-name    => 'session-id',
                                          -value   => $self->{SESSION_ID},
                                          -expires => '+60m',                # setting the expire time to 10 minutes
    );

    $r->headers_out->{'Set-Cookie'} = $sessionCookie;

    #  print "Set-Cookie: $sessionCookie\n";

    $self->setValue("SESSION_ID",   $self->{SESSION_ID});
    $self->setValue("CREATIONTIME", $self->{CREATIONTIME});
    $self->setValue("CREATEDNOW",   $needToCreateNewSession);

    return ($self);
}

# Set a value in the session hash
sub setValue()
{
    my ($self, $name, $value) = @_;
    $self->{VALUES}->{$name} = $value;
}

# Get a value from the session hash
sub getValue()
{
    my ($self, $key) = @_;
    return $self->{VALUES}->{$key};
}

# insert a new array variable. Expected input for
# $value is an array *reference*, ie \@arr
sub setArrayValue()
{
    my ($self, $name, $value) = @_;

    $self->{ARRAYS}->{$name} = $value;
}

# retrieve array variable. Returns an array reference
sub getArrayValue()
{
    my ($self, $name) = @_;
    return $self->{ARRAYS}->{$name};
}

# insert a new hash varible.
sub setHashValue()
{
    my ($self, $name, $value) = @_;
    $self->{HASHES}->{$name} = $value;
}

# retrieve a hash variable.
sub getHashValue()
{
    my ($self, $name) = @_;
    return $self->{HASHES}->{$name};
}

# Populate session hash
sub readFromDisk()
{
    my ($self) = shift;

    my ($sessionFileName) = $self->{REPOSITORY} . $self->{SESSION_ID};
    if (open(SESFILE, $sessionFileName))
    {
        my ($file, $pair, $key, $value);

        # This is needed if a value contains \n
        my (@allfile) = <SESFILE>;
        $file = join("", @allfile);

        my (@pairs) = split("\x00", $file);
        foreach $pair (@pairs)
        {
            if ($pair)
            {
                ($key, $value) = split("\x01", $pair, 2);
                if ($key)
                {

                    # print "$key $value\n";
                    $self->{VALUES}->{$key} = $value;
                }
            }
        }

        close(SESFILE);
    }
    else
    {
        $self->{ERROR}     = lprint("Could not open session file for reading");
        $self->{ERRORCODE} = 2;
    }

    # Do it all again, but this time try opening the array/blob file
    # Currently it only understands arrays and hashes, but I'm preparing
    # this for expansion so it can understand, for example, large data
    # objects.
    $sessionFileName .= ".blob";
    if (open(SESFILE, $sessionFileName))
    {
        my ($file, $blob, $type, $name, $data);

        # This is needed if a value contains \n
        my (@allfile) = <SESFILE>;
        $file = join("", @allfile);

        my (@blobs) = split("\x00", $file);
        foreach $blob (@blobs)
        {
            if ($blob)
            {

                # Format of file (top-level) is
                #
                #   record \x00 record \x00 record ...
                #
                # Format of record is:
                #
                #   type \x01 name \x01 data
                #
                # type can be
                #
                #   A = array
                #   H = hash

                ($type, $name, $data) = split("\x01", $blob, 3);

                if ($type eq "A")
                {

                    # Data contains an array of values. Values are
                    # delimited with \x02
                    @{ $self->{ARRAYS}->{$name} } = split("\x02", $data);
                }

                if ($type eq "H")
                {

                    # Data contains an array of key/value pairs, in
                    # the form
                    #
                    #   key \x03 value \x02 key \x03 value ...
                    my (@pairs) = split("\x02", $data);
                    my ($key, $value, $pair);

                    # new anonymous hash
                    $self->{HASHES}->{$name} = {};

                    foreach $pair (@pairs)
                    {
                        ($key, $value) = split("\x03", $pair, 2);
                        $self->{HASHES}->{$name}->{$key} = $value;
                    }
                }
            }
        }

        close(SESFILE);
    }
    else
    {

        # no error. Blob file won't exist unless there are blobs.
    }

}

# Flush session hash to disk
sub writeToDisk()
{
    my ($self) = shift;
    my ($key);

    # (open session file for writing)
    my ($sessionFileName) = $self->{REPOSITORY} . $self->{SESSION_ID};
    if (open(SESFILE, ">$sessionFileName"))
    {
        my ($numwritten) = 0;
        foreach $key (keys(%{ $self->{VALUES} }))
        {

            # add $key and $self->{VALUES}->{$key} to the file we're writing
            # Format is key \x01 value \x00 to avoid conflicts with important
            # character values
            print SESFILE $key . "\x01" . $self->{VALUES}->{$key} . "\x00";
            $numwritten++;
        }
        close(SESFILE);

        # If session was empty it must have been cleared, and thus we can
        # remove it. This is necessary in order to not overload session
        # directory.
        if (!$numwritten)
        {
            unlink $sessionFileName;
        }
    }
    else
    {
        $self->{ERROR}     = lprint("Could not open session for writing");
        $self->{ERRORCODE} = 2;
    }

    if ($self->{ARRAYS} || $self->{HASHES})
    {

        # someone has set array/hash in session, we need to write it
        # to separate file. Name it session + ".blob".
        $sessionFileName .= ".blob";

        if (open(SESFILE, ">$sessionFileName"))
        {
            my ($numwritten) = 0;

            # Avoid null values by setting up empty hash/array if needed
            if (!$self->{ARRAYS}) { @{ $self->{ARRAYS} } = (); }
            if (!$self->{HASHES}) { $self->{HASHES} = {}; }

            # iterate through arrays, won't happen if empty
            foreach $key (keys(%{ $self->{ARRAYS} }))
            {

                # We have an array to write
                my (@arr) = @{ $self->{ARRAYS}->{$key} };

                # Type is array, and name is $key
                print SESFILE "A\x01$key\x01";

                my ($cell);
                my ($isfirst) = 1;

                # iterate through array and print values
                foreach $cell (@arr)
                {
                    if (!$isfirst)
                    {
                        print SESFILE "\x02";
                    }
                    else
                    {
                        $isfirst = 0;
                    }
                    print SESFILE $cell;
                }

                # end of record
                print SESFILE "\x00";

                $numwritten++;
            }

            # iterate through hashes, won't happen if empty
            foreach $key (keys(%{ $self->{HASHES} }))
            {

                # We have a hash to write
                my ($hsh) = $self->{HASHES}->{$key};

                # Type is hash, and name is $key
                print SESFILE "H\x01$key\x01";

                my ($name);
                my ($isfirst) = 1;

                # iterate through hash keys and print name/values
                foreach $name (keys(%{$hsh}))
                {
                    if (!$isfirst)
                    {
                        print SESFILE "\x02";
                    }
                    else
                    {
                        $isfirst = 0;
                    }

                    my ($value) = $self->{HASHES}->{$key}->{$name};

                    print SESFILE "$name\x03$value";
                }

                # end of record
                print SESFILE "\x00";

                $numwritten++;
            }

            close(SESFILE);

            # If session was empty it must have been cleared, and thus we can
            # remove it. This is necessary in order to not overload session
            # directory.
            if (!$numwritten)
            {
                unlink $sessionFileName;
            }
        }
        else
        {
            $self->{ERROR}     = lprint("Could not open blob session for writing");
            $self->{ERRORCODE} = 2;
        }
    }
}

sub clear()
{
    my ($self) = shift;
    $self->{VALUES} = {};
    1;
}

sub getAKey ()
{
    my ($self) = shift;

    my ($remote)    = $ENV{REMOTE_ADDR};
    my (@timecodes) = localtime(time);

    for (my ($i) = 0 ; $i < @timecodes ; $i++)
    {
        if ($timecodes[$i] < 10)
        {
            $timecodes[$i] = "0" . $timecodes[$i];
        }
    }

    $timecodes[4]++;

    my ($key) = 1900 + $timecodes[5];
    $key = $key . $timecodes[4];
    $key = $key . $timecodes[3] . "_";
    $key = $key . $timecodes[2];
    $key = $key . $timecodes[1];
    $key = $key . $timecodes[0];
    $key = $key . "_" . $$;
    $key .= $remote;

    return $key;
}

sub Error()
{
    my ($self) = shift;
    return $self->{ERROR};
}

sub PrintErrorDescription
{
    my $self    = shift;
    my ($e)     = $self->{ERRORCODE};
    my ($found) = 0;

    print "    <br /><br />\n    ";

    unless ($e)
    {
        print "<i>[" . lprint("SYSTEM ERROR 0, NO ERROR") . "]</i> ";
        print lprint(
                "No error has occured, but the programmer has for some reason called PrintErrorDescription() anyway. ");
        print lprint("I guess the programmer has again made a mistake, something that is a very common event indeed.");
    }

    if ($e eq 1)
    {
        print "<b><i>[" . lprint("SYSTEM ERROR 1, NO SESSION") . "]</i></b> ";
        print lprint("The directory where the sessions are stores was not found and could not be created.") . "<br/>\n";
        print lprint("Please ask the server administrator to fix this.") . "<br/>";
        print lprint("The session directory is set to: ") . $self->{REPOSITORY};
        $found = 1;
    }

    if ($e eq 2)
    {
        print "<b><i>[" . lprint("SYSTEM ERROR 2, COULD NOT OPEN SESSION FILE") . "]</i></b> ";
        print lprint("The session directory is set to: ") . $self->{REPOSITORY};
        $found = 1;
    }

    if (!$found)
    {
        print lprint("This error is not in the knowledge base, so I guess the programmer has made a mistake.");
    }
    print "\n    <br /><br />\n";

    1;
}

1;

1;