package RSApache::RSApp;

# ----------------------------------------------------------------
# This is the base application class. Here's how to use it:
#
# Create your own request specific module that inherits from this class:
#
#	 package Derived::Class;
#
#	 use lib '/app/tools/common/lib';
#	 use base Common::RSApp;
#
#	 sub execute
#	 {
#        my $class = shift;
#        $self->Stylesheet("template_name.xsl");
#
#        # do some logic
#        #
#        # set some xml
#        #
#
#        return 1;
#	 }
#
# How to use this:
#
#    1. Store all outgoing XML in a data structure in $self->{xml}
#    2. Access query params by GetParam("paramName");
#    3. Control form field data with AddFormFieldValue(name => "email", value => "justin@test.com", error_type => "email_not_found")
#    4. Send status messages to the template with AddMessageXML(type => "success", code => "password_changed");
#    5. Control what to return to the browser by passing a value to one of these:
#           - Redirect()
#           - Stylesheet()
#           - Template()
#           - RawOutput()
#           - FileDownload()
#    6. $self->App and $self->ClientID are always available for the current request.
#    7. You can add select lists to Forms with GetCountrySelectList and others.
#    8. You can set basic navigation access with SetNavigationAccess($user);
# ----------------------------------------------------------------

use strict;
use warnings;
use URI::Escape;
use Date::Calc;

use lib '/app/tools/common/lib';
use Common::Consts;
use Common::WriteXML;

sub new {
    my $class  = shift;
    my %params = @_;

    my $self = {};
    $self->{xml} = {};
    bless $self, $class;

    $self->_init(%params);

    return $self;
}

# the template_dir is set in the apache conf file for
# the current application
sub Stylesheet {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{stylesheet} = ( $new_val =~ m|^/| ) ? $new_val : $self->{template_dir} . '/' . $new_val;
    }
    return $self->{stylesheet};
}

# if you pass a URI (eg. "/app/login") then RedirectURL will convert it for you
sub Redirect {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{redirect} = ( $new_val =~ /^http/ ) ? $new_val : $self->RedirectURL($new_val);
    }
    return $self->{redirect};
}

# if you just want to display a static html page
# "templates" is probably set in the apache conf
# for this application, but I haven't used this yet.
sub Template {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{template} = ( $new_val =~ m|^/| ) ? $new_val : $self->{templates} . '/' . $new_val;
    }
    return $self->{template};
}

# if you want the application to spit out raw XML,
# then use this function.
sub RawOutput {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{raw_output} = $new_val;
    }
    $self->{raw_output};
}

# to force download dialog boxes use ContentType along
# with this function. This takes a file path parameter.
sub FileDownload {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{file_download} = $new_val;
    }
    $self->{file_download};
}

sub FileDownloadName {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{file_download_name} = $new_val;
    }
    $self->{file_download_name};
}

sub ContentType {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{content_type} = $new_val;
    }
    $self->{content_type};
}

sub XMLString {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{xml_string} = $new_val;
    }
    $self->{xml_string};
}

# this gets set in _init()
sub ClientID {
    my $self = shift;
    return $self->{client_id};
}

# this gets set in _init()
sub App {
    my $self = shift;
    return $self->{xml}->{App};
}

sub ErrorCode {
    my $self = shift;
    if (@_) {
        my ($new_val) = @_;
        $self->{error_code} = $new_val;
    }
    $self->{error_code};
}

sub ErrRedirect {
}

# the handler will call this when it's about
# to dump its load to the browser.
sub GetXML {
    my $self = shift;

    return Common::WriteXML::GetXMLString( $self->{xml} );
}

# if you want the current query string minus
# some of the params, put the ones you don't want
# into the %params and voila!
sub GetPartialQueryString {
    my $self = shift;
    my %skip = @_;

    my @params = ();
    foreach my $key ( keys %{ $self->{params} } ) {
        next if ( ref( $self->{params}->{$key} ) eq "ARRAY" );
        if ( !exists $skip{$key} ) {
            push @params, $key . "=" . $self->{params}->{$key};
        }
    }

    return join( '&', @params );
}

# get the value of a specific request parameter
sub GetParam {
    my $self  = shift;
    my $pName = shift;

    my @array_result;
    my $result = $self->{params}->{$pName};
    if ( ref($result) eq "ARRAY" ) {
        @array_result = @$result;
    } else {
        @array_result = ($result);
    }

    return wantarray ? @array_result : $self->{params}->{$pName};
}

# forms the current request as these parts:
# http + s + :// + hostname + request_uri
sub GetRequestString {
    my $self = shift;

    my $url = 'https://' . $ENV{HTTP_HOST} . $ENV{REQUEST_URI};
    return $url;
}

# takes a URI. example: "/app/login";
sub RedirectURL {
    my $self = shift;
    my $uri  = shift;

    my $url = 'https://' . $ENV{HTTP_HOST} . $uri;
    return $url;
}

sub Hostname {
    return $ENV{HTTP_HOST};
}

# small wrapper around setting up xml for a form.
# pass a hash ref with these keys:
#   - name
#   - value
#   - error_type
#
# examples:
# $self->AddFormFieldValue{name => "email", value => "justin@test.com", error_type => "email_not_found"}
# $self->AddFormFieldValue(name => "Label", value => '', error_type => $error_val, select_list => $select_label_xml);
sub AddFormFieldValue {
    my $self = shift;
    my %args = @_;

    my $href;
    if ( $args{select_list} ) {
        $href = { $args{name} => [ { SelectList => [ $args{select_list} ] } ] };
    } else {
        $href = { $args{name} => $args{value} };
    }

    if ( $args{error_type} ) {

        # print STDERR "form error (".$args{name}."): ".$args{error_type}."\n";
        $href->{ErrorType} = $args{error_type};
        $self->{xml}->{Form}->{Errors} = 1;
    }

    # let's see if this form field has already been set.
    # if so, then re-assign it instead of adding a duplicate,
    # but only if it's an error field
    if ( ref( $self->{xml}->{Form}->{Fields}->{Field} ) eq 'ARRAY' ) {
        my $max = scalar @{ $self->{xml}->{Form}->{Fields}->{Field} };
        for ( my $i = 0 ; $i < $max ; $i++ ) {
            my $tmp_href = $self->{xml}->{Form}->{Fields}->{Field}->[$i];
            foreach my $key ( keys %$tmp_href ) {
                if ( $key eq $args{name} ) {
                    if ( exists $tmp_href->{ErrorType} && !exists $href->{ErrorType} ) {

                        # if an error field has already been set
                        # don't allow a duplicate field
                        return 1;
                    } else {

                        # print STDERR "this field ($key) is being reset\n";
                        $self->{xml}->{Form}->{Fields}->{Field}->[$i] = $href;
                        return 1;
                    }
                }
            }
        }
    }

    # if it wasn't alread set, then add it to the field list
    push @{ $self->{xml}->{Form}->{Fields}->{Field} }, $href;
}

# status messages used by the template
# to display fancy messages to the user
sub AddMessageXML {
    my $self = shift;
    my %args = @_;

    return undef if ( !defined $args{type} || !defined $args{code} );

    push @{ $self->{xml}->{Messages}->{Message} }, { Type => $args{type}, Code => $args{code} };
}

# so the template knows which navigation tabs
# the user has access to.
sub SetNavigationAccess {
    my $self = shift;
    my $user = shift;

    foreach my $area (@Common::Consts::NAVIGATION_TABS) {
        $self->{xml}->{Access}->{$area} = $self->AddAccessXML( type => $area, value => $user->CanAccess($area) );
    }

    # access for the current area
    $self->{xml}->{Access}->{ $self->App } = $self->AddAccessXML( type => $self->App, value => $user->CanAccess( $self->App ) );
}

# besides navigation access, there can be access
# to specific tasks on a page, you can set whatever
# you want here, just coordinate it with your template.
sub AddAccessXML {
    my $self = shift;
    my %args = @_;

    my $type  = $args{type};
    my $value = $args{value};

    $self->{xml}->{Access}->{$type} = $value;
}

# Pretty self explanatory. It does a little work to make
# sure "United States" is the first option.
#
# Here's an example:
#
#	my $country_list = $self->GetCountrySelectListXML($selected_country);
#	$self->AddFormFieldValue(name => "Country", value => $selected_country, select_list => $country_list);
#
# the other select lists work the same way
sub GetCountrySelectListXML {
    my $self     = shift;
    my $selected = shift;

    my $list = \%User::Address::COUNTRIES;

    my $us = { Value => "US", Label => "UNITED STATES" };
    if ( $selected eq 'US' ) {
        $us->{Selected} = 1;
    }

    my $xml = {};
    push @{ $xml->{Option} }, $us;

    foreach my $key ( sort { $list->{$a} cmp $list->{$b} } keys %$list ) {
        next if ( $key eq 'US' );

        my $href = {};
        $href->{Value} = $key;
        $href->{Label} = $list->{$key};
        if ( $selected eq $key ) {
            $href->{Selected} = 1;
        }

        push @{ $xml->{Option} }, $href;
    }

    return $xml;
}

sub GetStateSelectListXML {
    my $self     = shift;
    my $selected = shift;

    my $list = \%User::Address::US_STATES;

    return $self->GetSelectListXML( list => $list, selected => $selected, sort_by => 'value' );
}

# the level limit is used so that access levels higher
# than the one passed in will not be displayed.
sub GetAccessSelectListXML {
    my $self        = shift;
    my %args        = @_;
    my $selected    = $args{selected};
    my $level_limit = $args{limit};

    # this means it's a "blank" user form
    if ( ( !$level_limit || $level_limit == 1 ) && $selected != User::User::ACCESS_RSADMIN() ) {
        $level_limit = 2;
    }

    my $list = {};
    if ($level_limit) {
        foreach my $level ( keys %Common::Consts::PERMISSION_LABELS ) {
            if ( $level >= $level_limit ) {
                $list->{$level} = $Common::Consts::PERMISSION_LABELS{$level};
            }
        }
    } else {
        $list = \%Common::Consts::PERMISSION_LABELS;
    }

    return $self->GetSelectListXML( list => $list, selected => $selected );
}

# use sort_by to sort by the values or the keys
#
# access_levels are sorted by key
# states are sorted by value
#
sub GetSelectListXML {
    my $self     = shift;
    my %args     = @_;
    my $list     = $args{list} || return undef;
    my $selected = $args{selected};
    my $sortby   = $args{sort_by} || 'key';

    my @keys;
    if ( $sortby eq 'key' ) {
        @keys = sort keys %$list;
    } else {
        @keys = sort { $list->{$a} cmp $list->{$b} } keys %$list;
    }

    my $xml = {};
    foreach my $key (@keys) {
        my $href = {};
        $href->{Value} = $key;
        $href->{Label} = $list->{$key};
        if ( $selected eq $key ) {
            $href->{Selected} = 1;
        }

        push @{ $xml->{Option} }, $href;
    }

    return $xml;
}

#####################################################################
# Private methods...nothing to see here, move along.
#####################################################################
sub _init {
    my $self   = shift;
    my %params = @_;

    # --------------------------------------------------------
    # get app configuration variables
    # --------------------------------------------------------
    my $r = Apache->request();
    $self->{template_dir} = $r->dir_config("template_dir");
    $self->{client_id}    = $ENV{CLIENT_ID} || 0;
    $self->{xml}->{App}   = $r->dir_config("app");

    # --------------------------------------------------------
    # handle the CGI params
    # --------------------------------------------------------
    my $cgi = $params{cgi};

    if ($cgi) {
        $self->{cgi} = $cgi;
        my @xml_params = ();
        foreach my $param ( $cgi->param() ) {
            my @param_vals = $cgi->param($param);
            $self->{params}->{$param} = ( @param_vals > 1 ) ? \@param_vals : $param_vals[0];

            #$self->{params}->{$param} = $cgi->param($param);
        }

        # copy these to the xml
        $self->{xml}->{Params} = $self->{params};
    }
}

###
1;    # Play nicely.
###