#  Copyright (c) 1997-2006
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#----------------------------------------------------------------------------
#  $Project: polymake $$Id: Application.pm 7141 2006-03-02 09:36:35Z gawrilow $

use strict;
use namespaces;

use Poly::Module;

package Poly::Application;

declare %from_suffix;

my %repository;

#################################################################################
#
#  Constructor:
#
#  new Poly::Application('name');
#
use Struct (
   [ '@ISA' => 'Poly::Module' ],
   '$file_suffix',		# default file suffix
);

sub new {
   my $self=&_new;

   foreach my $dir (@lookup) {
      if (-d "$dir/apps/".$self->name) {
	 $self->installTop=$dir;
	 $self->top="$dir/apps/".$self->name;
	 last;
      }
   }
   die "unknown application '", $self->name, "'\n" unless $self->top;
   if (-d (my $dir=$self->top."/perllib")) {
      push @{$self->myINC}, $dir;
   }

   define_function("Poly::User", $self->name, sub { Poly::User::application($self) });
   define_function($self->pkg, "application", sub { $self }, 1);
   $self->init_include_rules("main.rules");
   if (keys %{$self->types}) {
      $self->EXPORT->{$_}="meth" for @Poly::Object::EXPORT_METHODS;
   } else {
      warn_print( "no object types declared in application '", $self->name, "'" );
   }

   if (defined $self->file_suffix) {
      $from_suffix{$self->file_suffix}=$self;
   }
   $self;
}
#################################################################################
#
#  Register an application, read in all its descriptive stuff
#
#  add('Name')
#
sub add {
   $repository{$_[1]} ||= &new;
}
#################################################################################
sub list {
   keys %repository;
}
sub known {
   exists $repository{$_[1]}
}
#################################################################################
sub pkg {
   "Apps::" . (shift)->name
}
#################################################################################
#  'ProtoName' => Prototype || undef
#  performs global search in all known applications
#
#  'AppName::ProtoName' => Prototype || undef
#  looks for in the specified application and its modules
#
sub prototype_lookup {
   if (( my ($app_name, $typename)=split /::/, shift )==2) {
      $typename eq "default"
         ? Poly::Application->add($app_name)->default_type
	 : Poly::Application->add($app_name)->find_prototype($typename);

   } elsif (($typename=$app_name) eq "default") {
      Poly::Application->add($Poly::User::default_application)->default_type;

   } else {
      my %visited;
      foreach $app_name ($Poly::User::default_application, @Poly::User::start_applications) {
	 next if $visited{$app_name}++;
	 my $t=Poly::Application->add($app_name)->find_prototype($typename);
	 return $t if defined($t);
      }
      while (($app_name, my $app)=each %repository) {
	 next if $visited{$app_name}++;
	 my $t=$app->find_prototype($typename);
	 return $t if defined($t);
      }
      undef
   }
}

1


syntax highlighted by Code2HTML, v. 0.9.1