#!/usr/bin/perl -w -I ..
|
#!/usr/bin/perl -w -I ..
|
###############################################################################
|
###############################################################################
|
#
|
#
|
# File: interface.pm
|
# File: interface.pm
|
#
|
#
|
#
|
#
|
###############################################################################
|
###############################################################################
|
use warnings;
|
use warnings;
|
use strict;
|
use strict;
|
use intfc_gen;
|
use intfc_gen;
|
use Data::Dumper;
|
use Data::Dumper;
|
|
|
use Cwd;
|
use Cwd;
|
|
|
|
|
|
|
package interface;
|
package interface;
|
|
|
|
|
|
|
|
|
|
|
sub interface_new {
|
sub interface_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = ("ARRAY" eq ref $_[0]) ? "interface" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "interface" : shift;
|
my $self;
|
my $self;
|
|
|
|
|
$self = {};
|
$self = {};
|
$self->{plugs} = {};
|
$self->{plugs} = {};
|
$self->{sockets} = {};
|
$self->{sockets} = {};
|
$self->{categories} = {};
|
$self->{categories} = {};
|
|
|
|
|
my $dir = Cwd::getcwd();
|
my $dir = Cwd::getcwd();
|
|
$dir =~ s/ /\\ /g;
|
my @files = glob "$dir/lib/interface/*.ITC";
|
my @files = glob "$dir/lib/interface/*.ITC";
|
for my $p (@files){
|
for my $p (@files){
|
#print "$p\n";
|
#print "$p\n";
|
#my $infc_gen = Storable::retrieve($p);
|
#my $infc_gen = Storable::retrieve($p);
|
# Read
|
# Read
|
my $infc_gen;
|
my $infc_gen;
|
$infc_gen = eval { do $p };
|
$infc_gen = eval { do $p };
|
# Might need "no strict;" before and "use strict;" after "do"
|
# Might need "no strict;" before and "use strict;" after "do"
|
die "Error reading: $@" if $@;
|
die "Error reading: $@" if $@;
|
|
|
add_intfc($self,$infc_gen);
|
add_intfc($self,$infc_gen);
|
}
|
}
|
|
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
|
|
sub add_category{
|
sub add_category{
|
my ($self,$category,$intfc_name,$info)=@_;
|
my ($self,$category,$intfc_name,$info)=@_;
|
$self->{categories}{$category}{names}{$intfc_name}{info}=$info;
|
$self->{categories}{$category}{names}{$intfc_name}{info}=$info;
|
|
|
}
|
}
|
|
|
sub get_description{
|
sub get_description{
|
my ($self,$category,$name)=@_;
|
my ($self,$category,$name)=@_;
|
my $info;
|
my $info;
|
if(exists ($self->{categories}{$category}{names}{$name})){
|
if(exists ($self->{categories}{$category}{names}{$name})){
|
$info= $self->{categories}{$category}{names}{$name}{info};
|
$info= $self->{categories}{$category}{names}{$name}{info};
|
}
|
}
|
return $info;
|
return $info;
|
}
|
}
|
|
|
|
|
sub add_plug{
|
sub add_plug{
|
my($self,$plug,$info,$category,$connection_num,$connect_to)=@_;
|
my($self,$plug,$info,$category,$connection_num,$connect_to)=@_;
|
$self->{plugs}{$plug}={};
|
$self->{plugs}{$plug}={};
|
$self->{plugs}{$plug}{connection_num}=$connection_num;
|
$self->{plugs}{$plug}{connection_num}=$connection_num;
|
$self->{plugs}{$plug}{connect_to}=$connect_to;
|
$self->{plugs}{$plug}{connect_to}=$connect_to;
|
$self->{plugs}{$plug}{info}=$info;
|
$self->{plugs}{$plug}{info}=$info;
|
$self->{plugs}{$plug}{category}=$category;
|
$self->{plugs}{$plug}{category}=$category;
|
}
|
}
|
|
|
sub get_plug{
|
sub get_plug{
|
my($self,$plug)=@_;
|
my($self,$plug)=@_;
|
my ($connection_num,$connect_to,$info,$category);
|
my ($connection_num,$connect_to,$info,$category);
|
if(exists ($self->{plugs}{$plug})){
|
if(exists ($self->{plugs}{$plug})){
|
$connection_num =$self->{plugs}{$plug}{connection_num};
|
$connection_num =$self->{plugs}{$plug}{connection_num};
|
$connect_to =$self->{plugs}{$plug}{connect_to};
|
$connect_to =$self->{plugs}{$plug}{connect_to};
|
$info =$self->{plugs}{$plug}{info};
|
$info =$self->{plugs}{$plug}{info};
|
$category =$self->{plugs}{$plug}{category};
|
$category =$self->{plugs}{$plug}{category};
|
|
|
}
|
}
|
return ($connection_num,$connect_to,$info,$category);
|
return ($connection_num,$connect_to,$info,$category);
|
}
|
}
|
|
|
|
|
|
|
sub add_socket{
|
sub add_socket{
|
my($self,$socket,$info,$category,$connection_num,$connect_to)=@_;
|
my($self,$socket,$info,$category,$connection_num,$connect_to)=@_;
|
$self->{sockets}{$socket}={};
|
$self->{sockets}{$socket}={};
|
$self->{sockets}{$socket}{connection_num}=$connection_num;
|
$self->{sockets}{$socket}{connection_num}=$connection_num;
|
$self->{sockets}{$socket}{connect_to}=$connect_to;
|
$self->{sockets}{$socket}{connect_to}=$connect_to;
|
$self->{sockets}{$socket}{info}=$info;
|
$self->{sockets}{$socket}{info}=$info;
|
$self->{sockets}{$socket}{category}=$category;
|
$self->{sockets}{$socket}{category}=$category;
|
}
|
}
|
|
|
|
|
sub get_socket{
|
sub get_socket{
|
my($self,$socket)=@_;
|
my($self,$socket)=@_;
|
my ($connection_num,$connect_to,$info,$category);
|
my ($connection_num,$connect_to,$info,$category);
|
if(exists ($self->{sockets}{$socket})){
|
if(exists ($self->{sockets}{$socket})){
|
$connection_num =$self->{sockets}{$socket}{connection_num};
|
$connection_num =$self->{sockets}{$socket}{connection_num};
|
$connect_to =$self->{sockets}{$socket}{connect_to};
|
$connect_to =$self->{sockets}{$socket}{connect_to};
|
$info =$self->{sockets}{$socket}{info};
|
$info =$self->{sockets}{$socket}{info};
|
$category =$self->{sockets}{$socket}{category}=$category;
|
$category =$self->{sockets}{$socket}{category}=$category;
|
}
|
}
|
return ($connection_num,$connect_to,$info,$category);
|
return ($connection_num,$connect_to,$info,$category);
|
}
|
}
|
|
|
|
|
sub add_param_to_plug{
|
sub add_param_to_plug{
|
my($self,$interface,$param,$value)=@_;
|
my($self,$interface,$param,$value)=@_;
|
$self->{plugs}{$interface}{parameters}{$param}=$value;
|
$self->{plugs}{$interface}{parameters}{$param}=$value;
|
|
|
}
|
}
|
|
|
|
|
sub add_param_to_socket{
|
sub add_param_to_socket{
|
my($self,$interface,$param,$value)=@_;
|
my($self,$interface,$param,$value)=@_;
|
$self->{sockets}{$interface}{parameters}{$param}=$value;
|
$self->{sockets}{$interface}{parameters}{$param}=$value;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub add_port_to_plug{
|
sub add_port_to_plug{
|
my($self,$interface,$port,$range,$type,$outport_type,$connect,$default_out)=@_;
|
my($self,$interface,$port,$range,$type,$outport_type,$connect,$default_out)=@_;
|
$self->{plugs}{$interface}{ports}{$port}={};
|
$self->{plugs}{$interface}{ports}{$port}={};
|
$self->{plugs}{$interface}{ports}{$port}{range}=$range;
|
$self->{plugs}{$interface}{ports}{$port}{range}=$range;
|
$self->{plugs}{$interface}{ports}{$port}{type}=$type;
|
$self->{plugs}{$interface}{ports}{$port}{type}=$type;
|
$self->{plugs}{$interface}{ports}{$port}{outport_type}=$outport_type;
|
$self->{plugs}{$interface}{ports}{$port}{outport_type}=$outport_type;
|
$self->{plugs}{$interface}{ports}{$port}{connect}=$connect;
|
$self->{plugs}{$interface}{ports}{$port}{connect}=$connect;
|
$self->{plugs}{$interface}{ports}{$port}{default_out}=$default_out;
|
$self->{plugs}{$interface}{ports}{$port}{default_out}=$default_out;
|
|
|
}
|
}
|
|
|
|
|
sub get_port_info_of_socket{
|
sub get_port_info_of_socket{
|
my($self,$socket,$port)=@_;
|
my($self,$socket,$port)=@_;
|
my($range,$type,$connect,$default_out);
|
my($range,$type,$connect,$default_out);
|
if(exists ($self->{sockets}{$socket}{ports}{$port})){
|
if(exists ($self->{sockets}{$socket}{ports}{$port})){
|
$range=$self->{sockets}{$socket}{ports}{$port}{range};
|
$range=$self->{sockets}{$socket}{ports}{$port}{range};
|
$type=$self->{sockets}{$socket}{ports}{$port}{type};
|
$type=$self->{sockets}{$socket}{ports}{$port}{type};
|
$connect=$self->{sockets}{$socket}{ports}{$port}{connect};
|
$connect=$self->{sockets}{$socket}{ports}{$port}{connect};
|
$default_out=$self->{sockets}{$socket}{ports}{$port}{default_out};
|
$default_out=$self->{sockets}{$socket}{ports}{$port}{default_out};
|
}
|
}
|
return ($range,$type,$connect,$default_out);
|
return ($range,$type,$connect,$default_out);
|
}
|
}
|
|
|
sub get_port_info_of_plug{
|
sub get_port_info_of_plug{
|
my($self,$plug,$port)=@_;
|
my($self,$plug,$port)=@_;
|
my($range,$type,$connect,$default_out);
|
my($range,$type,$connect,$default_out);
|
if(exists ($self->{plugs}{$plug}{ports}{$port})){
|
if(exists ($self->{plugs}{$plug}{ports}{$port})){
|
$range=$self->{plugs}{$plug}{ports}{$port}{range};
|
$range=$self->{plugs}{$plug}{ports}{$port}{range};
|
$type=$self->{plugs}{$plug}{ports}{$port}{type};
|
$type=$self->{plugs}{$plug}{ports}{$port}{type};
|
$connect=$self->{plugs}{$plug}{ports}{$port}{connect};
|
$connect=$self->{plugs}{$plug}{ports}{$port}{connect};
|
$default_out=$self->{plugs}{$plug}{ports}{$port}{default_out};
|
$default_out=$self->{plugs}{$plug}{ports}{$port}{default_out};
|
|
|
}
|
}
|
return ($range,$type,$connect,$default_out);
|
return ($range,$type,$connect,$default_out);
|
}
|
}
|
|
|
|
|
sub add_port_to_socket{
|
sub add_port_to_socket{
|
my($self,$socket,$port,$range,$type,$outport_type,$connect,$default_out)=@_;
|
my($self,$socket,$port,$range,$type,$outport_type,$connect,$default_out)=@_;
|
$self->{sockets}{$socket}{ports}{$port}={};
|
$self->{sockets}{$socket}{ports}{$port}={};
|
$self->{sockets}{$socket}{ports}{$port}{range}=$range;
|
$self->{sockets}{$socket}{ports}{$port}{range}=$range;
|
$self->{sockets}{$socket}{ports}{$port}{type}=$type;
|
$self->{sockets}{$socket}{ports}{$port}{type}=$type;
|
$self->{sockets}{$socket}{ports}{$port}{outport_type}=$outport_type;
|
$self->{sockets}{$socket}{ports}{$port}{outport_type}=$outport_type;
|
$self->{sockets}{$socket}{ports}{$port}{connect}=$connect;
|
$self->{sockets}{$socket}{ports}{$port}{connect}=$connect;
|
$self->{sockets}{$socket}{ports}{$port}{default_out}=$default_out;
|
$self->{sockets}{$socket}{ports}{$port}{default_out}=$default_out;
|
|
|
}
|
}
|
|
|
|
|
sub get_socket_port_list{
|
sub get_socket_port_list{
|
my($self,$socket)=@_;
|
my($self,$socket)=@_;
|
my @ports;
|
my @ports;
|
if(exists ($self->{sockets}{$socket}{ports})){
|
if(exists ($self->{sockets}{$socket}{ports})){
|
foreach my $p(keys %{$self->{sockets}{$socket}{ports}}){
|
foreach my $p(keys %{$self->{sockets}{$socket}{ports}}){
|
push (@ports,$p);
|
push (@ports,$p);
|
}
|
}
|
}
|
}
|
return @ports;
|
return @ports;
|
}
|
}
|
|
|
sub get_plug_port_list{
|
sub get_plug_port_list{
|
my($self,$plug)=@_;
|
my($self,$plug)=@_;
|
my @ports;
|
my @ports;
|
if(exists ($self->{plugs}{$plug}{ports})){
|
if(exists ($self->{plugs}{$plug}{ports})){
|
foreach my $p(keys %{$self->{plugs}{$plug}{ports}}){
|
foreach my $p(keys %{$self->{plugs}{$plug}{ports}}){
|
push (@ports,$p);
|
push (@ports,$p);
|
}
|
}
|
}
|
}
|
return @ports;
|
return @ports;
|
}
|
}
|
|
|
|
|
|
|
sub get_interfaces{
|
sub get_interfaces{
|
my $self=shift;
|
my $self=shift;
|
my @interfaces;
|
my @interfaces;
|
if(exists ($self->{plugs})){
|
if(exists ($self->{plugs})){
|
foreach my $p (sort keys %{$self->{plugs}}){
|
foreach my $p (sort keys %{$self->{plugs}}){
|
push (@interfaces,$p);
|
push (@interfaces,$p);
|
}
|
}
|
}
|
}
|
return @interfaces;
|
return @interfaces;
|
|
|
|
|
}
|
}
|
|
|
sub get_categories{
|
sub get_categories{
|
my $self=shift;
|
my $self=shift;
|
my @categories;
|
my @categories;
|
if(exists ($self->{categories})){
|
if(exists ($self->{categories})){
|
foreach my $p (sort keys %{$self->{categories}}){
|
foreach my $p (sort keys %{$self->{categories}}){
|
push (@categories,$p);
|
push (@categories,$p);
|
}
|
}
|
}
|
}
|
return @categories;
|
return @categories;
|
|
|
}
|
}
|
|
|
sub get_intfcs_of_category{
|
sub get_intfcs_of_category{
|
my ($self,$category)=@_;
|
my ($self,$category)=@_;
|
my @list;
|
my @list;
|
if(exists ($self->{categories}{$category}{names})){
|
if(exists ($self->{categories}{$category}{names})){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}}){
|
foreach my $p (sort keys %{$self->{categories}{$category}{names}}){
|
push (@list,$p);
|
push (@list,$p);
|
}
|
}
|
|
|
}
|
}
|
return @list;
|
return @list;
|
}
|
}
|
|
|
|
|
sub add_intfc{
|
sub add_intfc{
|
|
|
my ($self,$infc_gen) =@_;
|
my ($self,$infc_gen) =@_;
|
|
|
my $intfc_name=$infc_gen->intfc_get_interface_name();
|
my $intfc_name=$infc_gen->intfc_get_interface_name();
|
my $connection_num=$infc_gen->intfc_get_connection_num();
|
my $connection_num=$infc_gen->intfc_get_connection_num();
|
my $intfc_type=$infc_gen->intfc_get_interface_type();
|
my $intfc_type=$infc_gen->intfc_get_interface_type();
|
my $intfc_info=$infc_gen->intfc_get_description();
|
my $intfc_info=$infc_gen->intfc_get_description();
|
my $intfc_category=$infc_gen->intfc_get_category();
|
my $intfc_category=$infc_gen->intfc_get_category();
|
|
|
|
|
my(%types,%ranges,%names,%connect_types,%connect_ranges,%connect_names,%outport_types,%default_outs);
|
my(%types,%ranges,%names,%connect_types,%connect_ranges,%connect_names,%outport_types,%default_outs);
|
|
|
|
|
add_socket($self,$intfc_name,$intfc_info,$intfc_category,$connection_num,$intfc_name);
|
add_socket($self,$intfc_name,$intfc_info,$intfc_category,$connection_num,$intfc_name);
|
add_plug($self,$intfc_name,$intfc_info,$intfc_category,$connection_num,$intfc_name);
|
add_plug($self,$intfc_name,$intfc_info,$intfc_category,$connection_num,$intfc_name);
|
|
|
add_category($self,$intfc_category,$intfc_name,$intfc_info);
|
add_category($self,$intfc_category,$intfc_name,$intfc_info);
|
|
|
|
|
$infc_gen->intfc_get_ports(\%types,\%ranges,\%names,\%connect_types,\%connect_ranges,\%connect_names,\%outport_types,\%default_outs);
|
$infc_gen->intfc_get_ports(\%types,\%ranges,\%names,\%connect_types,\%connect_ranges,\%connect_names,\%outport_types,\%default_outs);
|
foreach my $id (sort keys %ranges){
|
foreach my $id (sort keys %ranges){
|
my $type=$types{$id};
|
my $type=$types{$id};
|
my $range=$ranges{$id};
|
my $range=$ranges{$id};
|
my $name=$names{$id};
|
my $name=$names{$id};
|
my $connect_type=$connect_types{$id};
|
my $connect_type=$connect_types{$id};
|
my $connect_range=$connect_ranges{$id};
|
my $connect_range=$connect_ranges{$id};
|
my $connect_name=$connect_names{$id};
|
my $connect_name=$connect_names{$id};
|
my $outport_type=$outport_types{$id};
|
my $outport_type=$outport_types{$id};
|
my $default_out=$default_outs{$id};
|
my $default_out=$default_outs{$id};
|
if($intfc_type eq 'plug'){
|
if($intfc_type eq 'plug'){
|
|
|
#my($self,$interface,$port,$range,$type,$outport_type)
|
#my($self,$interface,$port,$range,$type,$outport_type)
|
add_port_to_plug ($self,$intfc_name,$name,$range,$type,$outport_type,$connect_name,$default_out);
|
add_port_to_plug ($self,$intfc_name,$name,$range,$type,$outport_type,$connect_name,$default_out);
|
#print "add_port_to_plug(\$self,$intfc_name,$name,$range,$type,,$outport_type);\n";
|
#print "add_port_to_plug(\$self,$intfc_name,$name,$range,$type,,$outport_type);\n";
|
add_port_to_socket ($self,$intfc_name,$connect_name,$connect_range,$connect_type,$outport_type,$name,$default_out);
|
add_port_to_socket ($self,$intfc_name,$connect_name,$connect_range,$connect_type,$outport_type,$name,$default_out);
|
#print "add_port_to_socket(\$self,$connect_name,$connect_range,$connect_type);\n";
|
#print "add_port_to_socket(\$self,$connect_name,$connect_range,$connect_type);\n";
|
}
|
}
|
else{
|
else{
|
add_port_to_socket($self,$intfc_name,$name,$range,$type,$outport_type,$connect_name,$default_out);
|
add_port_to_socket($self,$intfc_name,$name,$range,$type,$outport_type,$connect_name,$default_out);
|
add_port_to_plug($self,$intfc_name,$connect_name,$connect_range,$connect_type,$outport_type,$name,$default_out);
|
add_port_to_plug($self,$intfc_name,$connect_name,$connect_range,$connect_type,$outport_type,$name,$default_out);
|
}
|
}
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1
|
1
|
|
|
