# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: Login.pm 3043 2008-03-31 14:00:38Z josh $

package BigMed::App::Web::Login;
use Carp;
$Carp::Verbose = 1;
use strict;
use utf8;
use base qw(BigMed::App::Web);
use CGI::Application::Plugin::Session;
use BigMed::User;
use BigMed::Site;
use BigMed::DiskUtil qw(bm_file_path bm_confirm_dir);

my $Current_User;
my $Current_Site;
my $Session_Dir;
my $Default_Script  = 'bm-editor.cgi';    #logs into this page by default
my $Default_Runmode = 'menu';

sub setup {
    my $app = shift;
    $app->start_mode('login');
    $app->run_modes( 'AUTOLOAD' => sub { $_[0]->rm_login() } );
}

sub cgiapp_init {                         #do session and cookie configuration
    my $app = shift;
    $app->SUPER::cgiapp_init;

    $Session_Dir =
      $app->env('MOXIEDATA')
      ? bm_file_path( $app->env('MOXIEDATA'), 'user_data', 'sessions' )
      : "/tmp";
    bm_confirm_dir( $Session_Dir, { data => 1, build_path => 1 } )
      or $app->error_stop;

    $app->session_config(
        CGI_SESSION_OPTIONS =>
          ["driver:File", $app->query, { Directory => $Session_Dir }],
        COOKIE_PARAMS => {
            -name => 'BigMedium',
            -path => '/',
            -expires => '',    #has to be empty string; undef doesn't cut it
        },
        DEFAULT_EXPIRY => $app->env('SESSION_EXPIRE') || "+60m",
        SEND_COOKIE => 0,      #gets sent explictly by rm_login_verify
    );
    CGI::Session->name('BigMedium');
    
    #makes session escape non-ascii characters for utf8 support
    #(eval doesn't always re-encode those strings correctly when reading
    #dumped strings back into memory). Not entirely clear why this works;
    #CGI::Session creates a Data::Dumper object with $d->Useqq( 0 );
    $Data::Dumper::Useqq = 1;
}

sub cgiapp_prerun {            # Redirect to login, if necessary
    my $app = shift;
    undef $Current_User;
    undef $Current_Site;
    $app->_force_login if $app->param('LOGIN_force');
    $app->run_modes(
        'login'              => 'rm_login',
        'session-expired'    => 'rm_session_expired',
        'login-reminder'     => 'rm_login_reminder',
        'login-verify'       => 'rm_login_verify',
        'login-site'         => 'rm_login_site',
        'logout'             => 'rm_logout',
        'not-permitted'      => 'rm_not_permitted',
        'ajax-login'         => 'rm_ajax_login',
        'ajax-login-verify'  => 'rm_ajax_login_verify',
        'ajax-login-badsite' => 'rm_ajax_login_badsite',
    );

    my $runmode           = $app->get_current_runmode();
    my $not_login_request =
      (      $runmode ne 'login'
          && $runmode ne 'login-verify'
          && $runmode ne 'logout'
          && $runmode ne 'ajax-login'
          && $runmode ne 'ajax-login-verify'
          && $runmode ne 'login-reminder'
          && $runmode ne 'crash' );
    my $session_expired = $not_login_request
      && $app->query->cookie('BigMedium')
      && $app->session->is_new;
    my $fresh_login =
      $not_login_request && !defined $app->session->param('_BMLOGIN_user');

    if ($session_expired) {    #prompt for sign in
        my $redir = $runmode =~ /^ajax/ ? 'ajax-login' : 'session-expired';
        $app->_stow_current_request() if $redir ne 'ajax-login';
        $app->prerun_mode($redir);
    }
    elsif ($fresh_login) {     #prompt for sign in
        my $redir = $runmode =~ /^ajax/ ? 'ajax-login' : 'login';
        $app->_stow_current_request() if $redir ne 'ajax-login';
        $app->prerun_mode($redir);
    }
    elsif ( $not_login_request && $app->_load_session_user ) {    #good
        if ( $app->session->param('_BMLOGIN_prev_url') ) {
            my $redir = $app->_restore_query_from_session;
            $app->prerun_mode($redir) if $redir;
        }
        if ( $app->session->param('_BMLOGIN_first_login') ) {
            $app->call_trigger('after_first_login');
            $app->session->clear( ['_BMLOGIN_first_login'] );
        }
    }
    elsif ($not_login_request) {    #problem authenticating
        my $redir = $runmode =~ /^ajax/ ? 'ajax-login' : 'login';
        $app->prerun_mode($redir);
    }
}

###########################################################
# RUN MODES
###########################################################

sub rm_login {
    my $app     = shift;
    my %options = @_;

    #if we haven't cached a previous request, go ahead and clear
    #the session
    my $s = $app->session;
    $s->clear if !$s->param('_BMLOGIN_prev_url');

    #build the form
    my $fieldset = $app->_login_form(%options);

    my ( $title, $message ) = $app->title_and_message(
        field_msg => $options{field_msg},
        message   => $options{message},
        title     => $options{head} || 'LOGIN_TITLE_Welcome to Big Medium',
    );

    #leave site id off of url or you get caught in a loop of login
    #prompts if it's a bad site id
    $app->html_template_screen(
        'screen_login_login.tmpl',
        bmcp_title => $title,
        form_url   =>
          $app->build_url(    #use current script to maintain params etc
            rm => 'login-verify',
          ),
        login_message => $message,
        fieldsets     => [$fieldset],
        reminder_url  => $app->build_url(
            script => 'bm-reset.cgi',
            rm     => 'password-help',
        ),
    );
}

sub rm_login_verify {
    my $app    = shift;
    my @verify = $app->_verify_credentials();
    return $app->rm_login( %{ $verify[1] } ) if !$verify[0];

    #clean up old session files (cycles through and loads all sessions,
    #automatically deleting any that are expired)
    CGI::Session->find( "driver:File", sub { },
        { Directory => $Session_Dir } );

    #marking for first login
    $app->session->param( '_BMLOGIN_first_login', 1 );
    $app->log( warning => 'Login: '
          . $app->log_data_tag( $app->current_user )
          . ' signed in' );

    #leave the site id off; gets confusing if the wrong or nonexisting id
    #is part of the url; gets you stuck in a loop of constant prompting
    #to sign in with the message "but we don't know that site"
    my $redirect = $app->session->param('_BMLOGIN_prev_url')
      || $app->build_url(
        script => $Default_Script,
        rm     => $Default_Runmode,
      );
    return $app->_set_cookie_redirect($redirect);
}

sub rm_login_site {
    my $app = shift;
    return $app->rm_login() if $app->error();

    my %options = @_;
    my $runmode = $app->get_current_runmode || '';
    $app->_stow_current_request() if $runmode ne 'login-site';

    #fetch sites
    my $user = $app->current_user;
    if ( !$user ) {
        $app->_load_session_user
          or return $app->rm_login( head => 'BM_Please_Review_Your_Entry' );
        $user = $app->current_user or return $app->rm_login();
    }
    my $user_sites;
    if ( $user_sites = $user->stash('LOGIN_site_selection') ) {
        $user->set_stash( 'LOGIN_site_selection', undef );
    }
    else {
        $user_sites = $app->_load_user_sites
          or
          return $app->rm_login( head => 'LOGIN_ERR_HEAD_No sites to edit' );
    }

    #build value list
    my $site;
    my @options;
    my %labels;
    while ( $site = $user_sites->next ) {
        push @options, $site->id;
        $labels{ $site->id } = $site->name; #already escaped
    }
    defined $site or return $app->rm_login();
    my $site_field = $app->prompt_field_ref(
        id        => 'BMsite',
        prompt_as => 'value_list',
        value     => $app->session->param('_BMLOGIN_site'),
        options   => \@options,
        labels    => \%labels,
        label     => 'LOGIN_Websites',
    );

    #build the default checkbox and submit button
    my $make_default = $app->prompt_field_ref(
        id           => 'LOGIN_set_default_site',
        prompt_as    => 'boolean',
        option_label => 'LOGIN_Make this my default website',
        label        => 'LOGIN_Default?',
    );
    my $submit = $app->prompt_field_ref(
        prompt_as => 'submit',
        id        => 'login_submit',
        value     => $app->language('BM_SUBMIT_LABEL_Continue'),
    );

    #assemble fieldset
    my $fieldset = $app->prompt_fieldset_ref(
        fields    => [$site_field, $make_default, $submit],
        title     => 'LOGIN_Choose site to edit',
        query     => $options{query},
        field_msg => $options{field_msg},
    );

    my ( $title, $message ) = $app->title_and_message(
        field_msg => $options{field_msg},
        message   => $options{message},
        title     => $options{head} || 'LOGIN_Select a site',
    );
    my $url = $app->session->param('_BMLOGIN_prev_url')
      || $app->build_url( script => $Default_Script, rm => $Default_Runmode );

    $app->html_template_screen(
        'screen_web_basic.tmpl',
        bmcp_title => $title,
        form_url   => $url,
        message    => $message,
        fieldsets  => [$fieldset],
    );
}

sub rm_session_expired {
    $_[0]->session_cookie();    #set the cookie for the new session
    $_[0]->rm_login(
        head    => 'LOGIN_HEAD_Session Timed Out',
        message => 'LOGIN_TEXT_Session timed Out',
    );
}

sub rm_logout {
    my $app = shift;

    #login automatically clears session; so it's effectively always like
    #logging out...
    $app->rm_login(
        head    => 'LOGIN_HEAD_Signed Out',
        message => 'LOGIN_TEXT_Signed Out',
    );
}

sub rm_login_reminder {
    $_[0]->basic_message(
        head => 'Coming soon...',
        text => 'Apologies for the inconvenience, but this feature is not '
          . 'yet complete. In the meantime, you can request to have your '
          . 'password reset by your <a href="mailto:'
          . $_[0]->env('ADMINEMAIL')
          . '">Big Medium administrator</a>.',
    );
}

sub rm_not_permitted {
    my $app = shift;
    $app->session->param('_BMLOGIN_first_login', 1);
    return $app->basic_message(
        head => $app->language('LOGIN_HEAD_Not permitted'),
        text => $app->language('LOGIN_TEXT_Not permitted'),
    );
}

sub rm_ajax_login {
    my $app     = shift;
    my %options = @_;
    my $site_id = $app->utf8_param('BMsite')
      || $app->path_site()
      || $app->utf8_param('site_id');
    my $fieldset = $app->_login_form( %options, site_id => $site_id );
    my ( $title, $message ) = $app->title_and_message(
        field_msg => $options{field_msg},
        message   => 'LOGIN_TEXT_Session timed Out',
        html_id   => 'BM_AJAX_LOGIN_STATUS',
    );
    my $html = $app->html_template(
        'screen_login_ajax-login.tmpl',
        form_url => $app->build_url(
            script => 'bm-login.cgi',
            rm     => 'ajax-login-verify',
            site   => $site_id
        ),
        message   => $message,
        fieldsets => [$fieldset],
    );
    $app->session_cookie();    #set the cookie
    return $app->ajax_json_response( { 'login' => $html } );
}

sub rm_ajax_login_verify {
    my $app    = shift;
    my @verify = $app->_verify_credentials();
    return $app->rm_ajax_login( %{ $verify[1] } ) if !$verify[0];
    $app->_load_effective_site;    #sign into the site if we can
    return $app->ajax_json_response( { 'valid' => 'OK' } );
}

sub rm_ajax_login_badsite {
    my $html = $_[0]->language(
        [   'AJAX_Could not login',
            '%BM<a href="%'
              . $_[0]->build_url( script => 'bm-login.cgi', rm => 'login' )
              . '%BM">%',
            '%BM</a>%',
        ]
    );
    $_[0]->ajax_error($html);
}

sub _login_form {
    my $app      = shift;
    my %options  = @_;
    my $username = $app->prompt_field_ref(
        data_class => 'BigMed::User',
        column     => 'name',
        id         => 'login_username',
        required   => 1,
        value      => '',
        focus      => 1,
    );
    my $password = $app->prompt_field_ref(
        data_class => 'BigMed::User',
        column     => 'password',
        id         => 'login_password',
        required   => 1,
        value      => '',
    );
    my $submit = $app->prompt_field_ref(
        id        => 'login_submit',
        prompt_as => 'submit',
        value     => $app->language('LOGIN_SUBMIT_Sign In'),
    );
    my @fields = ( $username, $password, $submit );
    if ( $options{site_id} ) {
        push @fields,
          $app->prompt_field_ref(
            id        => 'BMsite',
            prompt_as => 'hidden',
            value     => $options{site_id},
          );
    }
    return $app->prompt_fieldset_ref(
        fields    => \@fields,
        title     => 'LOGIN_LABEL_Please sign in',
        query     => $options{query},
        field_msg => $options{field_msg},
    );
}

sub _verify_credentials {
    my $app   = shift;
    my %field = $app->parse_submission(
        {   id         => 'login_username',
            data_class => 'BigMed::User',
            column     => 'name',
            required   => 1,
        },
        {   data_class => 'BigMed::User',
            column     => 'password',
            id         => 'login_password',
            required   => 1,
        },
    );
    if ( $field{_ERROR} ) {
        return (
            undef,
            {   head      => 'BM_Please_Review_Your_Entry',
                field_msg => $field{_ERROR},
                query     => $app->query,
            },
        );
    }
    $app->_authenticate_user(
        name       => $field{login_username},
        plain_pass => $field{login_password},
      )
      or return (
        undef,
        {   head  => 'BM_Please_Review_Your_Entry',
            query => $app->query,
        }
      );
    return (1);
}

###########################################################
# CURRENT SITE/USER ROUTINES
###########################################################

sub set_current_user {
    my ( $app, $user ) = @_;
    $Current_User = $user;

    #update session if there's a change
    my $s     = $app->session;
    my $suser = $s->param('_BMLOGIN_user') || '';
    my $suid  = $s->param('_BMLOGIN_userid') || 0;
    my $spass = $s->param('_BMLOGIN_password') || '';
    my $ssite = $s->param('_BMLOGIN_site') || 0;

    #clear if no user, or new user
    $s->clear if !$user || ( $suid && $suid != $user->id );
    return undef if !$user;

    if (   $suser ne $user->name
        || $spass ne $user->password
        || $suid != $user->id )
    {
        $s->param( '_BMLOGIN_userid',   $user->id );
        $s->param( '_BMLOGIN_user',     $user->name );
        $s->param( '_BMLOGIN_password', $user->password );
        $s->param( '_BMLOGIN_site',     $ssite );
    }
    $user;
}
sub current_user { $Current_User }

sub set_current_site {
    my $app  = shift;
    my $site = shift;
    $Current_Site = $site;

    my $site_id      = ref $site && $site->id ? $site->id : 0;
    my $s            = $app->session;
    my $session_site = $s->param('_BMLOGIN_site') || 0;
    if ( $session_site && $session_site != $site_id ) {    #changing site
        my $user = $app->current_user;
        $s->clear;
        $s->param( '_BMLOGIN_user',     $user->name );
        $s->param( '_BMLOGIN_userid',   $user->id );
        $s->param( '_BMLOGIN_password', $user->password );
        $s->param( '_BMLOGIN_site',     $site_id );
    }
    elsif ( $session_site != $site_id ) { #not changing site, no need to clear
        $s->param( '_BMLOGIN_site', $site_id );
    }
    $site;
}

sub current_site {
    $_[0]->_load_effective_site() if !$Current_Site;
    return $Current_Site;
}

#short-cut to collect site/user info before passing along to
#format_time
sub format_time {
    my %param = ref $_[2] eq 'HASH' ? %{ $_[2] } : ();
    $param{user} ||= $_[0]->current_user;
    $param{site} ||= $_[0]->current_site;
    $_[0]->SUPER::format_time( $_[1], \%param );
}

###########################################################
# AUTHENTICATION ROUTINES
###########################################################

sub _force_login {
    my $app   = shift;
    my $login = $app->param('LOGIN_force');
    return if ref $login ne 'HASH';
    $app->session_cookie();    #set the cookie
    $app->_authenticate_user(%$login);
}

sub _load_session_user {
    my $app = shift;
    my $s   = $app->session;
    if (   !$s->param('_BMLOGIN_user')
        || !$s->param('_BMLOGIN_password')
        || !$app->_authenticate_user(
            name      => $s->param('_BMLOGIN_user'),
            hash_pass => $s->param('_BMLOGIN_password'),
            id        => $s->param('_BMLOGIN_userid'),
        )
      )
    {
        return undef;    #params not present or not valid
    }
    else {
        return 1;        #authenticated and stowed in current_user
    }
}

sub _load_effective_site {
    my $app = shift;

    #in choosing site, the BMsite parameter takes precedence (means
    #that we're signing into or changing sites, and in certain
    #circumstances, and the parameter more likely reflects the
    #user's wish). If not present, take the site from the path,
    #or if unknown, from the session.

    #Routine returns site object if a site was loaded; false if not. Site
    #is accessible via current_site.
    my $s       = $app->session;
    my $site_id = $app->utf8_param('BMsite')
      || $app->path_site()
      || $s->param('_BMLOGIN_site');
    return $app->_authenticate_site($site_id) if $site_id;

    #if no site selected, see if there's a default to choose.
    my $user       = $app->current_user     or return undef;
    my $user_sites = $app->_load_user_sites or return undef;
    my $site;
    if ( $user_sites->count == 1 ) {
        $site = $user_sites->next or return undef;    #caught error
        $app->set_current_site($site);
    }
    elsif ( $user->default_site ) {                   #get default site
        $site = $user_sites->fetch( $user->default_site ) or return undef;
        $app->set_current_site($site);
    }
    else {    #multiple sites, unable to choose one; stash selection
              #for use by rm_login_site
        $user->set_stash( 'LOGIN_site_selection' => $user_sites );
        return undef;
    }
    $site;
}

sub _authenticate_user {
    my $app = shift;
    defined( my $user = BigMed::User->login(@_) )
      or return undef;
    if ( !$user ) {    #not found
                       #TO DO: Add a throttle-down routine
        my %param = @_;
        my $name = $param{name} || '[no name]';
        $app->log( warning => "Login: Bad sign-in attempt for $name" );
        return $app->set_error(
            head => 'LOGIN_ERR_HEAD_Incorrect User Name or Password',
            text => 'LOGIN_ERR_TEXT_Incorrect User Name or Password',
        );
    }
    $app->set_current_user($user);

    1;
}

sub _authenticate_site {
    my $app     = shift;
    my $site_id = shift;
    defined( my $site = BigMed::Site->fetch($site_id) ) or return undef;
    if ( !$site ) {
        $app->session->clear('_BMLOGIN_site');
        return $app->set_error(
            head => 'LOGIN_ERR_HEAD_No such site',
            text => ['LOGIN_ERR_TEXT_No such site', $site_id],
        );
    }
    my $user = $app->current_user
      or return undef;    #can't authenticate without user
    my $priv_level;
    defined( $priv_level = $user->privilege_level($site) ) or return undef;
    $priv_level
      or return $app->set_error(
        head => 'LOGIN_ERR_HEAD_No privileges at site',
        text => ['LOGIN_ERR_TEXT_No privileges at site', $site->name],
      );
    if (   $app->utf8_param('LOGIN_set_default_site')
        && $app->utf8_param('BMsite') )
    {
        $user->set_default_site($site_id);
        $user->save or return undef;
    }
    $app->set_current_site($site);
}

sub _load_user_sites {
    my $app  = shift;
    my $user = $app->current_user
      or croak 'Cannot do _load_user_sites without current_user defined';
    defined( my $user_sites = $user->allowed_site_selection() )
      or return undef;
    if ( !$user_sites || $user_sites->count == 0 ) {
        return $app->set_error(    #admin
            head => 'LOGIN_ERR_HEAD_No sites to edit',
            text => 'LOGIN_ERR_TEXT_No sites configured',
          )
          if $user->level > 5;
        return $app->set_error(    #mere mortal
            head => 'LOGIN_ERR_HEAD_No sites to edit',
            text => [
                'LOGIN_ERR_TEXT_No sites for this account',
                $user->name,
                '%BM<a href="mailto:'
                  . $app->escape( $app->env('ADMINEMAIL') ) . '">%',
                '%BM</a>%',
            ],
        );
    }
    $user_sites;
}

###########################################################
# DIVERTED REQUESTS AND QUERY CACHING
###########################################################

sub _set_cookie_redirect {
    my $app = shift;
    my $url = shift;

    #this *should* handle the IIS bug that ignores cookies when the
    #location header is set.
    if ( index( $ENV{SERVER_SOFTWARE}, 'Microsoft-IIS' ) >= 0 ) {
        $app->header_add( -refresh => "0; url=$url", );
    }
    else {
        $app->header_type('redirect');
        $app->header_props( -url => $url );
    }
    $app->session_cookie();    #squashing the header, add session manually
    return $app->language('LOGIN_Signing in...');
}

sub _stow_current_request {
    my $app = shift;
    my $url = $app->query->url( -path_info => 1 );
    if ($url) {
        $url =~ s{[.]cgi[/\\]}{.cgi?} if $app->env('USE_BMQUERY');
        my $s = $app->session;
        $s->param( '_BMLOGIN_prev_url', $url );

        #save from utf8_param
        foreach my $p ( $app->query->param() ) {
            my @values = $app->utf8_param($p) or next;
            if ( @values > 1 ) {
                $s->param($p, \@values);
            } else {
                $s->param($p, $values[0]);
            }
        }
    }
    return $app->session_cookie();
}

sub _restore_query_from_session {
    my $app = shift;
    return ''
      unless $app->session->param('_BMLOGIN_prev_url');
    my $new_runmode = $app->session->param('_BMLOGIN_runmode');

    my @protect = qw(_BMLOGIN_user _BMLOGIN_userid _BMLOGIN_password
      _BMLOGIN_site _BMLOGIN_first_login);

    #load session info into utf8_param object, except the _BMLOGIN info
    #start fresh, but don't delete existing params in query; need to clear
    #the rparam internally.
    my $rparam = {};
    
    #utf8_param stores all values as array refs;
    my $s = $app->session;
    foreach my $p ( $s->param ) {
        $rparam->{$p} = ref $s->param($p) ? $s->param($p) : [$s->param($p)];
    }
    $app->param('_WEB_UTF8', $rparam); #reset the utf8_param hashref
    my $q = $app->query;
    $s->load_param($q); #restore query object too, for good measure

    $app->clear_utf8_param(@protect, '_BMLOGIN_prev_url', '_BMLOGIN_runmode');

    #clear the session except for user/site info and _BMLOGIN_first_login
    my %orig;
    foreach my $key (@protect) {
        $orig{$key} = $app->session->param($key);
    }
    $s->clear();
    foreach my $key (@protect) {
        $s->param( $key, $orig{$key} );
    }
    return $new_runmode;
}

sub html_general_params {
    my $app        = shift;
    my %tmpl_param = $app->SUPER::html_general_params(@_);
    my ( $site, $user );
    if ( $site = $app->current_site ) {
        $tmpl_param{bmcp_now_editing} = $app->language('BM_Now editing');
        $tmpl_param{bmcp_sitename}   = $site->name;    #already escaped
        $tmpl_param{bm_current_site} = $site->id;      #already escaped
        $tmpl_param{bmcp_siteurl}    =
          $site->homepage_url . '/index.shtml';        #already escaped
    }
    if ( $user = $app->current_user ) {
        $tmpl_param{bmcp_username} = $user->name;      #already escaped
        $tmpl_param{bmcp_userid}   = $user->id;
        my $priv_level = $user->privilege_level($site)
          || '0';    #quietly ignore an error
        $tmpl_param{bmcp_userpriv} =
          $app->language( 'BM_User_Priv' . $priv_level );
    }
    %tmpl_param;
}

sub teardown {
    my $self = shift;
    $self->SUPER::teardown;
    $self->session->flush if $self->session;
}

1;

__END__

=head1 NAME

BigMed::App::Web::Login - Big Medium application class for user verification

=head1 DESCRIPTION

BigMed::App::Web::Login is a subclass of BigMed::App::Web that requires
user verification via BigMed::User. BigMed::App::Web::Login can be subclassed
by Big Medium web application modules that require user credentials.

BigMed::App::Web::Login manages authentication via cookies and server-side
session files; cookies and session files are generated automagically for
every request made via this class and its subclasses.

=head2 USAGE

=head2 Subclassing BigMed::App::Web::Login

To subclass BigMed::App::Web::Login, use it as the base class for your
application module by including these lines at the top of your module:

    package MyApp;
    use base qw(BigMed::App::Web::Login);

In addition to this module's run modes and user-validation, you also inherit
all of the methods of BigMed::App::Web.

=head2 Automated authentication

BigMed::App::Web::Login intercepts run mode requests via its C<cgiapp_prerun>
method and checks the user's session info for a valid login. If there isn't
one, or if the session has expired, BigMed::App::Web::Login diverts the
user to an appropriate login run mode 

The automated authentication will automatically load and cache the current
user object. Here's how those objects are selected.

=over 4

=item * User object

If the C<LOGIN_force> application parameter is loaded, the credentials in
that hash reference are used to load and verify the user object. (See
L<Specifying a User at Object Construction> below).

If there is not LOGIN_force parameter, Login checks the session for
user credentials stored earlier. If present, those are used.

If there are no session credentials, the run mode is diverted to a login
screen. The original URL, run mode and form parameters are stored in the
session, and Login automatically redirects to the original action after
the login is complete (this scenario applies to both expired sessions
and new logins).

=item * Site object

The site object for the current operation is loaded (and cached) when
you call the C<current_site> method.

=back

=head2 AJAX requests

It would be inconvenient to say the least if AJAX requests intended to update
a portion of the page suddenly displayed the full login screen, which would
be the result, for example, with expired sessions.

To avoid this, Login
checks the run mode name to see if it begins with the text "ajax" and, instead
of diverting the run mode to a login screen, it instead returns a login
form to be displayed within the current Big Medium page. This result can
be detected and displayed via the BM.Ajax.loginRequired javascript function;
for more details, see the supporting javascript files in Big Medium's
bmadmin/js directory.

=head2 Login info

=head3 C<< $app->current_user() >>

The BigMed::User object of the user currently signed into the application is
stored as a singleton. This method returns that singleton user object.

=head3 C<< $app->set_current_user() >>

Sets the singleton user object, and updates the session with the relevant
info.

=head3 C<< $app->current_site() >>

The BigMed::Site object of the site the user is currently working on.
This object is cached as a singleton the first time this method is
called.

The method checks the following values in the displayed order to determine
which site to load:

=over 4

=item * The method checks for a query parameter named C<BMsite> and loads
the site object with the id in that parameter value.

=item * If there no C<BMsite> parameter present, the method uses the site
specified in the URL path (via the C<path_info> method).

=item * If there is no site id present in the URL path, the method checks
the session for a C<_BMLOGIN_site> parameter and uses that id.

=back

If no site ID can be determined, the method returns undef.

In most cases you'll want to prompt the user for a site if no site can
be found:

    my $site = $app->current_site() or return $app->rm_login_site();


=head3 C<< $app->set_current_site() >>

Sets the singleton site object, and updates the session with the relevant
info.

=head2 Session Methods

BigMed::App::Web::Login automatically adds user sessions by incorporating a
CGI::Session object. A persistent session file is created for every
connection to a script using a BigMed::App::Web subclass application
module, and a cookie holding the unique session ID is automatically sent
to the user.

BigMed::App::Web::Login sessions have the following characteristics:

=over 4

=item * Session files are stored in the moxiedata/user_data/sessions
directory.

=item * These session files expire after the session time set in the BigMed
configuration (default is 60 minutes).

=item * The cookie holding the session id is named 'BigMedium' and it
expires at the end of the browser session.

=back

=head3 C<< $app->session >>

Returns the current CGI::Session object. This object is created on the first
call to the method and any subsequent calls return the same singleton
object for the duration of the request.

When C<session> is called, it looks for a cookie containing the session ID
and if none is found, it creates a new session.  If a cookie with the
session ID is found but the session has expired, then a new session will
be created.

The session object provides all of the methods provided by CGI::Session.
See the CGI::Session documentation for all of the details, but here are
the can't-live-without-em methods:

=over 4

=item * C<< $session->param($param_name) >>

Returns the value of the requested parameter.

=item * C<< $session->param($param_name, $param_value) >>

Sets the value of the parameter named in the first argument with the value
of the second argument.

=item * C<< $session->clear($param_name | \@param_names) >>

Clears parameters and values from the session object. If the argument
is undefined, all parameters are cleared. If the argument is a string
with a parameter name, only that parameter is cleared. If the argument
is an array reference, only the parameters named in the array will be
cleared.

To delete the session completely, use the C<< $app->session_delete >>
method instead (worth underlining: C<session_delete> is a method
of the application object, not the session object).

=item * C<< $session->dataref >>

Returns a hash reference to the session's parameter values.

    my $session = $app->$session;
    my $rparam = $session->dataref;
    my $first_name = $rparam->{first_name};
    my $last_name = $rparam->{last_name};

=item * C<< $session->save_param($query, \@param) >>

Saves parameters from a CGI.pm query object to the session object. In other
words, it's the same as calling param($name, $value) for every single query
parameter returned by $query->param().

    my $q = $app->query; # get user-submitted parameters
    my $session = $app->session; #get the session
    $session->save_param($query); #save all parameters to the session

If the second argument is present and is a reference to an array, only those
query parameters found in the array will be stored in the session.

=item * C<< $session->load_param($query, \@param) >>

Works like C<save_param> but in the opposite direction, loading session
parameters into a CGI query object. If the second argument is present and
is a reference to an array, only parameters found in that array will be
loaded to the query object.

=back

=head3 C<< $app->session_delete >>

Deletes the session file and removes the cookie from the client.

=head2 RUN MODES

=head3 login

The login run mode presents a welcome message and a login screen.

=head3 login-verify

Authenticates submitted username/password pair and then forwards to
a cached URL (if a URL requiring login was previously requested) or to
the default URL.

=head3 login-site

Prompts the user to select a site to edit.

=head3 logout

Signs out the user, deleting the session and cookie info.

=head3 not-permitted

Screen displays a message saying that the user does not have adequate
privileges to complete the requested action.

=head2 Specifying a User at Object Construction

As with BigMed::App::Web, you create and run BigMed::App::Web::Login modules
by using the C<new> and C<run> methods:

    my $app = MyApp->new();
    $app->run();

The C<new> method in BigMed::App::Web::Login also accepts an additional
optional parameter, C<LOGIN_force>, which allows you to specify the
username and password of the user to use when creating the new module:

    $app =
      MyApp->new( params =>
          { LOGIN_force => { name => $user_name, hash_pass => $pass } } );

These credentials will be used to login instead of any session info.
In practice, it's a rare case indeed when you already have the user and
password in hand when you're creating the application object. This is
used, for example, by BigMed::App::Web::Start for the Big Medium setup wizard
to create a login session immediately after creating the first account.

=head2 CALLBACKS

Callbacks may be registered by BigMed::App::Web::Login and its subclasses by
calling the add_trigger class method:

    BigMed::App::Web::Login->add_trigger('after_first_login', \&callback);

See BigMed::Trigger for more details about triggers and callbacks.
BigMed::App::Web::Login supports the following trigger hooks:

=head3 after_first_login

This hook's callbacks are run just before running the first run mode after
a successful login via the login-verify run mode. Login-verify forwards
the user to a URL after authentication, and these callbacks are run
after the user is forwarded but before the first run mode is executed.

This hook's callbacks receive the application object as the only argument.

=head1 SEE ALSO

=over 4

=item * BigMed::App::Web

=item * CGI::Session

=item * CGI::Application::Plugin::Session

=back

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut