#!/usr/bin/perl -w -I ..
|
#!/usr/bin/perl -w -I ..
|
###############################################################################
|
###############################################################################
|
#
|
#
|
# File: interface.pm
|
# File: interface.pm
|
#
|
#
|
#
|
#
|
###############################################################################
|
###############################################################################
|
use warnings;
|
use warnings;
|
use strict;
|
use strict;
|
|
|
|
|
|
|
package intfc_gen;
|
package intfc_gen;
|
|
|
|
sub uniq {
|
|
my %seen;
|
|
return grep { !$seen{$_}++ } @_;
|
|
}
|
|
|
|
|
sub interface_generator {
|
sub interface_generator {
|
my $class = "intfc_gen";
|
my $class = "intfc_gen";
|
my $self;
|
my $self;
|
$self->{file_name}=();
|
$self->{file_name}=();
|
$self->{modules}={};
|
$self->{modules}={};
|
$self->{module_name}=();
|
$self->{module_name}=();
|
$self->{type}=();
|
$self->{type}=();
|
$self->{name}=();
|
$self->{name}=();
|
bless($self,$class);
|
bless($self,$class);
|
return $self;
|
return $self;
|
}
|
}
|
|
|
sub intfc_set_interface_file {
|
sub intfc_set_interface_file {
|
my ($self,$file)= @_;
|
my ($self,$file)= @_;
|
if (defined $file){
|
if (defined $file){
|
#print "file name has been changed to $file\n";
|
#print "file name has been changed to $file\n";
|
$self->{file_name}=$file;
|
$self->{file_name}=$file;
|
#delete old data
|
#delete old data
|
if(exists ($self->{modules})) {delete $self->{modules}; } ;
|
if(exists ($self->{modules})) {delete $self->{modules}; } ;
|
if(exists ($self->{module_name})) {delete $self->{module_name}; } ;
|
if(exists ($self->{module_name})) {delete $self->{module_name}; } ;
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
|
|
|
|
|
|
}
|
}
|
}
|
}
|
|
|
sub intfc_get_interface_file {
|
sub intfc_get_interface_file {
|
my ($self)=@_;
|
my ($self)=@_;
|
my $file;
|
my $file;
|
if (exists ($self->{file_name})){
|
if (exists ($self->{file_name})){
|
$file=$self->{file_name};
|
$file=$self->{file_name};
|
}
|
}
|
return $file;
|
return $file;
|
}
|
}
|
|
|
sub intfc_add_module_list{
|
sub intfc_add_module_list{
|
my ($self,@list)=@_;
|
my ($self,@list)=@_;
|
$self->{modules}={};
|
$self->{modules}={};
|
foreach my $p(@list) {
|
foreach my $p(@list) {
|
$self->{modules}{$p}={};
|
$self->{modules}{$p}={};
|
|
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
sub intfc_get_module_list{
|
sub intfc_get_module_list{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @modules;
|
my @modules;
|
if(exists($self->{modules})){
|
if(exists($self->{modules})){
|
@modules=keys %{$self->{modules}};
|
@modules=keys %{$self->{modules}};
|
}
|
}
|
return @modules;
|
return @modules;
|
}
|
}
|
|
|
sub intfc_set_module_name{
|
sub intfc_set_module_name{
|
my ($self,$module)= @_;
|
my ($self,$module)= @_;
|
$self->{module_name}=$module;
|
$self->{module_name}=$module;
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
}
|
}
|
|
|
sub intfc_remove_ports{
|
sub intfc_remove_ports{
|
my $self=shift;
|
my $self=shift;
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
if(exists ($self->{ports})){ delete $self->{ports}};
|
}
|
}
|
|
|
|
|
|
|
sub intfc_get_module_name {
|
sub intfc_get_module_name {
|
my ($self)=@_;
|
my ($self)=@_;
|
my $module;
|
my $module;
|
if (exists ($self->{module_name})){
|
if (exists ($self->{module_name})){
|
$module=$self->{module_name};
|
$module=$self->{module_name};
|
}
|
}
|
return $module;
|
return $module;
|
}
|
}
|
|
|
|
|
sub intfc_add_port{
|
sub intfc_add_port{
|
my ($self,$port_id,$type,$range,$name,$connect_type,$connect_range,$connect_name,$outport_type,$default_out)=@_;
|
my ($self,$port_id,$type,$range,$name,$connect_type,$connect_range,$connect_name,$outport_type,$default_out)=@_;
|
$self->{ports}{$port_id}{name}=$name;
|
$self->{ports}{$port_id}{name}=$name;
|
$self->{ports}{$port_id}{range}=$range;
|
$self->{ports}{$port_id}{range}=$range;
|
$self->{ports}{$port_id}{type}=$type;
|
$self->{ports}{$port_id}{type}=$type;
|
$self->{ports}{$port_id}{connect_name}=$connect_name;
|
$self->{ports}{$port_id}{connect_name}=$connect_name;
|
$self->{ports}{$port_id}{connect_range}=$connect_range;
|
$self->{ports}{$port_id}{connect_range}=$connect_range;
|
$self->{ports}{$port_id}{connect_type}=$connect_type;
|
$self->{ports}{$port_id}{connect_type}=$connect_type;
|
$self->{ports}{$port_id}{outport_type}=$outport_type;
|
$self->{ports}{$port_id}{outport_type}=$outport_type;
|
$self->{ports}{$port_id}{default_out}=$default_out;
|
$self->{ports}{$port_id}{default_out}=$default_out;
|
}
|
}
|
|
|
sub intfc_get_ports{
|
sub intfc_get_ports{
|
my ($self,$types_ref,$ranges_ref,$names_ref,$connect_types_ref,$connect_ranges_ref,$connect_name_ref,$outport_type_ref,$default_out_ref)=@_;
|
my ($self,$types_ref,$ranges_ref,$names_ref,$connect_types_ref,$connect_ranges_ref,$connect_name_ref,$outport_type_ref,$default_out_ref)=@_;
|
if(exists ($self->{ports})){
|
if(exists ($self->{ports})){
|
foreach my $id (sort keys %{$self->{ports}}){
|
foreach my $id (sort keys %{$self->{ports}}){
|
$types_ref->{$id}=$self->{ports}{$id}{type};
|
$types_ref->{$id}=$self->{ports}{$id}{type};
|
$ranges_ref->{$id}=$self->{ports}{$id}{range};
|
$ranges_ref->{$id}=$self->{ports}{$id}{range};
|
$names_ref->{$id}=$self->{ports}{$id}{name};
|
$names_ref->{$id}=$self->{ports}{$id}{name};
|
$connect_types_ref->{$id}=$self->{ports}{$id}{connect_type};
|
$connect_types_ref->{$id}=$self->{ports}{$id}{connect_type};
|
$connect_ranges_ref->{$id}=$self->{ports}{$id}{connect_range};
|
$connect_ranges_ref->{$id}=$self->{ports}{$id}{connect_range};
|
$connect_name_ref->{$id}=$self->{ports}{$id}{connect_name};
|
$connect_name_ref->{$id}=$self->{ports}{$id}{connect_name};
|
$outport_type_ref->{$id}=$self->{ports}{$id}{outport_type};
|
$outport_type_ref->{$id}=$self->{ports}{$id}{outport_type};
|
$default_out_ref->{$id}=$self->{ports}{$id}{default_out};
|
$default_out_ref->{$id}=$self->{ports}{$id}{default_out};
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
sub intfc_ckeck_ports_available{
|
sub intfc_ckeck_ports_available{
|
my ($self)=@_;
|
my ($self)=@_;
|
my $result;
|
my $result;
|
if(exists ($self->{ports})){$result=1;}
|
if(exists ($self->{ports})){$result=1;}
|
return $result;
|
return $result;
|
|
|
}
|
}
|
|
|
sub intfc_remove_port{
|
sub intfc_remove_port{
|
my ($self,$port_id)=@_;
|
my ($self,$port_id)=@_;
|
if(exists ($self->{ports}{$port_id})){
|
if(exists ($self->{ports}{$port_id})){
|
delete $self->{ports}{$port_id};
|
delete $self->{ports}{$port_id};
|
}
|
}
|
}
|
}
|
|
|
|
|
sub intfc_get_ports_type{
|
sub intfc_get_ports_type{
|
my ($self)=@_;
|
my ($self)=@_;
|
my %ports_type;
|
my %ports_type;
|
if(exists ($self->{ports})){
|
if(exists ($self->{ports})){
|
foreach my $p (sort keys %{$self->{ports}}){
|
foreach my $p (sort keys %{$self->{ports}}){
|
$ports_type{$p}= $self->{ports}{$p}{type};
|
$ports_type{$p}= $self->{ports}{$p}{type};
|
|
|
}
|
}
|
}
|
}
|
return %ports_type;
|
return %ports_type;
|
}
|
}
|
|
|
|
|
|
|
sub intfc_set_interface_name{
|
sub intfc_set_interface_name{
|
my ($self,$name)=@_;
|
my ($self,$name)=@_;
|
$self->{name}=$name;
|
$self->{name}=$name;
|
}
|
}
|
|
|
sub intfc_get_interface_name {
|
sub intfc_get_interface_name {
|
my ($self)=@_;
|
my ($self)=@_;
|
my $name;
|
my $name;
|
if(exists ($self->{name})){
|
if(exists ($self->{name})){
|
$name=$self->{name};
|
$name=$self->{name};
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub intfc_set_interface_type {
|
sub intfc_set_interface_type {
|
my ($self,$intfc_type)=@_;
|
my ($self,$intfc_type)=@_;
|
$self->{type}=$intfc_type;
|
$self->{type}=$intfc_type;
|
}
|
}
|
|
|
|
|
sub intfc_get_interface_type {
|
sub intfc_get_interface_type {
|
my ($self)=@_;
|
my ($self)=@_;
|
my $type;
|
my $type;
|
if(exists ($self->{type})){
|
if(exists ($self->{type})){
|
$type=$self->{type};
|
$type=$self->{type};
|
}
|
}
|
return $type;
|
return $type;
|
}
|
}
|
|
|
|
|
sub intfc_set_connection_num {
|
sub intfc_set_connection_num {
|
my ($self,$connection_num)=@_;
|
my ($self,$connection_num)=@_;
|
$self->{connection_num}=$connection_num;
|
$self->{connection_num}=$connection_num;
|
}
|
}
|
|
|
|
|
sub intfc_get_connection_num {
|
sub intfc_get_connection_num {
|
my ($self)=@_;
|
my ($self)=@_;
|
my $connection_num;
|
my $connection_num;
|
if(exists ($self->{connection_num})){
|
if(exists ($self->{connection_num})){
|
$connection_num=$self->{connection_num};
|
$connection_num=$self->{connection_num};
|
}
|
}
|
return $connection_num;
|
return $connection_num;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub intfc_set_description{
|
sub intfc_set_description{
|
my ($self,$description)=@_;
|
my ($self,$description)=@_;
|
$self->{description}=$description;
|
$self->{description}=$description;
|
}
|
}
|
|
|
|
|
|
|
sub intfc_get_description{
|
sub intfc_get_description{
|
my ($self)=@_;
|
my ($self)=@_;
|
my $des;
|
my $des;
|
if(exists ($self->{description})){
|
if(exists ($self->{description})){
|
$des=$self->{description};
|
$des=$self->{description};
|
}
|
}
|
return $des;
|
return $des;
|
}
|
}
|
|
|
|
|
|
|
|
|
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};
|
|
|
|
|
}
|
}
|
|
|
sub object_add_attribute_order{
|
sub object_add_attribute_order{
|
my ($self,$attribute,@param)=@_;
|
my ($self,$attribute,@param)=@_;
|
$self->{'parameters_order'}{$attribute}=[] if (!defined $self->{parameters_order}{$attribute});
|
my $r = $self->{'parameters_order'}{$attribute};
|
foreach my $p (@param){
|
my @a;
|
push (@{$self->{parameters_order}{$attribute}},$p);
|
@a = @{$r} if(defined $r);
|
|
push (@a,@param);
|
}
|
@a=uniq(@a);
|
|
$self->{'parameters_order'}{$attribute} =\@a;
|
}
|
}
|
|
|
sub object_get_attribute_order{
|
sub object_get_attribute_order{
|
my ($self,$attribute)=@_;
|
my ($self,$attribute)=@_;
|
return @{$self->{parameters_order}{$attribute}};
|
return @{$self->{parameters_order}{$attribute}};
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
1
|
1
|
|
|
