view release on metacpan or  search on metacpan

lib/Lemonldap/NG/Manager/Conf/Parser.pm  view on Meta::CPAN

#
# It returns a boolean. Errors, warnings and changes are stored as array
# containing `{ message => 'Explanation' }. A main message is stored in
# `message` property.

use strict;
use utf8;
use Crypt::URandom;
use Mouse;
use JSON 'to_json';
use Lemonldap::NG::Common::Conf::ReConstants;
use Lemonldap::NG::Manager::Attributes;

our $VERSION = '2.22.0';

extends 'Lemonldap::NG::Common::Conf::Compact';

# High debugging for developers, set this to 1
use constant HIGHDEBUG => 0;

# Messages storage
has errors => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { return [] }
);
has warnings => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { return [] },
    trigger => sub {
        hdebug( 'warnings contains', $_[0]->{warnings} );
    }
);
has changes => ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
has message => (
    is      => 'rw',
    isa     => 'Str',
    lazy    => 1,
    default => sub {
        return join( ', ', map { $_->{message} } @{ $_[0]->errors } );
    },
    trigger => sub {
        hdebug( "Message becomes " . $_[0]->{message} );
    }
);
has needConfirmation =>
  ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );

# Booleans
has confChanged => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
    trigger => sub {
        hdebug( "condChanged: " . $_[0]->{confChanged} );
    }
);

# Properties required during build
has refConf => ( is => 'ro', isa      => 'HashRef', required => 1 );
has req     => ( is => 'ro', required => 1 );
has newConf => ( is => 'rw', isa      => 'HashRef' );
has tree    => ( is => 'rw', isa      => 'ArrayRef' );

# High debug method
sub hdebug {
    if (HIGHDEBUG) {
        foreach my $d (@_) {
            if ( ref $d ) {
                require Data::Dumper;
                $Data::Dumper::Useperl = 1;
                print STDERR Data::Dumper::Dumper($d);
            }
            else { print STDERR "$d\n" }
        }
    }
    undef;
}

##@method boolean check()
# Main method
#@return result
sub check {
    my ( $self, $localConf ) = @_;

    hdebug("# check()");
    unless ( $self->newConf ) {
        return 0 unless ( $self->scanTree );
    }
    unless ( $self->testNewConf($localConf) ) {
        hdebug("  testNewConf() failed");
        return 0;
    }
    my $separator = $self->newConf->{multiValuesSeparator} || '; ';
    hdebug("  tests succeed");
    my %conf          = %{ $self->newConf };
    my %compactedConf = %{ $self->compactConf( $self->newConf ) };
    my @removedKeys   = ();
    unless ( $self->confChanged ) {
        hdebug("  no change detected");
        $self->message('__confNotChanged__');
        return 0;
    }

    # Return removed keys if conf compacted
    @removedKeys = map { exists $compactedConf{$_} ? () : $_ } sort keys %conf
      if ( $self->newConf->{compactConf} );
    push @{ $self->changes },
      (
        $self->{newConf}->{compactConf}
        ? {
            confCompacted => '1',
            removedKeys   => join( $separator, @removedKeys )
          }
        : { confCompacted => '0' }
      );

    return 1;
}