package XorpConfigParser; use lib "/opt/vyatta/share/perl5/"; use strict; my %data; my %fields = ( _data => \%data ); sub new { my $that = shift; my $class = ref ($that) || $that; my $self = { %fields, }; bless $self, $class; return $self; } sub copy_node { my ($self, $from, $to, $name) = @_; if (!defined($from) || !defined($to) || !defined($name)) { return; } foreach my $node (@$from) { my $stringNodeNameHere = $node->{'name'}; if ($stringNodeNameHere =~ /^$name.*/) { foreach my $nodeCheck (@$to) { my $stringCheck = $nodeCheck->{'name'}; if ($name eq $stringCheck) { $nodeCheck->{'value'} = $node->{'value'}; $nodeCheck->{'children'} = $node->{'children'}; $nodeCheck->{'comment'} = $node->{'comment'}; return; } } push(@$to, $node); } } } sub copy_multis { my ($self, $nodes, $name) = @_; if (!defined($nodes) || !defined($name)) { return undef; } my @multis; foreach my $node (@$nodes) { my $stringNodeNameHere = $node->{'name'}; if ($stringNodeNameHere =~ /$name\s(\S+)/) { my $stringNameHere = $1; my %multi = ( 'name' => $stringNameHere, 'comment' => $node->{'comment'}, 'value' => $node->{'value'}, 'children' => $node->{'children'} ); push(@multis, \%multi); } } return @multis; } sub comment_out_child { my ($self, $children, $name, $comment) = @_; if (!defined($children) || !defined($name)) { return; } for (my $i = 0; $i < @$children; $i++) { my $stringNodeNameHere = @$children[$i]->{'name'}; if ($name eq $stringNodeNameHere) { @$children[$i]->{'comment_out'} = "1"; if (defined($comment)) { @$children[$i]->{'comment_out'} = $comment; } } } } sub create_node { my ($self, $path) = @_; my $hash = \%data; foreach my $segment (@$path) { my $children = $hash->{'children'}; if (!defined($children)) { my @new_children; $hash->{'children'} = \@new_children; $children = \@new_children; } my $child_found = 0; foreach my $child (@$children) { if ($child->{'name'} eq $segment) { $child_found = 1; $hash = $child; last; } } if ($child_found == 0) { my %new_hash = ( 'name' => $segment ); push(@$children, \%new_hash); $hash = \%new_hash; } } return $hash; } sub delete_child { my ($self, $children, $name) = @_; if (!defined($children) || !defined($name)) { return; } for (my $i = 0; $i < @$children; $i++) { my $stringNodeNameHere = @$children[$i]->{'name'}; if ($name eq $stringNodeNameHere) { @$children[$i] = undef; } } } sub find_child { my ($self, $children, $name) = @_; if (!defined($children) || !defined($name)) { return undef; } foreach my $child (@$children) { my $stringNodeNameHere = $child->{'name'}; if ($name eq $stringNodeNameHere) { return $child; } } return undef; } sub get_node { my ($self, $path) = @_; my $hash = $self->{_data}; foreach my $segment (@$path) { my $children = $hash->{'children'}; if (!defined($children)) { return undef; } my $child_found = 0; foreach my $child (@$children) { if ($child->{'name'} eq $segment) { $child_found = 1; $hash = $child; last; } } if ($child_found == 0) { return undef; } } return $hash; } sub push_comment { my ($self, $path, $comment) = @_; my $hash = \%data; foreach my $segment (@$path) { my $children = $hash->{'children'}; if (!defined($children)) { my @children; $hash->{'children'} = \@children; $children = \@children; } my $child_found = 0; foreach my $child (@$children) { if ($child->{'name'} eq $segment) { $child_found = 1; $hash = $child; last; } } if ($child_found == 0) { my %new_hash = ( 'name' => $segment ); push(@$children, \%new_hash); $hash = \%new_hash; } } my %new_comment = ( 'comment' => $comment ); my $childrenPush = $hash->{'children'}; if (!defined($childrenPush)) { my @new_children; $hash->{'children'} = \@new_children; $childrenPush = \@new_children; } push(@$childrenPush, \%new_comment); } sub set_value { my ($self, $path, $value) = @_; my $hash = $self->create_node($path); if (defined($hash)) { $hash->{'value'} = $value; } } sub output { my ($self, $depth, $hash) = @_; if (!defined($hash)) { $hash = $self->{_data}; } if ($hash->{'comment'} ne '') { print '/*' . $hash->{'comment'} . "*/\n"; } my $children = $hash->{'children'}; foreach my $child (@$children) { if (defined($child)) { if (defined($child->{'comment_out'})) { print "\n"; if ($child->{'comment_out'} ne "1") { print "/* --- $child->{'comment_out'} --- */\n"; } print "/* --- CONFIGURATION COMMENTED OUT DURING MIGRATION BELOW ---\n"; } print " " x $depth; if ($child->{'value'} ne '') { print "$child->{'name'}: $child->{'value'}"; print "\n"; } else { my $print_brackets = 0; my $children = $child->{'children'}; if (defined($children) && @$children > 0) { $print_brackets = 1; } elsif ($child->{'name'} ne '' && !($child->{'name'} =~ /\s/)) { $print_brackets = 1; } if ($child->{'name'} ne '') { print "$child->{'name'}"; if ($print_brackets) { print " {"; } print "\n"; } $self->output($depth+1, $child); if ($print_brackets) { print " " x $depth; print "}\n"; } } if (defined($child->{'comment_out'})) { print " --- CONFIGURATION COMMENTED OUT DURING MIGRATION ABOVE --- */\n\n"; } } } } sub parse { my ($self, $file) = @_; open(INPUT, "< $file") or die "Error! Unable to open file \"$file\". $!"; my $contents = ""; while () {$contents .= $_} close INPUT; my @array_contents = split('', $contents); # print scalar(@array_contents) . "\n"; my $length_contents = @array_contents; my $colon = 0; my $colon_quote = 0; my $name = ''; my $value = undef; my @path; my %tree; for (my $i = 0; $i < $length_contents;) { my $c = $array_contents[$i]; my $cNext = $array_contents[$i+1]; if ($c eq '/' && $cNext eq '*') { my $comment_text = ''; my $comment_end = index($contents, '*/', $i+2); if ($comment_end == -1) { $comment_text = substr($contents, $i+2); } else { $comment_text = substr($contents, $i+2, $comment_end - $i - 2); $i = $comment_end + 2; } # print 'Comment is: "' . $comment_text . "\"\n"; $self->push_comment(\@path, $comment_text); } elsif ($colon == 0 && ($c eq '{' || $c eq ':' || $c eq "\n")) { $name =~ s/^\s+|\s$//g; if (length($name) > 0) { push(@path, $name); # print "Path is: \"@path\" Name is: \"$name\"\n"; $self->set_value(\@path, $value); $name = ''; if ($c eq "\n") { pop(@path); } if ($c eq ':') { $colon = 1; } } $i++; } elsif ($c eq '}') { pop(@path); $name = ''; $i++; } elsif ($c eq ';') { $i++; } elsif ($colon == 1) { my $value_end = 0; if ($c eq '"') { $value .= $c; if ($colon_quote == 1) { $value_end = 1; } else { $colon_quote = 1; } } elsif ($c eq '\\' && $cNext eq '"') { $value .= '\\"'; $i++; } else { if ((length($value) > 0) || (!($c =~ /\s/))) { $value .= $c; } } if ($colon_quote == 0 && ($cNext eq '}' || $cNext eq ';' || $cNext =~ /\s/)) { $value_end = 1; } $i++; if ($value_end == 1) { if (length($value) > 0) { # print "Path is: \"@path\" Value is: $value\n"; $self->set_value(\@path, $value); $value = undef; } pop(@path); $colon_quote = 0; $colon = 0; } } else { $name .= $c; $i++; } } }