package Labyrinth::Request;

use warnings;
use strict;

use vars qw($VERSION $AUTOLOAD);
$VERSION = '5.01';

=head1 NAME

Labyrinth::Request - Determines the actions and content required of a request.

=head1 SYNOPSIS

  use Labyrinth::Request;

  # database object creation
  my ($content,@actions) = Request($realm);

=head1 DESCRIPTION

The Request package, given a request string (or defaults), will retrieve
the appropriate actions and template file for that request.

=cut

# -------------------------------------
# Library Modules

use Config::IniFiles;

use Labyrinth::Audit;
use Labyrinth::Globals  qw(:default);
use Labyrinth::Variables;
use Labyrinth::Writer;

# -------------------------------------
# Variables

my @configkeys = qw(layout actions content onsuccess onfailure onerror secure rewrite);
my %resetkeys = (onsuccess => 1, onfailure => 1, onerror => 1);
my %stored;

# -------------------------------------
# The Subs

=head1 FUNCTIONS

=head2 Constructor

=over 4

=item new()

=back

=cut

sub new {
    my $self    = shift;
    my $realm   = shift;
    my $request = shift || 'home-'.$realm;

    ## split the reset request into it's component parts
    my ($section,$command) = split("-",$request);
    $tvars{request} = $request;
    $tvars{section} = $section;
    $tvars{command} = $command;

    # sort the realm out
    my ($layout,$actions,$content,$onsuccess,$onfailure,$onerror)
        = $self->_read_config('realm',$realm,@configkeys);

    $onsuccess = $request;
    my @actions = split(",",$actions)   if($actions);

    # create an attributes hash
    my $atts = {
        'actions'   => \@actions,
        'layout'    => $layout,
        'content'   => $content,
        'onsuccess' => $onsuccess,
        'onfailure' => $onfailure,
        'onerror'   => $onerror,
    };

    LogDebug("--new:actions=[@actions]");
#   LogDebug("--new:layout=[$layout]");
#   LogDebug("--new:content=[$content]");

    # create the object
    bless $atts, $self;
    return $atts;
}

=head2 Methods

=head3 Handling Actions

=over 4

=item next_action()

=item add_actions(@actions)

=back

=cut

sub next_action { my $self = shift; shift @{$self->{actions}} }
sub add_actions { my $self = shift; push  @{$self->{actions}}, @_ }

=head3 Handling Command Resets

=over 4

=item reset_realm($realm)

=item reset_request($request)

=item redirect

=back

=cut

sub reset_realm {
    my $self    = shift;
    my $realm   = shift;
    my %hash;

    @hash{@configkeys} = $self->_read_config('realm',$realm,@configkeys);

    $self->{section} = 'realm';
    $self->{command} = $realm;  # needed to check onsuccess, etc.

    for(@configkeys) {
        next    unless($hash{$_});
        if($_ eq 'actions') {
            my @actions = split(",",$hash{$_});
            $self->add_actions(@actions);
LogDebug("--reset_realm:actions=@actions");
        } else {
            $self->{$_} = $hash{$_};
#LogDebug("--reset_realm:$_=$self->{$_}");
        }
    }
}

sub reset_request {
    my $self = shift;
    my $request = shift;
    my %hash;

    ## split the reset request into it's component parts
    my ($section,$command) = split("-",$request);
    $tvars{request} = $request;
    $tvars{section} = $section;
    $tvars{command} = $command;
    return  unless($section && $command);

    # remove any remaining actiona
    while($self->next_action){};

    @hash{@configkeys} = $self->_read_config($section,$command,@configkeys);

    #if($settings{$protocol} eq 'https' && !$hash{secure} || $hash{secure} !~ /^(on|either|both)$/) {
    #    # redirect to HTTP string
    #    $self->redirect('http',$hash{rewrite},$request);
    #    return;
    #} elsif($settings{$protocol} eq 'http' && $hash{secure} && $hash{secure} =~ /^(on|either|both)$/) {
    #    # redirect to HTTPS string
    #    $self->redirect('https',$hash{rewrite});
    #    return;
    #}

    for(@configkeys) {
        next    unless($hash{$_} || $resetkeys{$_});
        if($_ eq 'actions') {
            my @actions = split(",",$hash{$_});
            $self->add_actions(@actions);
LogDebug("--reset_request:actions=@actions");
        } else {
            $self->{$_} = $hash{$_};
LogDebug("--reset_request:$_=" . (defined $self->{$_} ? $self->{$_} : ''));
        }
    }
}

sub redirect {
    my ($self,$protocol,$rewrite,$request) = @_;

    return $tvars{redirect}    if(!$protocol);

    # set to existing query string, with new protocol
    $tvars{redirect} = "$protocol://$ENV{HTTP_HOST}";

    if(defined $rewrite) {
        $tvars{redirect} .= $rewrite;
    } else {
        $tvars{redirect} .= $ENV{REQUEST_URI}  if($ENV{REQUEST_URI});

        # rewrite query string
        if(defined $request) {
            $tvars{redirect} =~ s/\?.*//;
            $tvars{redirect} .= "?act=$request" if($request);
        }
    }
}

# private method to read config data

sub _read_config {
    my ($self,$section,$command,@keys) = @_;
    my @values;

    if($settings{requests} eq 'dbi') {
        my @rows = $dbi->GetQuery('hash','GetRequest',$section,$command);
        if(@rows) {
            push @values, map {$rows[0]->{$_}} @keys;
        } else {
            push @values, map {''} @keys;
        }
    } else {
        my $file = "$settings{requests}/$section.ini";
        Croak("Cannot read configuration file [$file]\n")   unless(-r $file);
        my $cfg = Config::IniFiles->new( -file => $file );
        Croak("Cannot access configuration file [$file]\n") unless($cfg);

        for my $key (@keys) {
            my $value  = $cfg->val( $command, $key );
    #LogDebug("--_read_config:[$command-$key]=[$value], file=[$file]");
            push @values, ($value ? $value : undef);
        }
    }
    return @values;
}

=head2 Accessor Methods

=over 4

=item layout

Layout template to be used

=item content

Content template to be used

=item onsuccess

Command to execute if this command succeeds.

=item onfailure

Command to execute if this command fails.

=item onerror

Command to execute if this command fails with an unrecoverable error.

=back

=cut

my @autosubs = qw(
    layout
    content
    onsuccess
    onfailure
    onerror
);
my %autosubs = map {$_ => 1} @autosubs;

sub AUTOLOAD {
    no strict 'refs';
    my $name = $AUTOLOAD;
    $name =~ s/^.*:://;
    die "Unknown sub $AUTOLOAD\n"   unless($autosubs{$name});

    *$name = sub {
        my $self = shift;
        my $value = $self->{$name};
        if($name =~ /^on/) { $self->{$name} = undef }   # once seen, forget it
        return $value;
    };
    goto &$name;
}

sub DESTROY {}

1;

__END__

=head1 SEE ALSO

  Config::IniFiles
  Labyrinth

=head1 AUTHOR

Barbie, <barbie@missbarbell.co.uk> for
Miss Barbell Productions, L<http://www.missbarbell.co.uk/>

=head1 COPYRIGHT & LICENSE

  Copyright (C) 2002-2011 Barbie for Miss Barbell Productions
  All Rights Reserved.

  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.

=cut
