source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Netzone.pm @ 2569

package LATMOS::Accounts::Bases::Sql::Netzone;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Sql::objects);
use LATMOS::Accounts::I18N;

our $VERSION = (q$Rev: 2104 $ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Accounts::Bases::Sql::Netzone - Network management

=head1 DESCRIPTION

The C<Netzone> object handle information for dns or dhcp management.

=cut

sub _object_table { 'netzone' }

sub _key_field { 'name' }

sub _has_extended_attributes { 1 }

sub _get_attr_schema {
    my ($class, $base) = @_;

    $class->SUPER::_get_attr_schema($base,
        {
            name    => { ro => 1, inline => 1, },
            cn      => { ro => 1, inline => 1, iname => 'name' },
            date    => { ro => 1, inline => 1, },
            create  => { ro => 1, inline => 1, },
            net     => { multiple => 1, monitored => 1, },
            netExclude => { multiple => 1, monitored => 1, },
            group   => { hide => 1 },
            allow_dyn => {
                formtype => 'CHECKBOX',
                ro => sub { 
                    $_[0] && ($_[0]->get_attributes('type') || '') =~ /dhcp|radius/ ? 0 : 1
                },
            },
            output => {},
            outputD => {
                hide => 1,
                ro => 1,
                managed => 1,
                get => sub {
                    $_[0]->object->_get_c_field('output') ||
                    ($_[0]->object->id . (($_[0]->object->get_attributes('type') || '') eq 'puppet' ? '.pp' : ''))
                },
            },
            template => {},
            templateD => {
                hide => 1,
                ro => 1,
                managed => 1,
                get => sub {
                    $_[0]->object->_get_c_field('template') ||
                    $_[0]->object->id . '.in'
                },
            },
            type    => {
                mandatory => 1,
                can_values => sub { qw(dhcp dns reverse puppet radius) },
            },
            site   => {
                delayed => 1,
                reference => 'site',
            },
            dynFrom   => {
                delayed => 1,
                multiple => 1,
                reference => 'netzone',
                ro => sub { 
                    $_[0] && ($_[0]->get_attributes('type') || '') =~ /^(dhcp|radius)$/ ? 0 : 1
                },
            },
            freeIP => {
                managed => 1,
                ro => 1,
                multiple => 1,
                get => sub {
                    my $self = $_[0]->object;
                    my @ips;
                    my $findip = $self->base->db->prepare(q{
                        select * from (
                        select host(network(value::inet)+ (generate_series(1, broadcast(value::inet) - network(value::inet) -1))) from netzone_attributes where
                        attr='net' and okey = $1 and family(value::inet) = 4
                        except
                        (
                        select host(network(value::inet)+ (generate_series(0, broadcast(value::inet) - network(value::inet)))) from
                        netzone_attributes where attr='netExclude' and okey = $1 and family(netzone_attributes.value::inet) = 4
                        union
                        select nethost_attributes_ips.value from nethost_attributes_ips join netzone_attributes on
                        netzone_attributes.attr='net' and nethost_attributes_ips.value::inet <<= netzone_attributes.value::inet
                        where netzone_attributes.okey = $1 and family(netzone_attributes.value::inet) = 4
                        )
                        ) as s
                        order by host::inet
                        });
                    $findip->execute($self->get_attributes('ikey'));
                    while (my $res = $findip->fetchrow_hashref) {
                        push(@ips, $res->{host});
                    }
                    return scalar(@ips) ? \@ips : undef;
                },
            },
            freeIPCount => {
                managed => 1,
                ro => 1,
                get => sub {
                    return scalar(grep { $_ } $_[0]->object->get_attributes('freeIP'));
                },
            },
            ipCount => {
                managed => 1,
                ro => 1,
                get => sub {
                    my ($self) = $_[0]->object;
                    my $findip = $self->base->db->prepare(q{
                        select count(*) from (
                        select host(network(value::inet)+ (generate_series(1, broadcast(value::inet) - network(value::inet) -1))) from netzone_attributes where
                        attr='net' and okey = $1 and family(value::inet) = 4
                        except
                        (
                        select host(network(value::inet)+ (generate_series(0, broadcast(value::inet) - network(value::inet)))) from
                        netzone_attributes where attr='netExclude' and okey = $1 and family(netzone_attributes.value::inet) = 4
                        )
                        ) as s
                        });
                    $findip->execute($self->get_attributes('ikey'));
                    my $res = $findip->fetchrow_hashref;
                    $findip->finish;
                    return $res->{count}
                },
            },
            hosts =>  {
                ro => 1,
                multiple => 1,
                managed => 1,
                reference => 'nethost',
                get => sub {
                    my ($self) = $_[0]->object;
                    my $findhost = $self->base->db->prepare_cached(q{
                        select name from nethost join nethost_attributes_ips on
                        nethost.ikey = nethost_attributes_ips.okey
                        where value::inet <<= any(?)
                        } . ($self->base->{wexported} ? '' : 'and exported = true') .
                        q{ except
                        select name from nethost join nethost_attributes_ips on
                        nethost.ikey = nethost_attributes_ips.okey
                        where value::inet <<= any(?)
                        order by name
                        }
                    );
                    $findhost->execute(
                        [ $self->get_attributes('net') ],
                        [ $self->get_attributes('netExclude') ],
                    );
                    my @hosts;
                    while (my $res = $findhost->fetchrow_hashref) {
                        push(@hosts, $res->{name});
                    }
                    return scalar(@hosts) ? \@hosts : undef;
                },
            },
            hostsExclude =>  {
                ro => 1,
                multiple => 1,
                managed => 1,
                reference => 'nethost',
                get => sub {
                    my $self = $_[0]->object;
                    my $findhost = $self->base->db->prepare_cached(q{
                        select name from nethost join nethost_attributes_ips on
                        nethost.ikey = nethost_attributes_ips.okey
                        where value::inet <<= any(?)
                        } . ($self->base->{wexported} ? '' : 'and exported = true') .
                        q{
                        order by name
                        }
                    );
                    $findhost->execute(
                        [ $self->get_attributes('netExclude') ],
                    );
                    my @hosts;
                    while (my $res = $findhost->fetchrow_hashref) {
                        push(@hosts, $res->{name});
                    }
                    return scalar(@hosts) ? \@hosts : undef;
                },
            },
            lastBuild => { hide => 1, },
            lastUpdate => { ro => 1, iname => 'lastBuild' },
            zoneRevision => { hide => 1, },
            dnsRevision =>  { ro => 1, iname => 'zoneRevision' },
            exported => { formtype => 'CHECKBOX', },
            puppetClass =>  { multiple => 1, },
            domain => { },
            description => { },
            hostParams => { multiple => 1 }, 
            radiusParams => { iname => 'hostParams', ro => 1 },
            vlan => { },
        }
    )
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts::Bases::Sql>
L<LATMOS::Accounts::Bases::Sql::Nethost>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut