view release on metacpan or  search on metacpan

lib/Ansible.pm  view on Meta::CPAN

    return $a eq $b;
}

sub set {
    my $self = shift;
    my $new = pop;
    my (@designators) = @_;
    #my ($self, $designator, $new) = @_;
    print STDERR "\nSET\n" if $debug_set;
    return undef unless $self;
    my $old;
    #my @designators;
    print STDERR "\nSELF $self->{$debg}" if $debug_set;
    # move into the block if possible
    $self = $self->subs
        if $self->subs;
    print STDERR "\nSELF $self->{$debg}" if $debug_set;
    #if (ref $designator eq 'ARRAY') {
    #	@designators = @$designator;
    #	$old = $self->get(@designators);
    #	$designator = pop(@designators);
    #} elsif ($designator) {
    #	$old = $self->get($designator);
    #} else {
    #	$old = $self;
    #}
    my $designator;
    if ( @designators ) {
        $old = $self->get(@designators);
        $designator = pop(@designators);
    }
    else {
        $old = $self;
    }
    print STDERR "\nOLD $old->{$debg}" if $debug_set;
    my (@lines) = expand(grep (/./, split(/\n/, $new)));
    if ( $lines[0] =~ /^(\s+)/ ) {
        my $ls = $1;
        my $m = 1;
        map { substr($_, 0, length($ls)) eq $ls or $m = 0 } @lines;
        map { substr($_, 0, length($ls)) = '' } @lines
            if $m;
    }
    my $indent = (' ' x $self->contextcount(@designators));
    for $_ ( @lines ) {
        s/(\S)\s+/$1 /g;
        s/\s+$//;
        $_ = 'exit' if /^\s*!\s*$/;
        $_ = "$indent$_";
    }
    print STDERR "SET TO {\n@lines\n}\n" if $debug_set;
    my $desig = shift(@lines);
    my @o;
    undef $old
        if ! $old;
    if ( ! $old ) {
        print STDERR "NO OLD\n" if $debug_set;
        push(@o, openangle($self->setcontext(@designators)));
        push(@o, $desig);
    }
    elsif ( ! $designator && ! looks_like_a_block($desig, @lines) ) {
        if ( $self->block && $self->context ) {
            unshift(@lines, $desig);
            $old = $self->context;
            undef $desig;
        }
        else {
            unshift(@lines, $desig);
            print STDERR "IN NASTY BIT\n" if $debug_set;
            #
            # this is a messy situation: we've got a random
            # block of stuff to set inside a random block.
            # In theorey we could avoid the die, I'll leave
            # that as an exercise for the reader.
            #
            confess "You cannot set nested configurations with set(undef, \$config) -- use a designator on the set method"
                if grep (/^$indent\s/, @lines);
            my (@t) = split(/\n/, $self->text);
            my (%t);
            @t{strim(@t)} = @t;
            while ( @lines ) {
                my $l = strim(shift(@lines));
                if ( $t{$l} ) {
                    delete $t{$l};
                }
                else {
                    push(@o, "$indent$l");
                }
            }
            for my $k ( keys %t ) {
                unshift(@o, iinvert($indent, $k));
            }
            unshift(@o, $self->setcontext)
                if @o;
        }
    }
    elsif ( $old->teql($desig) ) {
        print STDERR "DESIGNATOR EQUAL\n" if $debug_set;
        # okay
    }
    else {
        print STDERR "DESIGNATOR DIFERENT\n" if $debug_set;
        push(@o, openangle($self->setcontext(@designators)));
        if ( defined $designator ) {
            push(@o, iinvert($indent, $designator));
        }
        else {
            push(@o, iinvert($indent, split(/\n/, $self->text)));
        }
        push(@o, $desig);
    }
    if ( @lines ) {
        if ( $old && ! @o && $old->subs && $old->subs->next ) {
            print STDERR "OLD= $old->{$debg}" if $debug_set;
            my $ok = 1;
            my $f = $old->subs->next;
            print STDERR "F= $f->{$debg}" if $debug_set;
            for my $l ( @lines ) {
                next if $l =~ /^\s*exit\s*$/;
                next if $f->teql($l);
                print STDERR "LINE DIFF ON $l\n" if $debug_set;
                $ok = 0;
                last;
            }
            continue {
                $f = $f->next;
                print STDERR "F= $f->{$debg}" if $debug_set;
            }
            if ( ! $ok || $f ) {
                push(@o, openangle($self->setcontext(@designators)));
                push(@o, iinvert($indent, $designator));
                push(@o, $desig);
            }
        }
        push(@o, @lines) if @o;
    }
    @o = grep (defined, @o);
    push(@o, closeangle($self->unsetcontext(@designators)))
        if @o;
    return join('', returns(@o)) unless wantarray;
    return returns(@o);
}

sub looks_like_a_block {
    my ($first, @l) = @_;
    my $last = pop(@l);
    return 1 if ! defined $last;
    return 0 if grep (/^\S/, @l);
    return 0 if $first =~ /^\s/;
    return 0 if $last =~ /^\s/;
    return 1;
}

sub iinvert {
    my ($indent, @l) = @_;
    confess unless @l;
    for $_ ( @l ) {
        next unless defined;
        s/^\s*no /$indent/ or s/^\s*(\S)/${indent}no $1/
    }
    return $l[0] unless wantarray;
    return @l;
}

sub all {
    my ($self, $regex) = @_;
    $self = $self->zoom;
    return(map { $self->{$_} } $self->sortit(grep (/$regex/ && ! /$spec/o, keys %$self)))
        if $regex;
    return(map { $self->{$_} } $self->sortit(grep (! /$spec/o, keys %$self)));
}

sub get {
    my ($self, @designators) = @_;
    return $self->mget(@designators)
        if wantarray && @designators > 1;

    print STDERR "\nGET <@designators> $self->{$debg}" if $debug_get;

    return $self unless $self;
    my $zoom = $self->zoom->subs;
    $self = $zoom if $zoom;

    print STDERR "\nZOOMSUB $self->{$debg}" if $debug_get;

    while ( @designators ) {
        my $designator = shift(@designators);
        #		$self = $self->zoom;
        #	$self = $self->single || $self;
        print STDERR "\nDESIGNATOR: $designator.  ZOOMED: $self->{$debg}\n"
            if $debug_get;
        for my $d ( split(' ', $designator) ) {
            print STDERR "\nDO WE HAVE A: $d?\n" if $debug_get;
            return $undef unless $self->{$d};
            $self = $self->{$d};
            print STDERR "\nWE DO: $self->{$debg}\n" if $debug_get;
        }
        last unless @designators;
        if ( $self->single ) {
            $self = $self->subs;
            print STDERR "\nSINGLETON: $self->{$debg}\n" if $debug_get;
        }
        else {
            print STDERR "\nNOT SINGLE\n" if $debug_get;