#!/usr/bin/perl -w -I ..
|
#!/usr/bin/perl -w -I ..
|
###############################################################################
|
###############################################################################
|
#
|
#
|
# File: ip.pm
|
# File: ip.pm
|
#
|
#
|
#
|
#
|
###############################################################################
|
###############################################################################
|
use warnings;
|
use warnings;
|
use strict;
|
use strict;
|
use ip_gen;
|
use ip_gen;
|
use Cwd;
|
use Cwd;
|
|
|
|
|
package ip;
|
package ip;
|
|
|
|
|
sub lib_new {
|
sub lib_new {
|
my $class = ("ARRAY" eq ref $_[0]) ? "ip" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "ip" : shift;
|
my $self;
|
my $self;
|
$self = {};
|
$self = {};
|
my $dir = Cwd::getcwd();
|
my $dir = Cwd::getcwd();
|
$dir =~ s/ /\\ /g;
|
$dir =~ s/ /\\ /g;
|
my @files = glob "$dir/lib/ip/*/*.IP";
|
my @files = glob "$dir/lib/ip/*/*.IP";
|
for my $p (@files){
|
for my $p (@files){
|
|
|
# Read
|
# Read
|
my $ipgen;
|
my $ipgen;
|
$ipgen = eval { do $p };
|
$ipgen = eval { do $p };
|
# Might need "no strict;" before and "use strict;" after "do"
|
# Might need "no strict;" before and "use strict;" after "do"
|
if ($@ || !defined $ipgen){
|
if ($@ || !defined $ipgen){
|
print "\n**Warning: skipping $p file due to error in reading: $@\n";
|
print "\n**Warning: skipping $p file due to error in reading: $@\n";
|
next;
|
next;
|
}
|
}
|
add_ip($self,$ipgen);
|
add_ip($self,$ipgen);
|
|
|
}
|
}
|
|
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
|
|
sub ip_add_parameter {
|
sub ip_add_parameter {
|
my ($self,$category,$module,$parameter,$deafult,$type,$content,$info,$glob_param,$redefine_param)=@_;
|
my ($self,$category,$module,$parameter,$default,$type,$content,$info,$glob_param,$redefine_param)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}={};
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}={};
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{deafult}=$deafult;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{"default"}=$default;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{content}=$content;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{content}=$content;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{info}=$info;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{info}=$info;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{glob_param}=$glob_param;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{glob_param}=$glob_param;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{redefine_param}=$redefine_param;
|
$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{redefine_param}=$redefine_param;
|
}
|
}
|
}
|
}
|
|
|
|
|
sub ip_remove_parameter {
|
sub ip_remove_parameter {
|
my ($self,$category,$module,$parameter)=@_;
|
my ($self,$category,$module,$parameter)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
delete $self->{categories}{$category}{names}{$module}{parameters}{$parameter};
|
delete $self->{categories}{$category}{names}{$module}{parameters}{$parameter};
|
|
|
}else{ return 0;}
|
}else{ return 0;}
|
return 1;
|
return 1;
|
}
|
}
|
|
|
|
|
|
|
sub ip_get_parameter {
|
sub ip_get_parameter {
|
my ($self,$category,$module,$parameter)=@_;
|
my ($self,$category,$module,$parameter)=@_;
|
my ($deafult,$type,$content,$info,$glob_param,$redefine_param);
|
my ($default,$type,$content,$info,$glob_param,$redefine_param);
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$deafult =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{deafult};
|
$default =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{"default"};
|
$type =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{type};
|
$type =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{type};
|
$content =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{content};
|
$content =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{content};
|
$info =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{info};
|
$info =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{info};
|
$glob_param =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{glob_param};
|
$glob_param =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{glob_param};
|
$redefine_param =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{redefine_param};
|
$redefine_param =$self->{categories}{$category}{names}{$module}{parameters}{$parameter}{redefine_param};
|
}
|
}
|
return ($deafult,$type,$content,$info,$glob_param,$redefine_param);
|
return ($default,$type,$content,$info,$glob_param,$redefine_param);
|
}
|
}
|
|
|
|
|
sub ip_add_socket {
|
sub ip_add_socket {
|
my ($self,$category,$module,$interface,$type,$value,$connection_num)=@_;
|
my ($self,$category,$module,$interface,$type,$value,$connection_num)=@_;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$self->{categories}{$category}{names}{$module}{sockets}{$interface}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{sockets}{$interface}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{sockets}{$interface}{value}=$value;
|
$self->{categories}{$category}{names}{$module}{sockets}{$interface}{value}=$value;
|
if(defined $connection_num){$self->{categories}{$category}{names}{$module}{sockets}{$interface}{connection_num}=$connection_num;}
|
if(defined $connection_num){$self->{categories}{$category}{names}{$module}{sockets}{$interface}{connection_num}=$connection_num;}
|
|
|
|
|
}
|
}
|
}
|
}
|
|
|
|
|
sub ip_get_socket {
|
sub ip_get_socket {
|
my ($self,$category,$module,$socket)=@_;
|
my ($self,$category,$module,$socket)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$type =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{type};
|
$type =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{type};
|
$value =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{value};
|
$value =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{value};
|
$connection_num =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{connection_num};
|
$connection_num =$self->{categories}{$category}{names}{$module}{sockets}{$socket}{connection_num};
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
sub ip_get_module_sockets_list {
|
sub ip_get_module_sockets_list {
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my @r;
|
my @r;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
push (@r,$p);
|
push (@r,$p);
|
}
|
}
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
|
|
sub ip_add_plug {
|
sub ip_add_plug {
|
my ($self,$category,$module,$interface,$type,$value,$connection_num)=@_;
|
my ($self,$category,$module,$interface,$type,$value,$connection_num)=@_;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$self->{categories}{$category}{names}{$module}{plugs}{$interface}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{plugs}{$interface}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{plugs}{$interface}{value}=$value;
|
$self->{categories}{$category}{names}{$module}{plugs}{$interface}{value}=$value;
|
if(defined $connection_num){ $self->{categories}{$category}{names}{$module}{plugs}{$interface}{connection_num}=$connection_num;}
|
if(defined $connection_num){ $self->{categories}{$category}{names}{$module}{plugs}{$interface}{connection_num}=$connection_num;}
|
|
|
}
|
}
|
}
|
}
|
|
|
sub ip_get_plug {
|
sub ip_get_plug {
|
my ($self,$category,$module,$plug)=@_;
|
my ($self,$category,$module,$plug)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$type =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{type};
|
$type =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{type};
|
$value =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{value};
|
$value =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{value};
|
$connection_num =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{connection_num};
|
$connection_num =$self->{categories}{$category}{names}{$module}{plugs}{$plug}{connection_num};
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
sub ip_get_module_plugs_list {
|
sub ip_get_module_plugs_list {
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my @r;
|
my @r;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{plugs}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{plugs}}){
|
push (@r,$p);
|
push (@r,$p);
|
}
|
}
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub ip_add_port{
|
sub ip_add_port{
|
my ($self,$category,$module,$port,$type,$range,$intfc_name,$intfc_port)=@_;
|
my ($self,$category,$module,$port,$type,$range,$intfc_name,$intfc_port)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
$self->{categories}{$category}{names}{$module}{ports}{$port}={};
|
$self->{categories}{$category}{names}{$module}{ports}{$port}={};
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{type}=$type;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{range}=$range;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{range}=$range;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_port}=$intfc_port;
|
}
|
}
|
}
|
}
|
|
|
|
|
sub ip_get_port{
|
sub ip_get_port{
|
my ($self,$category,$module,$port)=@_;
|
my ($self,$category,$module,$port)=@_;
|
my ($type,$range,$intfc_name,$intfc_port);
|
my ($type,$range,$intfc_name,$intfc_port);
|
if ( exists ($self->{categories}{$category}{names}{$module}{ports}{$port}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}{ports}{$port}) ){
|
$type =$self->{categories}{$category}{names}{$module}{ports}{$port}{type};
|
$type =$self->{categories}{$category}{names}{$module}{ports}{$port}{type};
|
$range =$self->{categories}{$category}{names}{$module}{ports}{$port}{range};
|
$range =$self->{categories}{$category}{names}{$module}{ports}{$port}{range};
|
$intfc_name =$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_name};
|
$intfc_name =$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_name};
|
$intfc_port =$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_port};
|
$intfc_port =$self->{categories}{$category}{names}{$module}{ports}{$port}{intfc_port};
|
}
|
}
|
return ($type,$range,$intfc_name,$intfc_port);
|
return ($type,$range,$intfc_name,$intfc_port);
|
}
|
}
|
|
|
sub ip_list_ports{
|
sub ip_list_ports{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my @ports;
|
my @ports;
|
|
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
|
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{ports}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{ports}}){
|
push (@ports,$p);
|
push (@ports,$p);
|
}
|
}
|
}
|
}
|
return @ports;
|
return @ports;
|
}
|
}
|
|
|
|
|
|
|
sub ip_get_categories{
|
sub ip_get_categories{
|
my $self=shift;
|
my $self=shift;
|
my @r;
|
my @r;
|
if (exists ($self->{categories})){
|
if (exists ($self->{categories})){
|
foreach my $p (sort keys %{$self->{categories}}){
|
foreach my $p (sort keys %{$self->{categories}}){
|
push (@r,$p);
|
push (@r,$p);
|
}
|
}
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
sub get_modules{
|
sub get_modules{
|
my ($self,$category)=@_;
|
my ($self,$category)=@_;
|
my @r;
|
my @r;
|
if (exists ($self->{categories}{$category})){
|
if (exists ($self->{categories}{$category})){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}}){
|
push (@r,$p);
|
push (@r,$p);
|
}
|
}
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
sub get_param_default{
|
sub get_param_default{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my %r;
|
my %r;
|
if (!defined($module) ) {return %r;}
|
if (!defined($module) ) {return %r;}
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{parameters}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{parameters}}){
|
$r{$p}=$self->{categories}{$category}{names}{$module}{parameters}{$p}{deafult};
|
$r{$p}=$self->{categories}{$category}{names}{$module}{parameters}{$p}{"default"};
|
#print "$p=$r{$p}\n";
|
#print "$p=$r{$p}\n";
|
}
|
}
|
return %r;
|
return %r;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub ip_add_socket_names{
|
sub ip_add_socket_names{
|
my($self,$ipgen,$category,$module, $socket)=@_;
|
my($self,$ipgen,$category,$module, $socket)=@_;
|
my $num=0;
|
my $num=0;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
|
|
my $name= $ipgen->ipgen_get_socket_name($socket,$num);
|
my $name= $ipgen->ipgen_get_socket_name($socket,$num);
|
do{
|
do{
|
$self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name}=$name;
|
$self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name}=$name;
|
++$num;
|
++$num;
|
$name= $ipgen->ipgen_get_socket_name($socket,$num);
|
$name= $ipgen->ipgen_get_socket_name($socket,$num);
|
}while(defined $name);
|
}while(defined $name);
|
|
|
}
|
}
|
}
|
}
|
|
|
sub ip_get_socket_name{
|
sub ip_get_socket_name{
|
my($self,$category,$module, $socket,$num)=@_;
|
my($self,$category,$module, $socket,$num)=@_;
|
my $name;
|
my $name;
|
if ( exists ( $self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name}) ){
|
if ( exists ( $self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name}) ){
|
$name= $self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name};
|
$name= $self->{categories}{$category}{names}{$module}{sockets}{$socket}{$num}{name};
|
|
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
|
|
|
|
sub ip_add_plug_names{
|
sub ip_add_plug_names{
|
my($self,$ipgen,$category,$module, $plug)=@_;
|
my($self,$ipgen,$category,$module, $plug)=@_;
|
my $num=0;
|
my $num=0;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
|
|
my $name= $ipgen->ipgen_get_plug_name($plug,$num);
|
my $name= $ipgen->ipgen_get_plug_name($plug,$num);
|
do{
|
do{
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name}=$name;
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name}=$name;
|
my ($addr,$width)= $ipgen->ipgen_get_wb_addr($plug,$num);
|
my ($addr,$width)= $ipgen->ipgen_get_wb_addr($plug,$num);
|
if (defined $addr){
|
if (defined $addr){
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr}=$addr;
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr}=$addr;
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{width}=$width;
|
$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{width}=$width;
|
}
|
}
|
++$num;
|
++$num;
|
$name= $ipgen->ipgen_get_plug_name($plug,$num);
|
$name= $ipgen->ipgen_get_plug_name($plug,$num);
|
|
|
|
|
}while(defined $name);
|
}while(defined $name);
|
|
|
}
|
}
|
}
|
}
|
|
|
sub ip_get_wb_addr{
|
sub ip_get_wb_addr{
|
my($self,$category,$module,$plug,$num)=@_;
|
my($self,$category,$module,$plug,$num)=@_;
|
my ($addr , $width);
|
my ($addr , $width);
|
if(exists($self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr})){
|
if(exists($self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr})){
|
$addr = $self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr};
|
$addr = $self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{addr};
|
$width = $self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{width};
|
$width = $self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{width};
|
}
|
}
|
return ($addr , $width);
|
return ($addr , $width);
|
}
|
}
|
|
|
|
|
|
|
sub ip_get_plug_name{
|
sub ip_get_plug_name{
|
my($self,$category,$module, $plug,$num)=@_;
|
my($self,$category,$module, $plug,$num)=@_;
|
my $name;
|
my $name;
|
if ( exists ($self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name})){
|
if ( exists ($self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name})){
|
$name=$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name};
|
$name=$self->{categories}{$category}{names}{$module}{plugs}{$plug}{$num}{name};
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub get_module_sokets_value{
|
sub get_module_sokets_value{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
my %r;
|
my %r;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
$r{$p}=$self->{categories}{$category}{names}{$module}{sockets}{$p}{value};
|
$r{$p}=$self->{categories}{$category}{names}{$module}{sockets}{$p}{value};
|
}
|
}
|
|
|
}
|
}
|
return %r;
|
return %r;
|
}
|
}
|
|
|
|
|
sub get_module_sokets_type{
|
sub get_module_sokets_type{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
my %r;
|
my %r;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{sockets}}){
|
$r{$p}=$self->{categories}{$category}{names}{$module}{sockets}{$p}{type};
|
$r{$p}=$self->{categories}{$category}{names}{$module}{sockets}{$p}{type};
|
}
|
}
|
|
|
}
|
}
|
return %r;
|
return %r;
|
}
|
}
|
|
|
|
|
sub get_module_plugs_value{
|
sub get_module_plugs_value{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
if (!defined($category) ) {return 0;}
|
if (!defined($category) ) {return 0;}
|
my %r;
|
my %r;
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
if ( exists ($self->{categories}{$category}{names}{$module}) ){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{plugs}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}{$module}{plugs}}){
|
$r{$p}=$self->{categories}{$category}{names}{$module}{plugs}{$p}{value};
|
$r{$p}=$self->{categories}{$category}{names}{$module}{plugs}{$p}{value};
|
}
|
}
|
|
|
}
|
}
|
return %r;
|
return %r;
|
}
|
}
|
|
|
sub ip_get_param_order{
|
sub ip_get_param_order{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my @r;
|
my @r;
|
if(exists $self->{categories}{$category}{names}{$module}{parameters_order}) {
|
if(exists $self->{categories}{$category}{names}{$module}{parameters_order}) {
|
@r=@{$self->{categories}{$category}{names}{$module}{parameters_order}};
|
@r=@{$self->{categories}{$category}{names}{$module}{parameters_order}};
|
|
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub ip_add{
|
sub ip_add{
|
my ($self,$category,$module,$filed_name,$filed_data)=@_;
|
my ($self,$category,$module,$filed_name,$filed_data)=@_;
|
$self->{categories}{$category}{names}{$module}{$filed_name}=$filed_data;
|
$self->{categories}{$category}{names}{$module}{$filed_name}=$filed_data;
|
}
|
}
|
|
|
|
|
sub ip_get{
|
sub ip_get{
|
my ($self,$category,$module,$filed_name)=@_;
|
my ($self,$category,$module,$filed_name)=@_;
|
return $self->{categories}{$category}{names}{$module}{$filed_name};
|
return $self->{categories}{$category}{names}{$module}{$filed_name};
|
}
|
}
|
|
|
|
|
sub ip_get_list{
|
sub ip_get_list{
|
my ($self,$category,$module,$filed_name)=@_;
|
my ($self,$category,$module,$filed_name)=@_;
|
my @l;
|
my @l;
|
if( defined $self->{categories}{$category}{names}{$module}{$filed_name}){
|
if( defined $self->{categories}{$category}{names}{$module}{$filed_name}){
|
@l=@{$self->{categories}{$category}{names}{$module}{$filed_name}};
|
@l=@{$self->{categories}{$category}{names}{$module}{$filed_name}};
|
}
|
}
|
return @l;
|
return @l;
|
}
|
}
|
|
|
|
|
sub ip_remove{
|
sub ip_remove{
|
my ($self,$category,$module,$filed_name)=@_;
|
my ($self,$category,$module,$filed_name)=@_;
|
delete $self->{categories}{$category}{names}{$module}{$filed_name};
|
delete $self->{categories}{$category}{names}{$module}{$filed_name};
|
}
|
}
|
|
|
|
|
|
|
|
|
sub add_ip{
|
sub add_ip{
|
|
|
my ($self,$ipgen) =@_;
|
my ($self,$ipgen) =@_;
|
my $module;
|
my $module;
|
$module = $ipgen->ipgen_get("ip_name");
|
$module = $ipgen->ipgen_get("ip_name");
|
my $module_name =$ipgen->ipgen_get("module_name");
|
my $module_name =$ipgen->ipgen_get("module_name");
|
if(!defined $module){ $module = $module_name}
|
if(!defined $module){ $module = $module_name}
|
my $category= $ipgen->ipgen_get("category");
|
my $category= $ipgen->ipgen_get("category");
|
|
|
|
|
$self->{categories}{$category}{names}{$module}={};
|
$self->{categories}{$category}{names}{$module}={};
|
|
|
$self->{categories}{$category}{names}{$module}{module_name}=$module_name;
|
$self->{categories}{$category}{names}{$module}{module_name}=$module_name;
|
my @plugs= $ipgen->ipgen_list_plugs();
|
my @plugs= $ipgen->ipgen_list_plugs();
|
#print "$module:@plugs\n";
|
#print "$module:@plugs\n";
|
foreach my $plug (@plugs){
|
foreach my $plug (@plugs){
|
my ($type,$value,$connection_num)= $ipgen->ipgen_get_plug($plug);
|
my ($type,$value,$connection_num)= $ipgen->ipgen_get_plug($plug);
|
ip_add_plug($self,$category,$module,$plug,$type,$value,$connection_num);
|
ip_add_plug($self,$category,$module,$plug,$type,$value,$connection_num);
|
ip_add_plug_names($self,$ipgen,$category,$module, $plug);
|
ip_add_plug_names($self,$ipgen,$category,$module, $plug);
|
|
|
}
|
}
|
my @sockets= $ipgen->ipgen_list_sokets();
|
my @sockets= $ipgen->ipgen_list_sokets();
|
#print "$module:@sockets\n";
|
#print "$module:@sockets\n";
|
foreach my $socket (@sockets){
|
foreach my $socket (@sockets){
|
my ($type,$value,$connection_num)= $ipgen->ipgen_get_socket($socket);
|
my ($type,$value,$connection_num)= $ipgen->ipgen_get_socket($socket);
|
ip_add_socket($self,$category,$module, $socket,$type,$value,$connection_num);
|
ip_add_socket($self,$category,$module, $socket,$type,$value,$connection_num);
|
ip_add_socket_names($self,$ipgen,$category,$module, $socket);
|
ip_add_socket_names($self,$ipgen,$category,$module, $socket);
|
}
|
}
|
my @parameters= $ipgen->ipgen_get_all_parameters_list();
|
my @parameters= $ipgen->ipgen_get_all_parameters_list();
|
foreach my $param (@parameters){
|
foreach my $param (@parameters){
|
my ($deafult,$type,$content,$info,$glob_param,$redefine_param)=$ipgen->ipgen_get_parameter_detail($param);
|
my ($default,$type,$content,$info,$glob_param,$redefine_param)=$ipgen->ipgen_get_parameter_detail($param);
|
ip_add_parameter($self,$category,$module,$param,$deafult,$type,$content,$info,$glob_param,$redefine_param);
|
ip_add_parameter($self,$category,$module,$param,$default,$type,$content,$info,$glob_param,$redefine_param);
|
|
|
}
|
}
|
|
|
my @ports= $ipgen->ipgen_list_ports();
|
my @ports= $ipgen->ipgen_list_ports();
|
foreach my $port (@ports){
|
foreach my $port (@ports){
|
my($range,$type,$intfc_name,$intfc_port)=$ipgen->ipgen_get_port($port);
|
my($range,$type,$intfc_name,$intfc_port)=$ipgen->ipgen_get_port($port);
|
ip_add_port($self,$category,$module,$port,$type,$range,$intfc_name,$intfc_port);
|
ip_add_port($self,$category,$module,$port,$type,$range,$intfc_name,$intfc_port);
|
}
|
}
|
|
|
my @fileds =("system_h","hdl_files","sw_files","gen_sw_files","sw_params_list","unused","parameters_order","description","version",'description_pdf');
|
my @fileds =("system_h","hdl_files","sw_files","gen_sw_files","gen_hw_files","sw_params_list","unused","parameters_order","description","version",'description_pdf');
|
foreach my $p (@fileds){
|
foreach my $p (@fileds){
|
my $val=$ipgen->ipgen_get($p);
|
my $val=$ipgen->ipgen_get($p);
|
$self->{categories}{$category}{names}{$module}{$p}=$ipgen->ipgen_get($p) if(defined $val );
|
$self->{categories}{$category}{names}{$module}{$p}=$ipgen->ipgen_get($p) if(defined $val );
|
}
|
}
|
|
|
|
|
|
|
}
|
}
|
|
|
|
|
|
|
sub object_add_attribute{
|
sub object_add_attribute{
|
my ($self,$attribute1,$attribute2,$value)=@_;
|
my ($self,$attribute1,$attribute2,$value)=@_;
|
if(!defined $attribute2){$self->{$attribute1}=$value;}
|
if(!defined $attribute2){$self->{$attribute1}=$value;}
|
else {$self->{$attribute1}{$attribute2}=$value;}
|
else {$self->{$attribute1}{$attribute2}=$value;}
|
|
|
}
|
}
|
|
|
sub object_get_attribute{
|
sub object_get_attribute{
|
my ($self,$attribute1,$attribute2)=@_;
|
my ($self,$attribute1,$attribute2)=@_;
|
if(!defined $attribute2) {return $self->{$attribute1};}
|
if(!defined $attribute2) {return $self->{$attribute1};}
|
return $self->{$attribute1}{$attribute2};
|
return $self->{$attribute1}{$attribute2};
|
|
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1
|
1
|
|
|
