# 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