package Apache2::Controller::Directives;

=head1 NAME

Apache2::Controller::Directives - server config directives for A2C

=head1 VERSION

Version 1.000.100

=cut

use version;
our $VERSION = version->new('1.000.100');

=head1 SYNOPSIS

 # apache2 config file
 PerlLoadModule Apache2::Controller::Directives

 # for Apache2::Controller::Render::Template settings:
 A2C_Render_Template_Path /var/myapp/templates

 # etc.

All values are detainted using C<< m{ \A (.*) \z }mxs >>,
since they are assumed to be trusted because they come
from the server config file.  As long as you don't give
your users the ability to set directives, it should be okay.

=cut

use strict;
use warnings FATAL => 'all';
use English '-no_match_vars';

use Carp qw( croak );
use Log::Log4perl qw(:easy);
use YAML::Syck;
use Readonly;

use Apache2::Module ();
use Apache2::Const -compile => qw( OR_ALL NO_ARGS TAKE1 ITERATE ITERATE2 RAW_ARGS );
use Apache2::Controller::X;

use Apache2::Controller::Const qw( @RANDCHARS );

my @directives = (

    # dispatch
    {
        name            => 'A2C_Dispatch_Map',
        func            => __PACKAGE__.'::A2C_Dispatch_Map',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE,
        errmsg          => 'A2C_Dispatch_Map /path/to/yaml/syck/dispatch/map/file',
    },

    # template rendering
    { 
        name            => 'A2C_Render_Template_Path',
        func            => __PACKAGE__.'::A2C_Render_Template_Path',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE,
        errmsg          => 'A2C_Render_Template_Path /primary/path [/second ... [/n]]',
    },
    {
        name            => 'A2C_Render_Template_Opts',
        func            => __PACKAGE__.'::A2C_Render_Template_Opts',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE2,
        errmsg          => q{
            # specify Template Toolkit options:
            A2C_Render_Template_Opts INTERPOLATE 1
            A2C_Render_Template_Opts PRE_PROCESS header scripts style
            A2C_Render_Template_Opts POST_CHOMP  1
        },
    },

    # session stuff
    {
        name            => 'A2C_Session_Class',
        func            => __PACKAGE__.'::A2C_Session_Class',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Session_Class Apache::Session::File'
    },
    {
        name            => 'A2C_Session_Opts',
        func            => __PACKAGE__.'::A2C_Session_Opts',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE2,
        errmsg          => q{
            # specify options for chosen Apache::Session subclass.
            # example:
            A2C_Session_Opts   Directory       /tmp/sessions
            A2C_Session_Opts   LockDirectory   /var/lock/sessions
        },
    },
    {
        name            => 'A2C_Session_Secret',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::RAW_ARGS,
        errmsg          => q{
            # specify a constant secret for continuity across server restarts
            A2C_Session_Secret  foobar

            # if no parameters, server startup will generate a secret,
            # but this won't work for cluster farms etc.
            A2C_Session_Secret
        },
    },
    {
        name            => 'A2C_Session_Always_Save',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::NO_ARGS,
        errmsg          => 'example: A2C_Session_Always_Save',
    },
    {
        name            => 'A2C_Session_Cookie_Opts',
        func            => __PACKAGE__.'::A2C_Session_Cookie_Opts',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE2,
        errmsg          => q{
            # specify Apache2::Cookie options for session cookie.
            # example:
            A2C_Session_Cookie_Opts   name       myapp_sessionid
            A2C_Session_Cookie_Opts   expires    +3M
        },
    },

    # A2C:DBI::Connector
    {
        name            => 'A2C_DBI_DSN',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_DSN DBI:mysql:database=foo',
    },
    {
        name            => 'A2C_DBI_User',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_User database_username',
    },
    {
        name            => 'A2C_DBI_Password',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_Password database_password',
    },
    {
        name            => 'A2C_DBI_Options',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE2,
        errmsg          => q{
            # specify DBI connect() options:
            A2C_DBI_Options RaiseError 1
            A2C_DBI_Options AutoCommit 0
        },
    },
    {
        name            => 'A2C_DBI_Cleanup',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_Cleanup 1',
    },
    {
        name            => 'A2C_DBI_Class',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_Class MyApp::DBI',
    },
    {
        name            => 'A2C_DBI_Pnotes_Name',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_DBI_Pnotes_Name reader',
    },

    # A2C:Auth::OpenID
    {
        name            => 'A2C_Auth_OpenID_Login',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Login /myapp/login',
    },
    {
        name            => 'A2C_Auth_OpenID_Logout',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Logout /myapp/logout',
    },
    {
        name            => 'A2C_Auth_OpenID_Register',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Register /myapp/register',
    },
    {
        name            => 'A2C_Auth_OpenID_Timeout',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Timeout +1h',
    },
    {
        name            => 'A2C_Auth_OpenID_Table',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Table openid',
    },
    {
        name            => 'A2C_Auth_OpenID_User_Field',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_User_Field uname',
    },
    {
        name            => 'A2C_Auth_OpenID_URL_Field',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_URL_Field openid_url',
    },
    {
        name            => 'A2C_Auth_OpenID_DBI_Name',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_DBI_Name dbh',
    },
    {
        name            => 'A2C_Auth_OpenID_Trust_Root',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_Trust_Root http://blah.tld/blah',
    },
    {
        name            => 'A2C_Auth_OpenID_LWP_Class',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::TAKE1,
        errmsg          => 'example: A2C_Auth_OpenID_LWP_Class LWPx::ParanoidAgent',
    },
    {
        name            => 'A2C_Auth_OpenID_LWP_Opts',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::ITERATE2,
        errmsg          => q{
            # specify options to the LWP class.  example:
            A2C_Auth_OpenID_LWP_Opts timeout           10
            A2C_Auth_OpenID_LWP_Opts agent             A2C-openid
            A2C_Auth_OpenID_LWP_Opts whitelisted_hosts 127.0.0.1  foo.bar.tld
            # (don't whitelist stuff for ParanoidAgent unless you know
            # what you're doing... we do this for the test suite)
        },
    },
    {
        name            => 'A2C_Auth_OpenID_Allow_Login',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::NO_ARGS,
        errmsg          => 'example: A2C_Auth_OpenID_Allow_Login',
    },
    {
        name            => 'A2C_Auth_OpenID_Consumer_Secret',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::RAW_ARGS,
        errmsg          => q{
            # specify a constant secret for continuity across server restarts
            A2C_Auth_OpenID_Consumer_Secret  foobar

            # if no parameters, server startup will generate a secret,
            # but this won't work for cluster farms etc.
            A2C_Auth_OpenID_Consumer_Secret
        },
    },
    {
        name            => 'A2C_Auth_OpenID_NoPreserveParams',
        req_override    => Apache2::Const::OR_ALL,
        args_how        => Apache2::Const::NO_ARGS,
        errmsg          => 'example: A2C_Auth_OpenID_NoPreserveParams',
    },
);

Apache2::Module::add(__PACKAGE__, \@directives);

=head1 Apache2::Controller::Dispatch

See L<Apache2::Controller::Dispatch>

=head2 A2C_Dispatch_Map

This is the path to a file compatible with L<YAML::Syck>.
If you do not provide a C<< dispatch_map() >> subroutine,
the hash will be loaded with this file.

Different subclasses of L<Apache2::Controller::Dispatch>
have different data structures.  YMMV.

Or, if you just specify a package name, it will generate
a dispatch map with one 'default' entry with that package.

=cut

sub A2C_Dispatch_Map {
    my ($self, $parms, $value) = @_;

    ($value) = $value =~ m{ \A (.*) \z }mxs;

    if ($value =~ m{ :: }mxs) {
        $self->{A2C_Dispatch_Map} = { default => $value };
        return;
    }

    my $file = $value;
  # DEBUG("using file '$file' as A2C_Dispatch_Map");
    croak "A2C_Dispatch_Map $file does not exist or is not readable."
        if !(-e $file && -f _ && -r _);
    
    # why not go ahead and load the file!

    # slurp it in so it can be detainted.

    my $file_contents;
    {   local $/;
        open my $loadfile_fh, '<', $file 
            || croak "Cannot read A2C_Dispatch_Map $file: $OS_ERROR";
        $file_contents = <$loadfile_fh>;
        close $loadfile_fh;
    }

    eval { $self->{A2C_Dispatch_Map} = Load($file_contents) };
    croak "Could not load A2C_Dispatch_Map $file: $EVAL_ERROR" if $EVAL_ERROR;

  # DEBUG("success!");
    return;
}

=head1 Apache2::Controller::Render::Template

See L<Apache2::Controller::Render::Template>.

=head2 A2C_Render_Template_Path

This is the base path for templates used by 
Apache2::Controller::Render::Template.  The directive takes only
one parameter and verifies that the directory exists and is readable.

(At startup time Apache2 is root... this should verify readability by 
www user?  Hrmm how is it going to figure out what user that is?
It will have to access the server config via $parms. Except that
this does not appear to work?  It returns an empty hash.)

=cut

sub A2C_Render_Template_Path {
    my ($self, $parms, @directories_untainted) = @_;

    my @directories = map { 
        my ($val) = $_ =~ m{ \A (.*) \z }mxs;
        $val;
    } @directories_untainted;

    # uhh... this doesn't work?
  # my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
  # DEBUG(sub{"SERVER CONFIG:\n".Dump({
  #     map {("$_" => $srv_cfg->{$_})} keys %{$srv_cfg}
  # }) });
  # DEBUG("server is ".$parms->server);

    # I need to figure out how to merge these or something

    croak("A2C_Render_Template_Path '$_' does not exist or is not readable.") 
        for grep !( -d $_ && -r _ ), @directories;

    my $current = $self->{A2C_Render_Template_Path} || [ ];
  # DEBUG("pushing (@directories) to (@{$current})");

    push @{ $self->{A2C_Render_Template_Path} }, @directories;
}

=head2 A2C_Render_Template_Opts

 <location "/where/template/is/used">
     A2C_Render_Template_Opts INTERPOLATE 1
     A2C_Render_Template_Opts PRE_PROCESS header meta style scripts
     A2C_Render_Template_Opts POST_CHOMP  1
 </location>

Options for Template Toolkit.  See L<Template>.

You can also implement C<<get_template_opts>> in your controller subclass,
which simply returns the hash reference of template options.
See L<Apache2::Controller::Render::Template>.

Note the behavior is to merge values specified at multiple levels
into array references.  i.e. a subdirectory could specify an
additional C<<PRE_PROCESS>> template or whatever.  YMMV.
It should be this way, at any rate!

=cut

sub A2C_Render_Template_Opts {
    my ($self, $parms, $key, $val) = @_;
    $self->hash_assign('A2C_Render_Template_Opts', $key, $val);
    return;
}

=head1 Apache2::Controller::Session

See L<Apache2::Controller::Session>.

=head2 A2C_Session_Class

 A2C_Session_Class Apache::Session::File

Single argument, the class for the tied session hash.  L<Apache::Session>.

=cut

sub A2C_Session_Class {
    my ($self, $parms, $class) = @_;
    ($class) = $class =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Session_Class} = $class;
}

=head2 A2C_Session_Opts

Multiple arguments

 A2C_Session_Opts   Directory       /tmp/sessions
 A2C_Session_Opts   LockDirectory   /var/lock/sessions

=cut

sub A2C_Session_Opts {
    my ($self, $parms, $key, $val) = @_;
    $self->hash_assign('A2C_Session_Opts', $key, $val);
    return;
}

=head2 A2C_Session_Secret

 # generate a random 30-character string:
 A2C_Session_Secret

 # specify your own string:
 A2C_Session_Secret jsd9e9j#*@JMf39kc3

This server-wide constant string will used to verify the session id.
See L<Apache2::Controller::Session>.

If you don't specify the value, it will generate a default 30-character
random string, but this will regenerate on server restarts, and would not
work for a cluster of servers serving the same application.

=cut

sub A2C_Session_Secret {
    my ($self, $parms, $val) = @_;
    if (!defined $val || $val =~ m{ \A \s* \z }mxs) {
        srand;
        $val = join('', map $RANDCHARS[int(rand(@RANDCHARS))], 1..30);
    }
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Session_Secret} = $val;
}

=head2 A2C_Session_Always_Save

 A2C_Session_Always_Save

Takes no arguments.  If directed, L<Apache2::Controller::Session>
will update a top-level timestamp in 
C<< $r->pnotes->{a2c}{session}{a2c_timestamp} >> so that
L<Apache::Session> will always save.

=cut

sub A2C_Session_Always_Save {
    my ($self, $parms) = @_;
    $self->{A2C_Session_Always_Save} = 1;
}

=head2 A2C_Session_Cookie_Opts

 A2C_Session_Cookie_Opts name    myapp_sessionid
 A2C_Session_Cookie_Opts expires +3M

Multiple arguments.  
L<Apache2::Controller::Session::Cookie>,
L<Apache2::Cookie>

=cut

sub A2C_Session_Cookie_Opts {
    my ($self, $parms, $key, $val) = @_;
    $self->hash_assign('A2C_Session_Cookie_Opts', $key, $val);
    return;
}

=head1 Apache2::Controller::DBI::Connector

See L<Apache2::Controller::DBI::Connector>.

=head2 A2C_DBI_DSN 

 A2C_DBI_DSN        DBI:mysql:database=foobar;host=localhost

Single argument, the DSN string.  L<DBI>

=cut

sub A2C_DBI_DSN {
    my ($self, $parms, $dsn) = @_;
    ($dsn) = $dsn =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_DSN} = $dsn;
}

=head2 A2C_DBI_User

 A2C_DBI_User       heebee

Single argument, the DBI username.

=cut

sub A2C_DBI_User {
    my ($self, $parms, $user) = @_;
    ($user) = $user =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_User} = $user;
}

=head2 A2C_DBI_Password

 A2C_DBI_Password   jeebee

Single argument, the DBI password.

=cut

sub A2C_DBI_Password {
    my ($self, $parms, $password) = @_;
    ($password) = $password =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_Password} = $password;
}

=head2 A2C_DBI_Options

Multiple arguments.

 A2C_DBI_Options    RaiseError  1
 A2C_DBI_Options    AutoCommit  0

=cut

sub A2C_DBI_Options {
    my ($self, $parms, $key, $val) = @_;
    $self->hash_assign('A2C_DBI_Options', $key, $val);
    return;
}

=head2 A2C_DBI_Cleanup

Boolean.  

 A2C_DBI_Cleanup        1

=cut

sub A2C_DBI_Cleanup {
    my ($self, $parms, $val) = @_;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_Cleanup} = $val;
    return;
}

=head2 A2C_DBI_Pnotes_Name

String value.

 A2C_DBI_Pnotes_Name    reader

=cut

sub A2C_DBI_Pnotes_Name {
    my ($self, $parms, $val) = @_;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_Pnotes_Name} = $val;
    return;
}

=head2 A2C_DBI_Class

If you subclass DBI, specify the name of your DBI subclass here.

 A2C_DBI_Class      MyApp::DBI

Note that this is connected with a string eval which is slow.
If you don't use it, it uses a block eval to connect DBI.

=cut

sub A2C_DBI_Class {
    my ($self, $parms, $val) = @_;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_DBI_Class} = $val;
}

=head1 Apache2::Controller::Auth::OpenID

See L<Apache2::Controller::Auth::OpenID>.

=head2 A2C_Auth_OpenID_Login

 A2C_Auth_OpenID_Login  login

The URI path for your login controller page. 

If you start the value with a '/', it thinks you mean
an absolute URI.

If you do not start the value with a '/', it thinks you
mean a uri relative to 
the location path where the directive was declared.

Examples:

 <Location '/foo/bar'>
     A2C_Auth_OpenID_Login  /login
 </Location>

The user would be redirected to absolute uri '/login'.

 <Location '/loungy/vegas/entertainment'>
     A2C_Auth_OpenID_Login  kenny_loggins
 </Location>

The user would be redirected to 
C<< /loungy/vegas/entertainment/kenny_loggins >> 
if they are not logged in.

These conventions are the same for C<< A2C_Auth_OpenID_Logout >>
and C<< A2C_Auth_OpenID_Register >>.

Default is the path where the controller is declared, appended with '/login'.
Access will be allowed.

=cut

sub A2C_Auth_OpenID_Login {
    my ($self, $parms, $val) = @_;
    $val = 'login' if !defined $val;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $val = $parms->path.'/'.$val if $val !~ m{ \A / }mxs;
    $self->{A2C_Auth_OpenID_Login} = $val;
}

=head2 A2C_Auth_OpenID_Logout

 A2C_Auth_OpenID_Logout  logout

The URI path for your logout controller page.

Logout is processed automatically, resetting the flag and
timestamp in the session hash.  So you just need to present
a page that says "Good riddance" or something.

Same conventions apply as to C<< A2C_Auth_OpenID_Login >>.
Default is the path where the controller is declared, appended with '/logout'.
Access will be allowed.

=cut

sub A2C_Auth_OpenID_Logout {
    my ($self, $parms, $val) = @_;
    $val = 'logout' if !defined $val;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $val = $parms->path.'/'.$val if $val !~ m{ \A / }mxs;
    $self->{A2C_Auth_OpenID_Logout} = $val;
}

=head2 A2C_Auth_OpenID_Register

 A2C_Auth_OpenID_Register  register

The path for your registration page, where you will ask the user
to sign up and associate a username with the openid url.

Same conventions apply as to C<< A2C_Auth_OpenID_Login >>.
Default is the path where the controller is declared, appended with '/register'.
Access will be allowed.

=cut

sub A2C_Auth_OpenID_Register {
    my ($self, $parms, $val) = @_;
    $val = 'register' if !defined $val;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $val = $parms->path.'/'.$val if $val !~ m{ \A / }mxs;
    $self->{A2C_Auth_OpenID_Register} = $val;
}

=head2 A2C_Auth_OpenID_Timeout

 A2C_Auth_OpenID_Timeout  +1h

Idle timeout in seconds, +2m, +3h, +4D, +6M, +7Y, or 'no timeout'.
Default is 1 hour.  A month is actually 30 days, a year 365.

If you use 'no timeout' then logins will never expire.
This probably is not a good idea because OpenID url's can
be revoked, and because the login process can be a transparent
series of redirects if the user has something like
Verisign's SeatBelt plugin.

If you're doing some sort of cluster application or load balancing
and sharing the session between servers, make sure all your servers
are synchronized with NTP.  

=cut

my %time_multiplier = (
    s       => 1,
    m       => 60,
    h       => 60 * 60,
    D       => 60 * 60 * 24,
    M       => 60 * 60 * 24 * 30,
    Y       => 60 * 60 * 24 * 365,
);

sub A2C_Auth_OpenID_Timeout {
    my ($self, $parms, $val) = @_;
    $val ||= '+1h';
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    if ($val ne 'no timeout') {
        my ($num, $period) = $val =~ m{ \A \+? (\d+) ([YMDhms]?) \z }mxs;
        $period ||= 's';
        croak("A2C_Auth_OpenID_Timeout invalid format") 
            if !$num || !exists $time_multiplier{$period};
        $val = $num * $time_multiplier{$period};
    }

    $self->{A2C_Auth_OpenID_Timeout} = $val;
}

=head2 A2C_Auth_OpenID_Table

 A2C_Auth_OpenID_Login  openid

Name of the table in your connected database containing the 
user name and OpenID url fields.  Default == "openid".

=cut

sub A2C_Auth_OpenID_Table {
    my ($self, $parms, $val) = @_;
    $val ||= 'openid';
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_Table} = $val;
}

=head2 A2C_Auth_OpenID_User_Field

 A2C_Auth_OpenID_User_Field  uname

Name of username field in table.  Default == "uname".

=cut

sub A2C_Auth_OpenID_User_Field {
    my ($self, $parms, $val) = @_;
    $val ||= 'uname';
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_User_Field} = $val;
}

=head2 A2C_Auth_OpenID_URL_Field

 A2C_Auth_OpenID_URL_Field  openid_url

Name of OpenID URL field in table.  Default == "openid_url".

=cut

sub A2C_Auth_OpenID_URL_Field {
    my ($self, $parms, $val) = @_;
    $val ||= 'openid_url';
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_URL_Field} = $val;
}

=head2 A2C_Auth_OpenID_DBI_Name

 A2C_Auth_OpenID_DBI_Name  dbh

Name in C<< $r->pnotes->{a2c} >> of the connected L<DBI> handle.
Default == "dbh".

=cut

sub A2C_Auth_OpenID_DBI_Name {
    my ($self, $parms, $val) = @_;
    $val ||= 'dbh';
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_DBI_Name} = $val;
}

=head2 A2C_Auth_OpenID_Trust_Root

 A2C_Auth_OpenID_Trust_Root  http://blah.tld/blah

The trust_root param to pass to the user's OpenID server.
See L<Net::OpenID::Consumer>.  Default is the top of 
the web site with whatever scheme, host and port that
is currently being requested.

=cut

sub A2C_Auth_OpenID_Trust_Root {
    my ($self, $parms, $val) = @_;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_Trust_Root} = $val;
}

=head2 A2C_Auth_OpenID_LWP_Class

 A2C_Auth_OpenID_LWP_Class  LWPx::ParanoidAgent

Name of the L<LWP> class to use.  By default it uses
L<LWPx::ParanoidAgent> but not L<LWPx::ParanoidAgent::DashT>,
as that one is not available as a Debian package, I
was unsuccessful building it with dh-make-perl, and I
want to be able to distribute to Debian.

=cut

sub A2C_Auth_OpenID_LWP_Class {
    my ($self, $parms, $val) = @_;
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_LWP_Class} = $val || 'LWPx::ParanoidAgent';
}

=head2 A2C_Auth_OpenID_LWP_Opts

Specify options to the LWP class.

 A2C_Auth_OpenID_LWP_Opts timeout           10
 A2C_Auth_OpenID_LWP_Opts agent             A2C-openid
 A2C_Auth_OpenID_LWP_Opts whitelisted_hosts [ 127.0.0.1  foo.bar.com ]

Don't whitelist stuff for ParanoidAgent unless you know
what you're doing... I was going do this for the test suite to let
the module call the temporary OpenID server set up on localhost.

But that ends up not working in the test suite because of some other 
problem trying to connect to a port which I don't know necessarily?
("Error fetching URL: No sock from bgsend").
So the test suite just uses plain old LWP::UserAgent.

This uses C<< hash_assign() >> to assign the options.

Use [ ] to force an array ref for a single option that has
to be an arrayref: 

 A2C_Auth_OpenID_LWP_Opts whitelisted_hosts [ 192.168.34.5 ]

but don't use commas, it's tricky.
 
=cut

sub A2C_Auth_OpenID_LWP_Opts {
    my ($self, $parms, $key, $val) = @_;
    $self->hash_assign('A2C_Auth_OpenID_LWP_Opts', $key, $val);
    return;
}

=head2 A2C_Auth_OpenID_Allow_Login

 A2C_Auth_OpenID_Allow_Login

Takes no arguments.  If directed, L<Apache2::Controller::Auth::OpenID>
will allow all login attempts and will not attempt to authenticate 
with OpenID.  Useful for debugging your application on your laptop
when you are not connected to the Internet.

=cut

sub A2C_Auth_OpenID_Allow_Login {
    my ($self, $parms) = @_;
    $self->{A2C_Auth_OpenID_Allow_Login} = 1;
}

=head2 A2C_Auth_OpenID_Consumer_Secret

 # generate a random 30-character string:
 A2C_Auth_OpenID_Consumer_Secret

 # specify your own string:
 A2C_Auth_OpenID_Consumer_Secret jsd9e9j#*@JMf39kc3

This server-wide constant string will be appended to the value of 
time() for the sha224_base64 hash provided as the consumer_secret.
See L<Net::OpenID::Consumer/consumer_secret>.

If you don't specify the value, it will generate a default 30-character
random string, but this will regenerate on server restarts, and would not
work for a cluster of servers serving the same application.


=cut

sub A2C_Auth_OpenID_Consumer_Secret {
    my ($self, $parms, $val) = @_;
    if (!defined $val || $val =~ m{ \A \s* \z }mxs) {
        srand;
        $val = join('', map $RANDCHARS[int(rand(@RANDCHARS))], 1..30);
    }
    ($val) = $val =~ m{ \A (.*) \z }mxs;
    $self->{A2C_Auth_OpenID_Consumer_Secret} = $val;
}

=head2 A2C_Auth_OpenID_NoPreserveParams

 A2C_Auth_OpenID_NoPreserveParams

Takes no arguments.  If directed, L<Apache2::Controller::Auth::OpenID>
will not preserve GET/POST params.  I know a double-negative is
frowned upon, but it makes the most sense here, because preserving
GET/POST params should be the default behavior, and this turns
off that behavior.

=cut

sub A2C_Auth_OpenID_NoPreserveParams {
    my ($self, $parms) = @_;
    $self->{A2C_Auth_OpenID_NoPreserveParams} = 1;
}

=head2 hash_assign 

This is not a configuration option, but an internal routine
that we use to assign ITERATE2 options in a consistent way,
or so one might hope.  I'm not sure I fully understand the
behavior and I haven't written tests for directives.

If a single value is specified, it is assigned as a scalar.

If multiple values are specified (on the same configuration
directive call or in multiple calls) they are successively 

This is sort of similar the way that C<< $r->param >> will get
a string or an array ref depending if the var has been named
more than once.

Use [ ] to force an array ref for a single option that has
to be an arrayref: 

 A2C_Auth_OpenID_LWP_Opts whitelisted_hosts [ 127.0.0.1 ]

but don't use commas, it's tricky.  The closing ] is actually
ignored, but you should use it to make it look sensible.

As a result, you can't use '[' or ']' for the values of 
any of these options... but you "shouldn't need to do that."

See L<Apache2::Const/ITERATE2>.

=cut

sub hash_assign {
    my ($self, $directive, $key, $val) = @_;

    croak "No value for $directive {$key}." if !$val;

    ($key) = $key =~ m{ \A (.*) \z }mxs;
    ($val) = $val =~ m{ \A (.*) \z }mxs;

    if ($val eq '[') {
        $self->{$directive}{$key} = [ ] if !exists $self->{$directive}{$key};
        return;
    }

    return if $val eq ']';
    
    if (exists $self->{$directive}{$key}) {
        $self->{$directive}{$key} = [ $self->{$directive}{$key} ]
            if !ref $self->{$directive}{$key};
        push @{$self->{$directive}{$key}}, $val;
    }
    else {
        $self->{$directive}{$key} = $val;
    }
    return;
}

=head1 SEE ALSO

L<Apache2::Controller>

L<Apache2::Controller::Methods/get_directive>

L<Apache2::Controller::Session>

L<Apache2::Module>

=head1 AUTHOR

Mark Hedges, C<hedges +(a t)- scriptdolphin.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2008 Mark Hedges.  CPAN: markle

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

This software is provided as-is, with no warranty 
and no guarantee of fitness
for any particular purpose.

=cut

1;