[ViewVC] Diff of: cvsroot/COMP/SCRAM/src/BuildSystem/ToolDoc.pm

Comparing COMP/SCRAM/src/BuildSystem/ToolDoc.pm (file contents):
Revision 1.1 by williamc, Tue Apr 18 09:09:57 2000 UTC vs.
Revision 1.2 by williamc, Mon Aug 28 08:23:10 2000 UTC

-+
+#
-+
+# ToolDoc.pm
-+
+#
-+
+# Originally Written by Christopher Williams
-+
+#
-+
+# Description
-+
+# -----------
-+
+# SimpleDoc interface to initialise Tool objects
-+
+#
-+
+# Interface
-+
+# ---------
-+
+# new()         : A new ToolDoc object
-+
+# tool(toolobj) : set the tool object for the class
-+
+# toolsearcher(searcher) : set the searcher for finding reference tools
-+
+# setup(file,$name,$version) : setup a tool object from the specified file
-+
+#                               return 0 for OK 1 for cancel
-+
+# interactive([0|1]) : set the interactive node 0=off 1=on
-+
-+
+package BuildSystem::ToolDoc;
-+
+require 5.004;
-+
+use ActiveDoc::SimpleDoc;
-+
+use Utilities::Verbose;
-+
+@ISA=qw(Utilities::Verbose);
-+
-+
+sub new {
-+
+        my $class=shift;
-+
+        $self={};
-+
+        bless $self, $class;
-+
+        $self->{cache}=shift;
-+
+        $self->{mydoctype}="BuildSystem::ToolDoc";
-+
+        $self->{mydocversion}="1.0";
-+
+        $self->init();
-+
+        return $self;
-+
+}
-+
-+
+sub init {
-+
+        my $self=shift;
-+
+        $self->{switch}=ActiveDoc::SimpleDoc->new();
-+
+        $self->{switch}->newparse("setup");
-+
+        $self->{switch}->addtag("setup","Tool",\&Tool_Start, $self,
-+
+                                                "", $self,
-+
+                                                \&Tool_End, $self);
-+
+        $self->{switch}->addtag("setup","Lib",\&Lib, $self,
-+
+                                                "", $self,
-+
+                                                "", $self);
-+
+        $self->{switch}->addtag("setup","External",\&External_Start, $self,
-+
+                                                "", $self,
-+
+                                                "", $self);
-+
+        $self->{switch}->addtag("setup","Client",\&Client_start, $self,
-+
+                                                "", $self,
-+
+                                                \&Client_end, $self);
-+
+        $self->{switch}->addtag("setup","Environment",
-+
+                                                \&Environment_Start, $self,
-+
+                                                \&Env_text, $self,
-+
+                                                \&Environment_End, $self);
-+
+        $self->{switch}->grouptag("Tool","setup");
-+
+        $self->{switch}->addtag("setup","Architecture",
-+
+                                        \&Arch_Start,$self,
-+
+                                        "", $self,
-+
+                                        \&Arch_End,$self);
-+
+        $self->{Arch}=1;
-+
+        push @{$self->{ARCHBLOCK}}, $self->{Arch};
-+
-+
+}
-+
-+
+sub interactive {
-+
+        my $self=shift;
-+
-+
+        @_?$self->{interactive}=shift
-+
+          :((defined $self->{interactive})?$self->{interactive}:0);
-+
+}
-+
-+
+sub tool {
-+
+        my $self=shift;
-+
+        $self->{tool}=shift;
-+
+}
-+
-+
+sub toolsearcher {
-+
+        my $self=shift;
-+
+        if ( @_ ) {
-+
+          my $searcher=shift;
-+
+          if ( ! defined $searcher ) {
-+
+             $self->error("Undefined Value passed as a Searcher".
-+
+                " in ToolDoc::toolsearcher");
-+
+          }
-+
+          $self->{toolboxsearcher}=$searcher;
-+
+        }
-+
+        return $self->{toolboxsearcher};
-+
+}
-+
-+
+sub setup {
-+
+        my $self=shift;
-+
+        my $file=shift;
-+
+        my $name=shift;
-+
+        my $version=shift;
-+
-+
+        $self->{ToolEnv}{'SCRAMtoolname'}=$name;
-+
+        $self->{ToolEnv}{'SCRAMtoolversion'}=$version;
-+
+        $self->{ToolEnv}{'SCRAM_ARCH'}=$ENV{'SCRAM_ARCH'};
-+
-+
+        $name=~tr[A-Z][a-z];
-+
+        $self->{tool}->name($name);
-+
+        $self->{tool}->version($version);
-+
+        $self->{switch}->filetoparse($file);
-+
+        $self->{toolfound}=1;
-+
+        # -- check the type of document - can we parse it?
-+
+        my($doctype,$docversion)=$self->{switch}->doctype();
-+
+        if ( ($doctype ne $self->{mydoctype}) ||
-+
+                ($self->{mydocversion} ne $docversion) ) {
-+
+          $self->error("Unable to Parse Document of type $doctype $docversion".
-+
+                "\n(Only ".$self->{mydoctype}." ". $self->{mydocversion}.")");
-+
+        }
-+
+        $self->{switch}->parse("setup");
-+
+        return $self->{toolfound};
-+
+}
-+
-+
+sub featuretext {
-+
+        my $self=shift;
-+
+        my $feature=shift;
-+
-+
+        if ( @_ ) {
-+
+          $self->{featuretext}{$feature}=shift;
-+
+        }
-+
+        else {
-+
+          return ($self->{featuretext}{$feature});
-+
+        }
-+
+}
-+
-+
+sub _checkdefault {
-+
+        my $self=shift;
-+
+        my $hashref=shift;
-+
-+
+        if ( defined $$hashref{'default'} ) { #check default
-+
+          my $default;
-+
+          foreach $default ( split /:/, $$hashref{'default'} ) {
-+
+            $default=~s/\"//;
-+
+            if ($self->_testlocation($default,
-+
+               [ $self->{tool}->getfeature($$hashref{'type'})] )) { return 1; }
-+
+          }
-+
+        }
-+
+        return 0;
-+
+}
-+
-+
+sub _testlocation {
-+
+        my $self=shift;
-+
+        my $default=shift;
-+
+        my $testfiles=shift;
-+
+        my $OK='false';
-+
+        my $file;
-+
-+
+        chomp $default;
-+
+        $default=$self->_expandvars($default);
-+
+        print "Trying $default .... ";
-+
+        if ( -f $default ) {
-+
+                $OK="true";
-+
+        }
-+
+        else {
-+
+          my $fh=FileHandle->new();
-+
+          opendir $fh,  $default or do { print "No \n"; return 0; };
-+
+         ($#{$testfiles}==-1) ? $OK='false' : $OK='true';
-+
+          print "\n";
-+
+          my @files=readdir $fh;
-+
+          undef $fh;
-+
+          foreach $file ( @$testfiles ) {
-+
+                print "   Checking for $file .... ";
-+
+                # now check that the required files are actually there
-+
+                if ( ( $number = grep /\Q$file\L/, @files) == 0 ) {
-+
+                   $OK='false';
-+
+                   print "not found\n";
-+
+                   last;
-+
+                }
-+
+                print "found\n";
-+
+          }
-+
+        }
-+
+        if ( $OK eq 'true' ) {
-+
+                print "Directory Check Complete\n";
-+
+                return 1
-+
+        }
-+
+        return 0
-+
+}
-+
-+
+sub _expandvars {
-+
+        my $self=shift;
-+
+        my $string=shift;
-+
-+
+        return "" , if ( ! defined $string );
-+
+        $string=~s{
-+
+                \$\((\w+)\)
-+
+        }{
-+
+          if (defined $self->{ToolEnv}{$1}) {
-+
+                $self->_expandvars($self->{ToolEnv}{$1});
-+
+          } else {
-+
+                "\$$1";
-+
+          }
-+
+        }egx;
-+
+        $string=~s{
-+
+                \$(\w+)
-+
+        }{
-+
+          if (defined $self->{ToolEnv}{$1}) {
-+
+                $self->_expandvars($self->{ToolEnv}{$1});
-+
+          } else {
-+
+                "\$$1";
-+
+          }
-+
+        }egx;
-+
+        return $string;
-+
+}
-+
-+
-+
+sub _askuser {
-+
+        my $self=shift;
-+
+        my $querystring=shift;
-+
+        my $varname=shift;
-+
-+
+        print $self->featuretext($self->{EnvContext});
-+
+        for  ( ;; ) {
-+
+         print "\n".$querystring." (RETURN to log as missing)\nset $varname = ";
-+
+         $path=<STDIN>;
-+
+         chomp $path;
-+
+         if ( $path ne "" ) {
-+
+          if ( defined $self->{'client'}) { # must be a location
-+
+           if ( $self->_testlocation($path , "H", $Envtype{$type} )) {
-+
+             return $path;
-+
+           }
-+
+           print "Error : ".$path." does not exist.\n";
-+
+           next;
-+
+          }
-+
+         }
-+
+         else {
-+
+           return $path;
-+
+         }
-+
+        } #end for
-+
-+
+}
-+
-+
+#
-+
+# Propgate through the searcher collecting matching tools
-+
+#
-+
+sub _searchtools {
-+
+        my $self=shift;
-+
+        my $tool=shift;
-+
-+
+        my @tools=();
-+
+        my $area;
-+
+        my $rtool;
-+
+        if ( defined $self->{toolboxsearcher} ) {
-+
+           my $it=$self->{toolboxsearcher}->newiterator();
-+
+           while ( ! $it->last()  ) {
-+
+             $area=$it->next();
-+
+             if ( defined $area ) {
-+
+              $self->verbose("Searching for ".$tool->name()." ".
-+
+                 $tool->version()." in ".$area->location());
-+
+              $rtool=$area->toolbox()->gettool($tool->name(),$tool->version());
-+
+              if ( (defined $rtool) && $rtool->equals($tool) ) {
-+
+                push @tools,$rtool;
-+
+              }
-+
+             }
-+
+           }
-+
+        }
-+
+        return @tools;
-+
+}
-+
-+
+# search toolboxes for a nice list
-+
+#
-+
+sub _toolparamcopy {
-+
+        my $self=shift;
-+
+        my $tool=shift;
-+
+        my $param=shift;
-+
-+
+        my $rv=0;
-+
+        my @params=();
-+
+        $self->verbose("Check Other Projects for tool");
-+
+        my @validtools=$self->_searchtools($tool);
-+
+        if ( ! $self->interactive() ) {
-+
+          if ( $#validtools >=0 ) {
-+
+           @params=$validtools[0]->getfeature($param);
-+
+           if ( $#params >=0 ) {
-+
+                $self->verbose("Extracting Feature $param from tool".
-+
+                        " (= @params )\n");
-+
+                #$tool->setfeature($param,@params);
-+
+                $rv=1;
-+
+           }
-+
+          }
-+
+        }
-+
+        return ($rv,@params);
-+
+}
-+
-+
+# -- Tag Routines
-+
-+
+sub Client_start {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        if ( $self->{Arch} ) {
-+
+          $self->{'client'}=1;
-+
+        }
-+
+}
-+
-+
+sub Client_end {
-+
+        my $self=shift;
-+
+        if ( $self->{Arch} ) {
-+
+        undef $self->{'client'};
-+
+        }
-+
+}
-+
-+
+sub Tool_Start {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->checktag($name, $hashref, 'name');
-+
+        $self->{switch}->checktag($name, $hashref, 'version');
-+
+        $self->{switch}->opengroup("Toolactive");
-+
-+
+        # lower case the name
-+
+        $$hashref{'name'}=~tr[A-Z][a-z];
-+
+        # make sure we only pick up the tool requested
-+
+        if ( ( $self->{tool}->name() eq $$hashref{'name'} ) &&
-+
+                ($self->{tool}->version() eq $$hashref{'version'})) {
-+
+          $self->{switch}->
-+
+                allowgroup("Toolactive",$self->{switch}->currentparsename());
-+
+          $self->{ToolEnv}{'SCRAMtoolname'}=$$hashref{'name'};
-+
+          $self->{ToolEnv}{'SCRAMtoolversion'}=$$hashref{'version'};
-+
+          $self->{toolfound}=0;
-+
+        }
-+
+        else {
-+
+          $self->{switch}->disallowgroup("Toolactive",
-+
+                                $self->{switch}->currentparsename());
-+
+        }
-+
+}
-+
-+
+sub Tool_End {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->closegroup("Toolactive");
-+
+}
-+
-+
+sub Environment_Start {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->checktag($name, $hashref, 'name');
-+
+        if ( $self->{Arch} ) {
-+
+          if ( defined $self->{EnvContext} ) {
-+
+            $self->parserror(" Attempted to open new <$name> context".
-+
+                        " without closing the previous one");
-+
+          }
-+
+          $self->{currentenvtext}="";
-+
+          $self->{EnvContext}=$$hashref{'name'};
-+
+          undef $self->{Envvalue};
-+
+          if ( exists $$hashref{'type'} ) {
-+
+            $$hashref{'type'}=~tr[A-Z][a-z];
-+
+            $self->{tool}->type($$hashref{'name'},$$hashref{'type'});
-+
+          }
-+
+          if ( exists $$hashref{'value'}) {
-+
+            $self->{Envvalue}=$$hashref{'value'};
-+
+          }
-+
+          elsif ( ! $self->interactive() ) {
-+
+           # check other installed copies of the tool
-+
+           my ($rv,@params)=
-+
+                $self->_toolparamcopy($self->{tool},$$hashref{'name'});
-+
+           if ( $rv && ($#params == 0)) { #dont use multivalued params!
-+
+              $self->{Envvalue}=$params[0]; # single val parameter
-+
+           }
-+
+           elsif ( defined $ENV{$$hashref{'name'}} ) {
-+
+              # check the environment
-+
+              $self->{Envvalue}=$ENV{$$hashref{'name'}};
-+
+           }
-+
+           elsif ( $self->_checkdefault($hashref) ) {
-+
+              $self->{Envvalue}=$$hashref{'default'};
-+
+           }
-+
+          }
-+
+        }
-+
+}
-+
-+
+sub Env_text {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $string=shift;
-+
-+
+        if ( $self->{Arch} ) {
-+
+          $self->{currentenvtext}=$self->{currentenvtext}.$string;
-+
+        }
-+
+}
-+
-+
+sub Environment_End {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
-+
+        if ( $self->{Arch} ) {
-+
+          if ( ! defined $self->{EnvContext} ) {
-+
+            $self->{switch}->parseerror("</$name> without an opening context");
-+
+          }
-+
+          # - set the help text
-+
+          $self->featuretext($self->{EnvContext},$self->{currentenvtext});
-+
+          if ( ! defined $self->{Envvalue} ) {
-+
+            $self->{Envvalue}=$self->_askuser("Please Enter the Value Below:",
-+
+                        $self->{EnvContext});
-+
+          }
-+
+          $self->{Envvalue}=$self->_expandvars($self->{Envvalue});
-+
+          $self->{tool}->addfeature($self->{EnvContext}, $self->{Envvalue});
-+
+          $self->{ToolEnv}{$self->{EnvContext}}=$self->{Envvalue};
-+
+          undef $self->{EnvContext};
-+
+          undef $self->{Envvalue};
-+
+        }
-+
+}
-+
-+
+sub Lib {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->checktag($name, $hashref, 'name');
-+
+        if ( $self->{Arch} ) {
-+
+          $self->{tool}->addfeature("lib",$$hashref{'name'});
-+
+        }
-+
+}
-+
-+
+sub External_Start {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->checktag($name, $hashref,'ref');
-+
+        if ( $self->{Arch} ) {
-+
+          $self->{tool}->addfeature("_externals",$$hashref{'ref'});
-+
+        }
-+
+}
-+
-+
+sub Arch_Start {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
+        my $hashref=shift;
-+
-+
+        $self->{switch}->checktag($name, $hashref,'name');
-+
+        ( ($ENV{SCRAM_ARCH}=~/$$hashref{name}.*/) )? ($self->{Arch}=1)
-+
+                                                : ($self->{Arch}=0);
-+
+        push @{$self->{ARCHBLOCK}}, $self->{Arch};
-+
+}
-+
-+
+sub Arch_End {
-+
+        my $self=shift;
-+
+        my $name=shift;
-+
-+
+        pop @{$self->{ARCHBLOCK}};
-+
+        $self->{Arch}=$self->{ARCHBLOCK}[$#{$self->{ARCHBLOCK}}];
-+
+}
-+
-+

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing COMP/SCRAM/src/BuildSystem/ToolDoc.pm (file contents): Revision 1.1 by williamc, Tue Apr 18 09:09:57 2000 UTC vs. Revision 1.2 by williamc, Mon Aug 28 08:23:10 2000 UTC

Diff Legend

Comparing COMP/SCRAM/src/BuildSystem/ToolDoc.pm (file contents):
Revision 1.1 by williamc, Tue Apr 18 09:09:57 2000 UTC vs.
Revision 1.2 by williamc, Mon Aug 28 08:23:10 2000 UTC