Skip to content
Snippets Groups Projects
WebRequest.pm 24.15 KiB
package AccountManager::WebRequest;

use strict;
use warnings;

use CGI;
use DateTime;
use English qw(-no_match_vars);
use HTTP::AcceptLanguage;
use Template;
use Log::Any::Adapter;
use List::MoreUtils qw(uniq);
use Text::CSV;

use AccountManager::Account;
use AccountManager::Account::Manager;
use AccountManager::Metadata;
use AccountManager::Service;
use AccountManager::Token;
use AccountManager::Tools;

## Defining parameters format
my $urn_or_url_regex = '(http(s?):\/\/|urn:)[^\\\$\*\"\'\`\^\|\<\>\n\s]+'
  ;    ## Format de type URL HTTP ou URN
my $url_regex     = 'http(s?):\/\/[^\\\$\*\"\'\`\^\|\<\>\n\s]+';
my $email_regex   = '([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\w\-]+(\.[\w\-]+)+';
my $domains_regex = '[\w\.\-]+(,[\w\.\-]+)*';
my %format        = (
    ## URL
    #'attributeauthority' => $url_regex,
    'entityid' => $urn_or_url_regex,
);

my %actions = (
    home               => 'req_home',
    select_sp          => 'req_select_sp',
    select_email       => 'req_select_email',
    complete_challenge => 'req_complete_challenge',
    create_accounts    => 'req_create_accounts',
    download_accounts  => 'req_download_accounts',
);

## New web request
sub new {
    my ($pkg, %args) = @_;

    my $self = {
        configuration => $args{configuration},
    };

    Log::Any::Adapter->set(
        'File',
        $self->{configuration}->{log}->{file},
        log_level => $self->{configuration}->{log}->{level}
    );

    $self->{logger} = Log::Any->get_logger();

    AccountManager::DB->register_db(
        driver          => $self->{configuration}->{database}->{type},
        database        => $self->{configuration}->{database}->{name},
        host            => $self->{configuration}->{database}->{host},
        password        => $self->{configuration}->{database}->{password},
        username        => $self->{configuration}->{database}->{user}
    );

    $self->{db} = AccountManager::DB->new();
    $self->{cgi} = CGI->new();

    bless $self, $pkg;