Cisco-Reconfig

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

 - Fixed a warning when the last config file line was
   indented.  (found by Martin Lorensen <martin at lorensen.dk>)

0.4 2003/05/27

 - Oops, forgot to document the new string-based construtor
   (from Martin Lorensen <martin at lorensen.dk>)

0.3 2003/05/26

 - Replaced destroy() with Scalar::Util::weaken at the suggestion and
   with the much assistance of Martin Lorensen <martin at lorensen.dk>.
   Thank you Martin!
 - ->destroy() is now deprecated.
 - Also Bugfix to get() from Martin Lorensen.
 - Added a special case for banners to fix a bug pointed out by
   Mike Drons <mdrons at ins.com>.

0.2 2003/01/27

 - A small problem with IO::File possibly resolved.

lib/Cisco/Reconfig.pm  view on Meta::CPAN

@EXPORT_OK = qw(readconfig stringconfig $minus_one_indent_rx);

$VERSION = '0.912';

require Exporter;
use strict;
use Text::Tabs;
use Carp;
use Carp qw(verbose confess);
use IO::File;
use Scalar::Util qw(weaken);
my $iostrings;
our $allow_minus_one_indent = qr/class /;
our $allow_plus_one_indent = qr/service-policy |quit$/;
our $bad_indent_policy = 'DIE';


BEGIN	{
	eval " use IO::String ";
	$iostrings = $@ ? 0 : 1;
}

lib/Cisco/Reconfig.pm  view on Meta::CPAN

sub rc1
{
	my ($indent, $seq, $parent, $dcon) = @_;
	my $last;
	my $config = bless { $bloc => 1 }, __PACKAGE__;

	$config->{$debg} = "BLOCK:$dseq:$dcon" if $ddata;

	$config->{$cntx} = $parent;
	weaken $config->{$cntx};

	$dseq++;
	my $prev;
	my $ciscobug;
	for(;$line;$prev = $line, $line = <$fh>) {
		$_ = $line;
		s/^( *)//;
		my $in = length($1);
		s/^(no +)//;
		my $no = $1;

lib/Cisco/Reconfig.pm  view on Meta::CPAN

					    $word => $x, ) 
					: (),
			}, __PACKAGE__;
			$dseq++;
		}
		$context->{$seqn} = $seq++;
		$context->{$text} = $line;
		confess if $context->{$cntx};

		$context->{$cntx} = $config;
		weaken $context->{$cntx};

		unless ($nonext) {
			if ($last) {
				$last->{$next} = $context;
				weaken $last->{$next};
			} else {
				$config->{$next} = $context;
				weaken $config->{$next};
			}
		}

		$last = $context;

		if ($line && 
			($line =~ /(\^C)/ && $line !~ /\^C.*\^C/)
			|| 
			($line =~ /banner [a-z\-]+ ((?!\^C).+)/))
		{
			#
			# big special case for banners 'cause they don't follow
			# normal indenting rules
			#
			die unless defined $1;
			my $sep = qr/\Q$1\E/;
			my $sub = $last->{$subs} = bless { $bloc => 1 }, __PACKAGE__;
			$sub->{$cntx} = $last;
			weaken $sub->{$cntx};
			my $subnull = $sub->{''} = bless { $bloc => 1, $dupl => [] }, __PACKAGE__;
			$subnull->{$cntx} = $sub;
			weaken $subnull->{$cntx};
			for(;;) {
				$line = <$fh>;
				last unless $line;
				my $l = bless { 
					$ddata ? ( $debg => "$dseq:DUP:$line" ) : (),
				}, __PACKAGE__;
				$dseq++;
				$l->{$seqn} = $seq++;
				$l->{$text} = $line;
				$l->{$cntx} = $subnull;
				weaken($l->{$cntx});
				push(@{$subnull->{$dupl}}, $l);
				last if $line =~ /$sep[\r]?$/;
			} 
			warn "parse probably failed"
				unless $line && $line =~ /$sep[\r]?$/;
		}
	}
	return $config;
}

t/banner.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

use strict;

my $debugdump = 0;

if ($debugdump) {
	$Cisco::Reconfig::nonext = 1;
}

BEGIN { plan test => 6 };

t/banner2.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

use strict;

my $debugdump = 0;

if ($debugdump) {
	$Cisco::Reconfig::nonext = 1;
}

BEGIN { plan test => 6 };

t/cisco.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

use strict;

my $debugdump = 0;

#if ($debugdump) {
#	$Cisco::Reconfig::nonext = 1;
#}

BEGIN { plan test => 45 };

t/classmap-12-4.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

#
# The configuration file in this test is buggy.  It's a Cisco
# bug so we'll try to work around it.
#

use Cisco::Reconfig;
use Test::More qw(no_plan);
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $debugdump = 0;

my $config = readconfig(\*DATA);

my $finished;

END { ok($finished, "finished") }

if ($debugdump) {

t/indentbug.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

#
# The configuration file in this test is buggy.  It's a Cisco
# bug so we'll try to work around it.
#

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $debugdump = 0;

BEGIN { plan test => 6 };

sub wok
{
	my ($a, $b) = @_;
	require File::Slurp;
	import File::Slurp;

t/intzoom.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $debugdump = 0;

if ($debugdump) {
	$Cisco::Reconfig::nonext = 1;
}

BEGIN { plan test => 2 };

sub wok

t/smalltest.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $debugdump = 0;

if ($debugdump) {
	$Cisco::Reconfig::nonext = 1;
}

BEGIN { plan test => 2 };

sub wok

t/stringconfig.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig qw(stringconfig);
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $iostringmissing;
BEGIN	{
	eval " use IO::String ";
	$iostringmissing = $@ ? 1 : 0;
}


my $debugdump = 0;

t/trailingindent.t  view on Meta::CPAN

#!/usr/bin/perl -I. -w

use Cisco::Reconfig;
use Test;
use Carp qw(verbose);
use Scalar::Util qw(weaken);

my $debugdump = 0;

if ($debugdump) {
	$Cisco::Reconfig::nonext = 1;
}

BEGIN { plan test => 2 };

sub wok

t/weak_ref_to_obj.t  view on Meta::CPAN

#!/usr/bin/perl -w

use Test::More qw(no_plan);
use Scalar::Util qw(weaken isweak);
use warnings;
use strict;

my $a;
my $b = \$a;

ok(! isweak($b), "b not weak");
weaken($b);
ok(isweak($b), "b weak");

my $x = { y => [ 0, 1, 2], z => \$a, w => { a => 7 } };

my $strong = { %$x };

ok(! isweak($x->{z}), "z not weak");
weaken($x->{z});
ok(isweak($x->{z}), "z weak");

ok(! isweak($x->{y}), "y not weak");
weaken($x->{y});
ok(isweak($x->{y}), "y weak");

ok(! isweak($x->{w}), "w not weak");
weaken($x->{w});
ok(isweak($x->{w}), "w weak");

my $copy = $x;

ok(isweak($copy->{z}), "copy z weak");
ok(isweak($copy->{w}), "copy w weak");
ok(isweak($copy->{y}), "copy y weak");

undef $strong;