/usr/local/CPAN/Net-Appliance-Frontpanel/Net/Appliance/Frontpanel/CacheBuilderRole.pm
package Net::Appliance::Frontpanel::CacheBuilderRole;
use Moose::Role;
with 'Net::Appliance::Frontpanel::Helper::Logger';
use XML::LibXML;
use XML::LibXSLT;
use File::Temp;
has 'xslt_parser' => (
is => 'ro',
isa => 'XML::LibXSLT',
default => sub { XML::LibXSLT->new() },
lazy => 1,
);
has 'xml_parser' => (
is => 'ro',
isa => 'XML::LibXML',
default => sub { XML::LibXML->new() },
lazy => 1,
);
has 'hardware_classes' => (
is => 'ro',
isa => 'XML::LibXML::Element',
lazy_build => 1,
);
sub _build_hardware_classes {
my $self = shift;
my $parser = $self->xml_parser;
my $classes = XML::LibXML::Element->new('classes');
my $p = $parser->parse_file( $self->config->xml_loc('port.xml') );
$classes->appendChild( $_ ) for $p->findnodes('//port-image');
my $m = $parser->parse_file( $self->config->xml_loc('module.xml') );
$classes->appendChild( $_ ) for $m->findnodes('//module');
my $c = $parser->parse_file( $self->config->xml_loc('chassis.xml') );
$classes->appendChild( $_ ) for $c->findnodes('//chassis');
return $classes;
}
sub transform_and_write_out {
my ($self, %args) = @_;
my $stylesheet = $self->xslt_parser->parse_stylesheet_file($args{xslt});
my $results = $stylesheet->transform( $self->xml_parser->parse_file($args{xml}) );
$stylesheet->output_file($results, $args{out});
}
# munge the name - should be in SNMP::Info ?
# this is Cisco-specific.
sub munge_port_name {
my ($self, $name) = @_;
if ($name =~ m{^(?:Te|Gi|Fa)\D*(\d+/\d+(?:/\d+)?)}) {
my $num = $1;
$name = ( $name =~ m/^Fa/ ? "FastEthernet$num" :
$name =~ m/^Gi/ ? "GigabitEthernet$num" :
$name =~ m/^Te/ ? "TenGigabitEthernet$num" : $name );
}
return $name;
}
sub build_tree {
my ($self, $id, $tree, $seen, %modules) = @_;
++$seen->{$id};
my $mod = $modules{$id}{module};
return if $mod->{class} !~ m/(port|chassis|stack|container|module)/;
$self->logger->debug("ITEM pos:[$mod->{pos}] parent:[$mod->{parent}] "
."description[$mod->{description}] name[$mod->{name}] type[$mod->{type}] class[$mod->{class}]");
$mod->{name} = $self->munge_port_name($mod->{name});
my $e = XML::LibXML::Element->new($mod->{class});
$e->setAttribute('type', $mod->{type});
$e->setAttribute('name', $mod->{name});
$tree->appendChild($e);
foreach my $kidtype ( keys %{$modules{$id}{children}} ) {
foreach my $kid ( @{$modules{$id}{children}{$kidtype}} ) {
next if !defined $kid;
$self->build_tree($kid, $e, $seen, %modules);
}
}
}
sub get_modules {
my ($self, $ip) = @_;
my %modules;
foreach my $mod (@{$self->config->device_modules($ip)}) {
$modules{$mod->{index}}{module} = $mod;
if ($mod->{parent}) {
if ($mod->{pos}) {
${$modules{$mod->{parent}}{children}{$mod->{class}}}[$mod->{pos}] = $mod->{index};
} else {
push(@{$modules{$mod->{parent}}{children}{$mod->{class}}}, $mod->{index});
}
} else {
push(@{$modules{root}}, $mod->{index});
}
}
return %modules;
}
# dump device spec as evaluable perl
sub make_device_cache {
my ($self, $ip) = @_;
my %modules = $self->get_modules($ip);
my $device = XML::LibXML::Element->new('device');
my $seen = {};
foreach my $id (sort {$a cmp $b} keys %modules) {
next if $seen->{$id};
next if !defined $modules{$id};
next if $id eq 'root';
$self->build_tree($id, $device, $seen, %modules);
}
my $doc = XML::LibXML::Document->new();
my $root = XML::LibXML::Element->new('root');
$doc->setDocumentElement($root);
# insert device description XML generated from device_module DB table
$root->appendChild($device);
# insert module and chassis classes as loaded from shipped XML files
$root->appendChild($self->hardware_classes);
$doc = $self->xslt_parser->parse_stylesheet_file($self->config->xml_loc('macro.xsl'))->transform($doc);
$doc = $self->xslt_parser->parse_stylesheet_file($self->config->xml_loc('entity.xsl'))->transform($doc);
# ============================================================================
my $tempdoc = File::Temp->new;
$doc->toFile( $tempdoc->filename );
$self->transform_and_write_out(
xml => $tempdoc->filename,
xslt => $self->config->xml_loc('device-spec2perl.xsl'),
out => $self->config->spec_file($ip),
);
$tempdoc->DESTROY;
}
# dump current port-image elements as evaluable perl
sub make_ports_cache {
my $self = shift;
$self->transform_and_write_out(
xml => $self->config->xml_loc('port.xml'),
xslt => $self->config->xml_loc('port-image2perl.xsl'),
out => $self->config->data_loc( $self->config->port_db_file ),
);
}
sub make_cache_all {
my $self = shift;
$self->make_ports_cache;
$self->make_device_cache($_) for @{$self->config->devices_list};
}
no Moose::Role;
1;
__END__