root/juggler/tags/1.1_dr_1/JugglerConfigure.pm

Revision 9180, 5.0 kB (checked in by patrickh, 6 years ago)

Copyright update.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 # ************** <auto-copyright.pl BEGIN do not edit this line> **************
2 #
3 # VR Juggler is (C) Copyright 1998-2002 by Iowa State University
4 #
5 # Original Authors:
6 #   Allen Bierbaum, Christopher Just,
7 #   Patrick Hartling, Kevin Meinert,
8 #   Carolina Cruz-Neira, Albert Baker
9 #
10 # This library is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU Library General Public
12 # License as published by the Free Software Foundation; either
13 # version 2 of the License, or (at your option) any later version.
14 #
15 # This library is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 # Library General Public License for more details.
19 #
20 # You should have received a copy of the GNU Library General Public
21 # License along with this library; if not, write to the
22 # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 # Boston, MA 02111-1307, USA.
24 #
25 # -----------------------------------------------------------------
26 # File:          $RCSfile$
27 # Date modified: $Date$
28 # Version:       $Revision$
29 # -----------------------------------------------------------------
30 #
31 # *************** <auto-copyright.pl END do not edit this line> ***************
32
33 package JugglerConfigure;
34
35 use strict 'vars';
36 use vars qw($DEFAULT_MODULE);
37
38 sub parseConfigFile($);
39
40 $DEFAULT_MODULE = '';
41 my %MODULES     = ();
42
43 sub parseConfigFile ($)
44 {
45    my $cfg = shift;
46    open(CFG, "$cfg") or die "ERROR: Could not read from $cfg: $!\n";
47
48    my($cfg_file, $line);
49    while ( $line = <CFG> )
50    {
51       $line =~ s/(#|\/\/).*$//;
52       $cfg_file .= "$line";
53    }
54
55    close(CFG);
56
57    while ( $cfg_file !~ /^\s*$/ )
58    {
59       if ( $cfg_file =~ /^\s*(\S+)\s*{(.+?)}\s*/s )
60       {
61          my $mod   = "$1";
62          my $deps  = "$2";
63          $cfg_file = $';
64
65          $MODULES{"$mod"} = new JugglerModule("$mod");
66
67          while ( $deps !~ /^\s*$/ )
68          {
69             if ( $deps =~ /^\s*depend\s+(\S+);/ )
70             {
71                $deps = $';
72                my $module_name = "$1";
73
74                die "ERROR: No such module $module_name for $mod dependency\n"
75                   unless defined($MODULES{"$module_name"});
76
77                $MODULES{"$mod"}->addDependencies($MODULES{"$module_name"}->getDependencies());
78             }
79             elsif ( $deps =~ /\s*(\S.+?)(:\s+(.+?)|\s*);/ )
80             {
81                $deps = $';
82
83                my $dep_path = "$1";
84                my %vars = ();
85
86                if ( defined($3) )
87                {
88                   my @var_list = split(/\s*,\s*/, "$3");
89
90                   my $var;
91                   foreach $var ( @var_list )
92                   {
93                      $var =~ /\s*(\w+)=(\S+)\s*/;
94                      $vars{"$1"} = "$2";
95                   }
96                }
97
98                $MODULES{"$mod"}->addDependency(new ModuleDependency("$dep_path",
99                                                                     \%vars));
100             }
101             else
102             {
103                # XXX: Not quite right...
104                $deps ='';
105             }
106          }
107       }
108       elsif ( $cfg_file =~ /^Default:\s+(\S+)\s*$/m )
109       {
110          $DEFAULT_MODULE = "$1";
111          $cfg_file       = $';
112       }
113
114       $cfg_file =~ s/^\s*//;
115    }
116
117    return %MODULES;
118 }
119
120 package JugglerModule;
121
122 sub new ($$)
123 {
124    my $class = shift;
125    my $name  = shift;
126
127    return bless
128    {
129       'name' => $name,          # Name of this module
130       'deps' => []              # Array of ModuleDependecy objects
131    }, $class;
132 }
133
134 sub getName ($)
135 {
136    my $this = shift;
137    return $this->{'name'};
138 }
139
140 sub getDependencies ($)
141 {
142    my $this = shift;
143    return @{$this->{'deps'}};
144 }
145
146 sub addDependency ($$)
147 {
148    my $this = shift;
149    my $dep  = shift;
150    push(@{$this->{'deps'}}, $dep);
151 }
152
153 sub addDependencies ($@)
154 {
155    my $this = shift;
156
157    # The $MODULES entry for $module_name contains an array of hash references.
158    # We just copy those references into the array for the current module
159    # ($this).  Simple, no?
160    my $dep;
161    foreach $dep ( @_ )
162    {
163       $this->addDependency($dep) unless $this->hasDependency($dep);
164    }
165 }
166
167 sub hasDependency ($$)
168 {
169    my $this    = shift;
170    my $new_dep = shift;
171
172    my $has_dependency = 0;
173
174    my $cur_dep;
175    foreach $cur_dep ( $this->getDependencies() )
176    {
177       if ( $cur_dep->getPath() eq $new_dep->getPath() )
178       {
179          $has_dependency = 1;
180          last;
181       }
182    }
183
184    return $has_dependency;
185 }
186
187 package ModuleDependency;
188
189 sub new ($$;$)
190 {
191    my $class = shift;
192    my $path  = shift;
193    my $env   = shift || {};
194    
195    return bless
196    {
197       'path' => $path,          # Path to this dependency
198       'env'  => $env            # Reference to environment variable hash
199    }, $class;
200 }
201
202 sub getPath ($)
203 {
204    my $this = shift;
205    return $this->{'path'};
206 }
207
208 sub getEnvironment ($)
209 {
210    my $this = shift;
211    return %{$this->{'env'}};
212 }
213
214 sub getEnvironmentValue ($$)
215 {
216    my $this = shift;
217    my $key  = shift;
218
219    return ${$this->{'env'}}{"$key"};
220 }
221
222 1;
Note: See TracBrowser for help on using the browser.