# 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