source: trunk/LATMOS-Accounts-Web/lib/LATMOS/Accounts/Web/Model/Accounts.pm @ 1738

package LATMOS::Accounts::Web::Model::Accounts;

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../../LATMOS-Accounts/lib";
use base 'Catalyst::Model';
use base 'LATMOS::Accounts';
use LATMOS::Accounts::Log;

la_set_log(
    syslog => [],
    console => LA_WARNING,
);

=head1 NAME

LATMOS::Accounts::Web::Model::Accounts - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=cut

=head1 FUNCTIONS

=cut

sub new {
    my ($class) = @_;
    bless(LATMOS::Accounts
        ->new(LATMOS::Accounts::Web->config->{config}),
        $class);
}

sub ACCEPT_CONTEXT {
    my ($self, $c, $form, $object, $base) = @_;
    $self->{c} = $c;
    $self;
}

sub accounts {
    my ($self) = @_;
    $self;
}

sub db {
    my ($self) = @_;
    $self->{_default_base} and return $self->{_default_base};
    $self->{_default_base} = $self->base;
    $self->{_default_base}->load or return;
    $self->{_default_base}->wexported(1);
    $self->{_default_base}
}

=head2 obj_to_label($ref)

Return a proper label to display for each object

=cut

sub obj_to_label {
    my ($self, $ref) = @_;
    my $uri_part = {
        user => 'Utilisateurs',
        group => 'Groupes',
        nethost => 'HÎtes réseaux',
        netzone => 'Zones réseau',
        site => 'Sites',
        aliases => 'Alias',
        service => 'Services',
    }->{$ref};
}

sub obj_to_uri {
    my ($self, $ref, $id) = @_;
    my $uri_part = {
        user => 'users',
        group => 'groups',
        nethost => 'nethosts',
        netzone => 'netzones',
        site => 'sites',
        aliases => 'aliases',
        service => 'services',
    }->{$ref} || $ref;

    return $self->{c}->uri_for('/', $uri_part, ($id ? $id : ()));
}

sub object_prev_next {
    my ($self, $otype, $id) = @_;

    my @list = $self->db->list_objects($otype);
    my $prev;
    while (@list && ($list[0] || '') ne $id) {
        $prev = shift(@list);
    }
    return([ $prev, $list[1] ]);
}

sub object_navigate {
    my ($self, $otype, $id, @filter) = @_;

    my @list = $self->db->search_objects($otype, @filter);

    my $i = 0;
    for($i = 0; $i <= $#list; $i++) {
        $list[$i] eq $id and last;
    }

    my %ptr = ();
    $ptr{oprev} = $list[$i-1] if ($i > 0);
    $ptr{'onext'} = $list[$i+1] if ($i < $#list);
    $ptr{ofirst} = $list[0] if ($i > 1);
    $ptr{'olast'} = $list[$#list] if ($i < $#list -1);
    $ptr{list} = \@list;

    return \%ptr;
}

# Such function must not be here, but in LATMOS::Accounts
# But code does not allow this at time
sub list_unowned_aliases {
    my ($self, $filter) = @_;
    my $db = $self->db;
    my $sth = $db->db->prepare_cached(q{
        select name, forward from aliases where
        name not in (select name from "user")
            and
        forward not in (select array[name] from "user")
    } . 
    ($filter 
        ? q{
            and (lower(name) ILIKE $1 or
            lower(array_to_string(forward, ',')) ILIKE $1)
          }
        : '')
    );

    $sth->execute($filter ? ('%' . $filter . '%') : ());
    my %aliases;
    while (my $res = $sth->fetchrow_hashref) {
        $aliases{$res->{name}} = $res->{forward};
    }
    return \%aliases
}

sub sync_access {
    my ($self) = @_;
    $self->SUPER::sync_access
}

sub sync {
    my ($self) = @_;
    $self->default_synchro()
}

=head1 AUTHOR

Thauvin Olivier

=head1 LICENSE

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

=cut

1;