# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Session::File
#   Author  : Alex Krohn
#   CVS Info :                          
#   $Id: File.pm,v 1.14 2004/01/13 01:35:20 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   A module for implementing session management.
#
# Todo:
#   -   SQL Support.
#

package GT::Session::File;
# ===============================================================
# Pragmas
    use strict;
    use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $error $DIRECTORY $SESSION);

# Internal nodules
    use GT::Base ();
    use GT::MD5 qw/md5_hex/;
    use GT::Dumper;

# Global variable init
    @ISA     = qw/GT::Base/;
    $VERSION = sprintf "%d.%03d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
    $DEBUG   = 0;
    $ATTRIBS = { 
        id          => undef, 
        data        => undef, 
        directory   => undef, 
        save        => 0, 
        subdir      => 0,

        _debug      => $DEBUG
    };
    $ERRORS = {
        'BADDATA'   => "Invalid data in session: '%s'. Reason: '%s'",
        'NOROOT'    => "No root directory was defined!",
        'CANTOPEN'  => "Can't open file: '%s'. Reason: '%s'",
        'CANTDEL'   => "Unable to delete file: '%s'. Reason: '%s'",
        'CLASSFUNC' => "This is a class function only.",
        'INVALIDSESSION' => "Invalid session id: '%s'."
    };
    $DIRECTORY = "./auth";
    $SESSION   = '';

sub new {
# ---------------------------------------------------------------
# Initilizes a session. Expects to find a session id to lookup, some
# data to save, or nothing. If no session is defined, then one will
# be generated. If an invalid session is specified, nothing is returned.
#
    my $this  = shift;
    my $class = ref $this || $this;
    my $self  = bless {}, $class;

# Set defaults.
    foreach (keys %$ATTRIBS) {
        $self->{$_} = $ATTRIBS->{$_};
    }

# Don't save by default.
    $self->{save} = 0;

# We got passed in a single session id.
    if (@_ == 1) {
        $self->load ($_[0]) or return $self->error ('INVALIDSESSION', 'WARN', $_[0]);
        return $self;
    }

# We got passed some options, possibly a session id.
    if (@_ > 1) {
        my $opts  = $self->common_param(@_);
        foreach (keys %$opts) {
            exists $self->{$_} and ($self->{$_} = $opts->{$_});
        }
        if ($self->{directory}) {
            $DIRECTORY = $self->{directory};
        }
    }

# If we have an id, load it or return.
    if ($self->{id}) {
        $self->load ($self->{id}) or return $self->error ('INVALIDSESSION', 'WARN', $self->{id});
    }
    else {
        $self->{id} = generate_session_id();
        $self->{save} = 1;
    }

    return $self;
}

sub DESTROY {
# ---------------------------------------------------------------
# Makes sure we save the session.
#
    $_[0]->save() if ($_[0]->{save});
    $_[0]->debug ("Object destroyed.") if ($_[0]->{_debug} > 1);
}

sub data {
# ---------------------------------------------------------------
# Set/retrieve the data, make sure to set save to 1.
#
    if (@_ > 1) { $_[0]->{data} = $_[1]; $_[0]->{save} = 1; }
    return $_[0]->{data};
}

sub load {
# ---------------------------------------------------------------
# Loads a session id and data.
#
    my ($self, $sid) = @_;
    if (($sid =~ /^[\w\d]+$/) and (length $sid < 40)) {
        my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
        my $file = $root;
        if ($self->{subdir}) {
            $file .= '/' . substr ($sid, 0, 1);
        }
        $file .= '/' . $sid;
        if (-e $file) {
            local ($@, $!, $SESSION);
            $file =~ /(.*)/;
            $file = $1;

            do "$file"; 
            ($@ || $!) and return $self->error ('BADDATA', 'FATAL', $file, "$@" || "$!");
            $self->{data} = $SESSION;
            $self->{id}   = $sid;
            $self->debug ("Session '$sid' loaded ok.") if ($self->{_debug});
            return 1;
        }
        else {
            $self->debug ("Attempted to load invalid session: '$sid'.") if ($self->{_debug});
        }
    }
    else {
        $self->debug ("Attempted to load invalid, or blank session '$sid'.") if ($self->{_debug});
    }
    return;
}

sub save {
# ---------------------------------------------------------------
# Save a session id and data.
#
    my $self = shift;
    my $sid = $self->{id};

    if (($sid =~ /^[\w\d]+$/) and (length $sid < 40)) {
        my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
        my $file = $root;
        if ($self->{subdir}) {
            $file .= '/' . substr ($sid, 0, 1);
            -d $file or mkdir ($file, 0755) or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
        }
        $file .= '/' . $sid;
        my $fh = \do {local *FH; *FH};
        open ($fh, "> $file") or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
        my $dump = GT::Dumper->dump(
            var  => '$SESSION',
            data => $self->{data}
        );
        print $fh $dump;
        close $fh;
        $self->{save} = 0;
        $self->debug ("Session '$sid' saved.") if ($self->{_debug});
    }
    else {
        $self->debug ("Attempted to save invalid session '$sid'") if ($self->{_debug});
    }
}

sub delete {
# ---------------------------------------------------------------
# Delete a session.
#
    my $self = shift;
    my $sid;
    if (! ref $self) {
        $self = bless { _debug => $DEBUG }, $self;
        $sid = shift; 
    }
    else { 
        $sid = $self->{id} 
    }

    if (($sid =~ /^([\w\d]+)$/) and (length $sid < 40)) {
        $sid = $1;
        my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
        my $file = $root;
        if ($self->{subdir}) {
            $file .= '/' . substr ($sid, 0, 1);
        }
        $file .= '/' . $sid;
        unlink $file or return $self->error ('CANTDEL', 'WARN', $file, "$!");
        $self->{id}   = undef;
        $self->{data} = undef;
        $self->{save} = 0;
        $self->debug ("Session '$sid' deleted.") if ($self->{_debug});
    }
}

sub cleanup {
# ---------------------------------------------------------------
# CLASS function to cleanup session directory.
#
    my ($self, $seconds, $directory) = @_;
    (ref $self) or $self = bless { _debug => $DEBUG }, $self;

    if ($seconds == 0) {
        $self->debug ("Cleanup not erasing anything, seconds set to 0.") if ($self->{_debug});
        return;
    }

    defined $seconds   or ($seconds = 3600);
    defined $directory or ($directory = $DIRECTORY);
    $directory or return $self->error ('NOROOT', 'FATAL');

    my $dir = \do {local *FH; *FH};
    opendir ($dir, $directory) or return $self->error ('CANTOPEN', 'FATAL', $directory, "$!");
    my @files = grep { $_ and (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
    closedir ($dir);

    foreach my $file (@files) {
        my $full_file = "$directory/$file";
        my $is_dir    = -d $full_file;

        if ($self->{subdir} and $is_dir) {
            my $dir = \do {local *FH; *FH};
            opendir $dir, $full_file or return $self->error ('CANTOPEN', 'FATAL', $full_file, "$!");
            push @files, map { $file . '/' . $_ } grep { (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
            closedir $dir;
            next;
        }
        elsif ($is_dir) {
            next;
        }

        if (((stat($full_file))[9] + $seconds) <= time()) {
            $self->debug ("Cleanup is removing '$full_file' older then $seconds s. old.") if ($self->{_debug});
            $full_file =~ /(.*)/;
            $full_file = $1;
            unlink $full_file or return $self->error ('CANTDEL', 'FATAL', $full_file, "$!");
        }
    }
}

sub generate_session_id {
# ---------------------------------------------------------------
# Generates a session id.
#
    return md5_hex ( time . $$ . rand (16000) );
}

1;

__END__

=head1 NAME

GT::Session::File - A session management module, with simple data storage/retrieval.

=head1 SYNOPSIS

Create a session:
    my $session = new GT::Session::File;
    my $id = $session->id();

Save data with the session:
    $session->data ("Save this information!");

Load a session.
    my $session = new GT::Session::File ( $id ) or die "Can't load session: '$id'."

Set session directory.
    my $session = new GT::Session::File ( directory => '/path/to/sessions', id => $id );

Delete a session
    $session->delete();

Cleanup old sessions, takes argument of number of seconds old.
    $session->cleanup ( 5000 );

=head1 TODO

* Integrate SQL interface into flatfile interface.