generatehood.pl

无线通信的主要编程软件,是无线通信工作人员的必备工具,关天相关教程我会在后续传上.

#!/usr/bin/perl -w

# "Copyright (c) 2000-2003 The Regents of the University of California.  
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice, the following
# two paragraphs and the author appear in all copies of this software.
# 
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY
# OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS."
#
# @author Kamin Whitehouse 
#

use strict;
use FindBin;
use lib $FindBin::Bin;
use AtTags;

my $DestDir = "";

#get rid of extraneous arguments
my @args = @ARGV;
@ARGV = ();
while (@args){
    my $arg = shift @args;
    if ($arg eq "-d") {
        $DestDir = shift @args;
        $DestDir .= "/" unless $arg =~ m{/$};
    } elsif ($arg !~ m/^-[^I]/) {
	push @ARGV, $arg;
    }
}

#add a few more directories that should always be on the search path
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/types/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/interfaces/" );
unshift ( @ARGV, "-I".$ENV{'TOSDIR'}."/system/" );
unshift ( @ARGV, "-I".$ENV{'PWD'}."/" );


#make sure the user knows what's going on:
print "generateHood.pl @ARGV\n";


##############################
# look through the @registry tags to find all unique Attributes, and
#count them
##############################


my ($attributeDefs, $includes) = AtTags::getUniqueTags(@ARGV, "registry", ("attrName"));
my $count = scalar keys %$attributeDefs;

##############################
# look through the @reflection tags to find all unique Reflections
# Numbers come by default by including the Registry.h file.
##############################


my ($reflectionDefs, $includesB) = AtTags::getUniqueTags(@ARGV, "reflection", ("hoodName","reflName"));

for my $include (keys %$includesB){
    $includes->{$include} = 1;
}

##############################
# look through the @scribble tags to find all unique Scribbles.
##############################


my ($scribbleDefs, $includesC) = AtTags::getUniqueTags(@ARGV, "scribble", ("hoodName","scribbleName"));

for my $include (keys %$includesC){
    $includes->{$include} = 1;
}

##############################
# Continue numbering the scribbles where the attributes left off
##############################

for my $name (sort keys %$scribbleDefs ) {
    my $scribble = $scribbleDefs->{$name};
    $scribble->{'scribbleNum'} = $count++;
}


##############################
# look through the @hood tags to find all unique neighborhoods.
##############################


my ($hoodDefs, $includesD) = AtTags::getUniqueTags(@ARGV, "hood", ("hoodName", "numNeighbors", "requiredAttr1", "requiredAttr2", "requiredAttr3", "requiredAttr4", "requiredAttr5", "requiredAttr6", "requiredAttr7", "requiredAttr8"));

for my $include (keys %$includesD){
    $includes->{$include} = 1;
}

##############################
# go through all reflections and scribbles and create a new hash of
# them for each hood.  Simultaneously, crosscheck all refls vs attribute
# names and all hoodNames against actual hood defs for undefined
#names;
# 
# The desired structure is:
# hoods--->Hood1--->reflections--->Refl1
#       |        |              |
#       |        |              |->Refl2...
#       |        |
#       |        |
#       |        |->scribbles----->Scribble1
#       |                       |
#       |                       |->Scribble2...
#       |
#       |
#       |->Hood2...
##############################

my %hoods;
while ( my ($hoodkey, $hood) = each ( %$hoodDefs) ){
    my %reflections;
    my %scribbles;
    my $hoodName = $hood->{'hoodName'};
    $hood->{'reflections'} = \%reflections;
    $hood->{'scribbles'} = \%scribbles;
    my @required = ();
    if ($hood->{"requiredAttr1"}) { push(@required, $hood->{"requiredAttr1"});}
    if ($hood->{"requiredAttr2"}) { push(@required, $hood->{"requiredAttr2"});}
    if ($hood->{"requiredAttr3"}) { push(@required, $hood->{"requiredAttr3"});}
    if ($hood->{"requiredAttr4"}) { push(@required, $hood->{"requiredAttr4"});}
    if ($hood->{"requiredAttr5"}) { push(@required, $hood->{"requiredAttr5"});}
    if ($hood->{"requiredAttr6"}) { push(@required, $hood->{"requiredAttr6"});}
    if ($hood->{"requiredAttr7"}) { push(@required, $hood->{"requiredAttr7"});}
    if ($hood->{"requiredAttr8"}) { push(@required, $hood->{"requiredAttr8"});}
    for my $attr (@required){
	if (! $attributeDefs->{$attr} ){
	    die("ERROR: $hoodName requires attribute $attr, which doesn't exist.");
	}
    }
    $hood->{'required'} = \@required;
    $hoods{$hoodName} = $hood;
}

while ( my ($key, $reflDef) = each( %$reflectionDefs) ){
    my $reflName = $reflDef->{'reflName'};
    if (! $attributeDefs->{$reflName} ){
	die ("$reflDef->{'componentName'}:  ERROR: reflection \"$reflName\" defined with no corresponding attribute.\n\n");
    }
    my $hoodName = $reflDef->{'hoodName'};
    if (! $hoods{$hoodName} ){
	die ("$reflDef->{'componentName'}:  ERROR: reflection \"$reflName\" defined in undefined hood \"$hoodName\".\n\n");
    }
    $hoods{$hoodName}->{'reflections'}->{$reflName} = $reflDef;
}

while ( my ($key, $scribbleDef) = each( %$scribbleDefs) ){
    my $scribbleName = $scribbleDef->{'scribbleName'};
    if ( $attributeDefs->{$scribbleName} ){
	die ("$scribbleDef->{'componentName'}:  ERROR: scribble \"$scribbleName\" has conflict with attribute of same name.\n\n");
    }
    my $hoodName = $scribbleDef->{'hoodName'};
    if (! $hoods{$hoodName} ){
	die ("$scribbleDef->{'componentName'}:  ERROR: scribble \"$scribbleName\" defined in undefined hood \"$hoodName\".\n\n");
    }
    $hoods{$hoodName}->{'scribbles'}->{$scribbleName} = $scribbleDef;
}



##############################
# Number the hoods alphabetically
##############################

my $firstHoodNum = 100;
$count = 0;
for my $name (sort keys %hoods ) {
    my $hood = $hoods{$name};
    $hood->{'hoodNum'} = $count++;
}


##############################
# discover the number of attributes, max reflections per hood, attr
# groups, etc in order to create the Hood.h file
##############################

#total number of attributes
my $numAttributes = scalar keys %$attributeDefs;
my $numHoods = scalar keys %$hoodDefs;
my $maxReflectionsPerHood=0;
my $maxRequiredPerHood=0;
my $maxAttributeGroupSize=1;
while ( my ($hoodName, $hood) = each (%hoods) ) {
    $hood->{'totalRefls'} = scalar keys(%{$hood->{'reflections'}})
	+  scalar keys (%{$hood->{'scribbles'}});
    if ($hood->{'totalRefls'} > $maxReflectionsPerHood ){
        #max reflections per hood
	$maxReflectionsPerHood = $hood->{'totalRefls'};
    }
    my $required = $hood->{'required'};
    if (scalar @$required > $maxRequiredPerHood ){
        #max required attributes per hood
	$maxRequiredPerHood = scalar @$required;
    }

    # create attribute groups, ie. groups of attrs that are "pushed" together (one for each attribute)
    if (scalar @$required > 1){
	for my $attr (@$required){
	    my %groupHash; #use hash table to avoid duplicates in group
	    my $group = \%groupHash;
	    if ($attributeDefs->{$attr}->{'group'}) {
		$group = $attributeDefs->{$attr}->{'group'};
	    }
	    for my $subAttr (@$required){
		if ($attr ne $subAttr ){
		    $group->{$subAttr} = 1;
		}
	    }
	    if (1 + scalar keys %$group > $maxAttributeGroupSize){
		$maxAttributeGroupSize = 1+ scalar keys %$group;
	    }
	    $attributeDefs->{$attr}->{'group'} = $group;
	}
    }
}




##############################
# print out the parsed info for debugging/user knowledge
##############################

my $s;

if (keys %hoods){
    while ( my ($hoodName, $hood) = each ( %hoods) ){
	$s = "Adding reflections to $hoodName:\n"; 
	my $reflections = $hood->{'reflections'};
	while ( my ($reflName, $reflection) = each %$reflections ) { 
	    if ($reflection->{'provided'}==1){
		$s = sprintf "%s%30s : %s\n", $s, $reflection->{'gparams'}->[0],"$reflection->{'componentName'}.$reflName"; 
	    }
	    else{
		$s = sprintf "%s%30s : %s\n", $s, $reflection->{'gparams'}->[0],$reflName; 
	    }
	}
	print "$s\n"; 
	$s = "Adding scribbles to $hoodName:\n"; 
	my $scribbles = $hood->{'scribbles'};
	while ( my ($scribbleName, $scribble) = each %$scribbles ) { 
	    if ($scribble->{'provided'}==1){
		$s = sprintf "%s%30s:\t\t$scribble->{'gparams'}->[0]\n", $s, "$scribble->{'componentName'}.$scribbleName"; 
	    }
	    else{
		$s = sprintf "%s%30s:\t\t$scribble->{'gparams'}->[0]\n", $s, $scribbleName; 
	    }
	}
	print "$s\n"; 
    }
}
else{
    print "** Warning: no hoods defined.\n\n"; 
}	

##############################
# Create a warning at the top of each generated file
##############################

my $G_warning =<< 'EOF';
// *** WARNING ****** WARNING ****** WARNING ****** WARNING ****** WARNING ***
// ***                                                                     ***
// *** This file was automatically generated by generateHood.pl.   ***