#  Copyright (c) 1997-2010
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.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 10172 2011-05-01 08:22:47Z benmuell $

use strict;
use namespaces;

package Polymake::Core::Application;

declare $reconfigure=0;
declare $extension;
declare $plausibility_checks=1;

my (%repository, %forward, $user_prefs_help);

#################################################################################
#
#  Constructor:
#
#  new Application('name', [ rules to load ]);
#
use Polymake::Struct (
   [ new => '$' ],
   [ '$name' => '#1' ],
   [ '$pkg' => '"Polymake::" . #1' ],
   [ '$top' => 'undef' ],         # application top directory (beneath apps/)
   [ '$installTop' => 'undef' ],  # installation directory
   '@myINC',                      # directories with perl modules
   '@rulepath',                   # directories with rules
   '@scriptpath',                 # directories with scripts
   '@object_types',               # ObjectType
   '$default_type',
   '@rules',                      # Rule
   '@rules_to_finalize',          # Rule - production rules defined in the rulefiles being currently read
   '%rulefiles',                  # 'rulefile' => load status
   [ '$configured' => 'undef' ],  # 'rulefile' => configuration result
   '%config_clock',               # 'rulefile' => "time" of the last configuration
   '%rule_code',                  # 'rulefile' => CODE : the complete rulefile-level subroutine
   '%credits',                    # product name => Rule::Credit
   '%credits_by_rulefile',        # 'rulefile' => Rule::Credit
   '%preamble_end',               # 'rulefile' => last line containing a configuration command (CONFIGURE or REQUIRE)
   [ '$custom' => 'undef' ],      # Customize::perApplication
   [ '$prefs' => 'undef' ],       # Preference::perApplication
   [ '$temp_prefs' => '0' ],      # prefer_now in action
   [ '$help' => 'new Help' ],
   '%used',                       # 'name' => Application
   '%imported',                   # 'name' => 1
   '@import_sorted',              # 'name', ... : flattened list in DFS order
   '%EXPORT',                     # names and attributes of user functions and methods
   [ '$compile_scope' => 'undef' ],
   '&eval_expr',                  # eval'uating the given source code in the application-specific lexical context
   [ '$cpp' => 'undef' ],         # CPlusPlus::perAplication
   [ '$declared' => '0' ],
   [ '$default_file_suffix' => 'undef' ],
   '@file_suffixes',
   '@extensions',                 # Extension : extensions contributing to this application
);

sub new {
   my @load_rules=splice @_, 2;
   init_full(&init_forw, @load_rules);
}

sub init_forw {
   my $self=&_new;
   define_function(     # for the rule parser
      $self->pkg, "self",
      sub {
         if (my $what=shift) {
            if ($what<0) {
               if ($what==-1) {
                  # providing help path for scopes without own prototype object
                  my $pkg=caller;
                  $self->help->find("objects", $pkg) || $self->help->add(["objects", $pkg]);
               } else {
                  $self;
               }
            } else {
               croak( "This declaration is only allowed in the object type scope" );
            }
         } else {
            $self;
         }
      },
      1);
   $self;
}
#################################################################################
sub init_full {
   my $self=shift;
   my ($dir, $top);
   my $name=$self->name;
 DIR:
   foreach (@User::lookup_applications) {
      if (-d ($dir="$_/apps/$name")) {
         $top=$dir;
         if (@_) {
            foreach (@_) { -f "$top/rules/$_" or next DIR; }
         } else {
            -f "$top/rules/main.rules" or next;
         }
         $self->installTop=$_;
         $self->top=$top;
         last;
      }
   }
   if (!defined($self->top)) {
      if (defined($top)) {
         croak( @_>1 ? "rule files ".join(", ",@_) : "rule file ".($_[0] || "main.rules"),
                " not found for application $name" );
      } else {
         croak( "unknown application $name" );
      }
   }
   if ($self->installTop ne $InstallTop) {
      add Extension($self->installTop);
   }
   if (-d ($dir=$self->top."/perllib")) {
      push @{$self->myINC}, $dir;
   }
   if (-d ($dir=$self->top."/scripts")) {
      push @{$self->scriptpath}, $dir;
   }

   push @{$self->rulepath}, $self->top."/rules";

   local $plausibility_checks=$DeveloperMode || $self->installTop ne $InstallTop;
   local $Shell=new NoShell();         # disable interactive configuration

   $self->configured=namespaces::declare_var($self->pkg, "%configured");
   $self->custom=$Custom->app_handler($self->pkg);
   $self->custom->add('%configured', <<'.', $Customize::state_config | $Customize::state_hidden | $Customize::state_accumulating, $self->pkg);
Rulefiles with autoconfiguration sections and their exit codes.
Value 0 denotes configuration failure, which disables the corresponding rulefile.
.
   $self->prefs=$Prefs->app_handler($self);
   $self->cpp=CPlusPlus::app_handler($self);

   include_rules($self, @_ ? @_
                           : ( ($Help::gather ? "?help.rules" : ()),
                               "main.rules") );
   $self->cpp->end_loading;

   if (@User::lookup_applications>1) {
      foreach my $ext_dir (@User::lookup_applications) {
         if ($ext_dir ne $self->installTop && -d (my $my_dir="$ext_dir/apps/$name")) {
            load_extension($self, $my_dir, add Extension($ext_dir));
         }
      }
   }

   $self->prefs->end_loading;
   if (length(my $cmds=$self->prefs->user_commands))
   {
      local $User::application=$self;
      local_unshift(\@INC, $self);
      $self->eval_expr->("package Polymake::User; $cmds");
      die $@ if $@;
   }

   if ($Help::gather) {
      $self->custom->create_help_topics($self->help);
      unless ($user_prefs_help) {
         $user_prefs_help=new Help;
         $Prefs->custom->create_help_topics($user_prefs_help);
      }
      push @{$self->help->related}, $user_prefs_help;
   }

   $self;
}
#################################################################################
sub load_extension {
   local $extension=pop;
   my ($self, $my_dir)=@_;
   push @{$self->rulepath}, "$my_dir/rules";
   push @{$self->myINC}, "$my_dir/perllib";
   push @{$self->scriptpath}, "$my_dir/scripts";

   $self->cpp->loading_extension($extension);
   include_rules($self, ($Help::gather ? "?$my_dir/rules/help.rules" : ()),
                        "?$my_dir/rules/main.rules");
   $self->cpp->end_loading;
   push @{$self->extensions}, $extension;
}
#################################################################################
sub add {
   $repository{$_[1]} ||= init_full( &forward );
}
sub forward {
   $forward{$_[1]} ||= &init_forw;
}
sub lookup { $repository{$_[1]} }
#################################################################################
sub list {
   values %repository;
}
sub known {
   keys %repository;
}
sub delete {
   my ($self,$name) = @_;
   delete $repository{$name};
}
#################################################################################
sub lookup_rule {
   my ($self, $rulename)=@_;
   my $pos=0;
   foreach (@{$self->rulepath}) {
      my $filename="$_/$rulename";
      return ($filename, $pos) if -f $filename;
      ++$pos;
   }
   ()
}
#################################################################################
sub exclude_rule {
   my ($self, $rulefile)=@_;
   if ($rulefile =~ /^($id_re)::(.*)/o) {
      exclude_rule($self->used->{$1} || croak( "application $1 is not declared as USE'd - may not load its rules here" ), $2);
   } else {
      $rulefile =~ s/^\?//;
      if (my ($filename, $pos)=lookup_rule($self,$rulefile)) {
         $rulefile=$filename if $pos;
         $self->rulefiles->{$rulefile}=0;
         if (defined (delete $self->configured->{$rulefile})) {
            $self->custom->handler->need_save=1;
         }
      } else {
         croak( "rule file ", $self->name, "::$rulefile does not exist" );
      }
   }
}
#################################################################################
sub include_rule {
   my ($self, $rulefile)=@_;
   if ($rulefile =~ /^($id_re)::/o) {
      include_rules($self->used->{$1} || croak( "application $1 is not declared as USE'd - may not load its rules here" ), $');
   } else {
      my $rc;
      my $may_be_absent= $rulefile =~ s/^\?//;
      if (defined($extension) && index($rulefile,"/")< 0 ) { 
         # use extension directory if we are coming from outside of this application
         $rulefile = $extension->app_dir($self)."/rules/$rulefile";
         dbg_print("prepended extension directory for $rulefile\n") if $Verbose::rules>1;
      }
      if (defined( $rc=$self->rulefiles->{$rulefile} )) {
         return $rc;
      }
      if (defined ($rc=$self->configured->{$rulefile}) && !$rc && $self->config_clock->{$rulefile} >= $reconfigure) {
         return $self->rulefiles->{$rulefile}=0;
      }
      my $filename=$rulefile;
      my $pos;
      if (index($filename,"/")>=0 && -f $filename               # don't lookup for rules in the cwd unless explicitly asked for
          or ($filename, $pos)=lookup_rule($self,$rulefile)) {

         if ($pos) {
            if (defined( $rc=$self->rulefiles->{$filename} )) {
               return $rc;
            }
            if (defined( $rc=$self->configured->{$filename} ) && !$rc && $self->config_clock->{$rulefile} >= $reconfigure) {
               return $self->rulefiles->{$filename}=0;
            }
            $rulefile=$filename;
         }
         local $extension=$pos ? $self->extensions->[$pos] : undef if defined($pos);
         $self->rulefiles->{$rulefile}=1;
         dbg_print( "reading rules from $filename" ) if $Verbose::rules>1;
         require "rules:$filename";
         $self->rulefiles->{$rulefile};
      } else {
         $may_be_absent || croak( "rule file ", ($rulefile =~ m{^/} ? $rulefile : $self->name."::$rulefile"), " does not exist" );
      }
   }
}
#################################################################################
sub include_rules {
   my $self=shift;
   is_code($INC[0]) ? $User::application==$self ? undef : local_unshift(\@INC, $self) :
   is_object($INC[0]) ? $INC[0]==$self || (local $INC[0]=$self) : local_unshift(\@INC, $self);
   local_array($self->custom->tied_vars, []);
   local_scalar($self->compile_scope, new Scope());
   $self->compile_scope->cleanup->{$self->custom}=undef;
   my $rc_all=0;
   eval {
      my $parse_embedded;
      foreach my $rulename (@_) {
         my $is_main= $rulename =~ m{main\.rules$} and $parse_embedded=1;
         if (my $rc=include_rule($self, $rulename)) {
            ++$rc_all;
         } elsif ($is_main) {
            $parse_embedded=0;
         }
      }
      if ($parse_embedded && $self->cpp->embedded_rules_cnt > 0) {
         my $so_name=$self->cpp->shared_modules->{$extension ? $extension->dir : $self->installTop}->so_name;
         dbg_print( "reading rules embedded in shared module $so_name" ) if $Verbose::rules>1;
         $so_name="c++:$so_name";
         $self->rulefiles->{$so_name}=1;
         require $so_name;
      }
      $_->finalize for @{$self->rules_to_finalize};
   };
   if ($@) {
      die beautify_error();
   }
   @{$self->rules_to_finalize}=();
   $rc_all;
}
#################################################################################
sub parse_rule_block {
   my $block=shift;
   $block =~ /^\s*/g;
   map {
      /\|/ ? [ split /\s*\|\s*/ ] : $_
   } $block =~ m{\G ([^\s,|]+ (?: \s*\|\s* [^\s,|]+)*) (?: \s*,\s* | \s+ | $ )}xog
}
#################################################################################
sub include_rule_block {
   my ($self, $mandatory, $block)=@_;
   foreach (parse_rule_block($block)) {
      if (is_ARRAY($_)) {
         my $rc;
         foreach my $rulefile (@$_) {
            if ($rc) {
               exclude_rule($self, $rulefile);
            } else {
               $rc=include_rule($self, $rulefile);
            }
         }
         return 0 if $rc<$mandatory;
      } else {
         return 0 if include_rule($self, $_) < $mandatory;
      }
   }
   1
}
#################################################################################
sub eval_type {
   my ($self, $expr)=@_;
   translate_type($expr);
   $self->eval_expr->($expr) || report_type_error($_[1])
}

declare @type_args;

sub eval_cpp_type {     # called from C++ clients
   (my ($self, $expr), @type_args)=@_;
   translate_type($expr);
   $expr =~ s/\Q(*)\E$/(\@Polymake::Core::Application::type_args)/;
   $self->eval_expr->($expr) || report_type_error($_[1])
}
#################################################################################
sub start_preamble {
   my ($self, $filename, $code)=@_;
   $self->rule_code->{$extension ? $filename : ($filename =~ $filename_re)[0]}=$code;
   $self
}
#################################################################################
sub close_preamble {
   my ($self, $success, $rulefile, $filename, $line, $optional)=@_;
   if ($success) {
      return 1 if $line < $self->preamble_end->{$filename};   # further CONFIGURE blocks follow
   }

   $self->config_clock->{$rulefile}=$reconfigure;
   $self->custom->handler->need_save=1;
   if ($success) {
      $self->configured->{$rulefile} ||= 1;
   } elsif ($optional) {
      $self->configured->{$rulefile}=-1;
      return 1 if $line < $self->preamble_end->{$filename};
   } else {
      $self->configured->{$rulefile}=0;
      $self->rulefiles->{$rulefile}=0;
      $self->declared |= 8;
      if (is_object(my $credit=$self->credits_by_rulefile->{$rulefile})) {
         $credit->shown=$Rule::Credit::hide;
      }
      return 0;
   }

   $self->rulefiles->{$rulefile}=1;
}
#################################################################################
sub configure {
   my ($self, $code, $filename, $line, $optional)=@_;
   my ($rulefile)= $extension ? $filename : $filename =~ $filename_re;
   if (defined (my $rc=$self->configured->{$rulefile}) && $self->config_clock->{$rulefile} >= $reconfigure) {
      $rc || $optional;
   } else {
      require 'Polymake/config_utils.pl';
      my $success=eval { $code->() };
      if ($@) {
         warn_print( "$filename - autoconfiguration failed:\n", $@ );
         $@="";
      }
      close_preamble($self, $success, $rulefile, $filename, $line, $optional);
   }
}
#################################################################################
sub configure_build {
   my ($self, $code, $filename, $line)=@_;
   if (defined (my $rc=$self->configured->{$filename}) && $self->config_clock->{$filename} >= $reconfigure) {
      $rc;
   } elsif ($self->cpp->needs_build($extension)) {
      require 'Polymake/config_utils.pl';
      my @vars=eval { $code->() };
      if ($@) {
         warn_print( "$filename - autoconfiguration failed:\n", $@ );
         $@="";
      }
      if (@vars) {
         $self->cpp->store_in_conf_makefile($extension->dir, @vars);
      }
      close_preamble($self, @vars ? 1 : 0, $filename, $filename, $line);
   } else {
      close_preamble($self, 1, $filename, $filename, $line);
   }
}
#################################################################################
sub include_required {
   my ($self, $block, $filename, $line)=@_;
   my $success=include_rule_block($self, 1, $block);
   my ($rulefile)= $extension ? $filename : $filename =~ $filename_re;
   if ($success) {
      return 1 if $self->configured->{$rulefile} && $self->config_clock->{$rulefile} >= $reconfigure;
   }
   close_preamble($self, $success, $rulefile, $filename, $line);
}
#################################################################################
sub set_file_suffix {
   my ($self, $suffix)=@_;
   ($self->default_file_suffix &&= croak("multiple definition of default file suffix")) ||= $suffix;
   push @{$self->file_suffixes}, $suffix;
}
#################################################################################
sub lookup_credit {
   my ($self, $product)=@_;
   $self->credits->{$product} ||= do {
      my @full_credits=grep { defined } map { $_->credits->{$product} } values %{$self->used};
      $full_credits[0];
   }
}
#################################################################################
sub add_credit {
   my ($self, $product, $text, $filename, $may_repeat)=@_;
   if ($text =~ /\S/) {
      if ($plausibility_checks || $may_repeat) {
         if (my ($credit)=grep { defined } map { $_->credits->{$product} } $self, values %{$self->used}) {
            return $credit if $may_repeat;
            croak( "multiple credits for $product" );
         }
      }
      sanitize_help($text);
      my $credit=new Rule::Credit($product, $text);
      my ($rulefile)= $extension ? $filename : $filename =~ $filename_re;
      $self->credits_by_rulefile->{$rulefile}=$credit;
      $self->credits->{$product}=$credit;
   } else {
      &lookup_credit || croak( "CREDIT $product definition did not occur until here - either misspelled product name or missing REQUIRE block" );
   }
}
#################################################################################
sub add_custom {
   my $self=shift;
   $self->custom->add(@_)->extension=$extension;
}
#################################################################################
sub use_apps {
   my ($self, $import)=splice @_,0,2;
   my ($i, $app);

   my @apps=map {
      if (my ($appname, $start_rules)= m/^\s* ($id_re) (?: \s*\(\s* (.*?) \s*\) )? \s*$/xo) {
         $app=add Application($appname);
         if (defined $start_rules) {
            include_rule_block($app, 1, $start_rules)
              or croak( "could not load mandatory rulefile(s) $start_rules due to configuration issues" );
         }
         $app;
      } else {
         croak( "invalid application name '$_'" );
      }
   } @_;

   if ($import) {
      my $ord=-1;
      my %order=map { $_ => ++$ord } @{$self->import_sorted};

    APPS:
      for ($i=0; $i<=$#apps; ++$i) {
         $app=$apps[$i];
         if (exists $self->imported->{$app->name}) {
            splice @apps, $i--, 1;  next;
         }
         for (my $j=$i+1; $j<=$#apps; ++$j) {
            if (exists $apps[$j]->imported->{$app->name}) {
               splice @apps, $i--, 1; next APPS;
            }
         }

         push @{$self->myINC}, @{$app->myINC};
         push %{$self->EXPORT}, %{$app->EXPORT};
         push %{$self->credits}, %{$app->credits};

         namespaces::using($self->pkg, $app->pkg);
         namespaces::using($self->pkg."::objects", $app->pkg."::objects");
         namespaces::using($self->pkg."::props", $app->pkg."::props");

         $self->imported->{$app->name}=$app;
         $order{$app->name}=++$ord;

         # IMPORT relation is transitive
         while (my ($other_app_name, $other_app)=each %{$app->imported}) {
            $self->imported->{$other_app_name}=$other_app;
            assign_min($order{$other_app_name},$ord);
         }
      }

      my @import_sorted=sort {
         exists $a->imported->{$b->name} ? -1 :
         exists $b->imported->{$a->name} ? 1 :
         $order{$a} <=> $order{$b}
      } values %{$self->imported};

      @{$self->import_sorted}=map { $_->name } @import_sorted;
      @{$self->prefs->imported}=map { $_->prefs } @import_sorted;
      if ($Help::gather) {
         push @{$self->help->related}, map { $_->help } @import_sorted;
      }
   }

   foreach $app (@apps) {
      $self->used->{$app->name}=$app;
      # flatten the %used
      push %{$self->used}, %{$app->used};
   }
}

sub common {
   my ($self, $other)=@_;
   if ($self==$other || exists $self->used->{$other->name}) {
      $self;
   } elsif (exists $other->used->{$self->name}) {
      $other;
   } else {
      undef;
   }
}

#################################################################################
sub find_custom_var {
   my ($self, $name, $alt)=@_;
   my $var;
   if (!defined ($var=$self->custom->find($name))) {
      foreach my $app (values %{$self->used}) {
         $var=$app->custom->find($name) and last;
      }
   }
   if (defined($var)) {
      ($self->custom, $var)
   } elsif (defined($alt) && defined ($var=$alt->find($name))) {
      ($alt, $var)
   } else {
      croak( "unknown custom variable $name" );
   }
}

sub _set_custom {
   (my ($self, $name, $alt, @tail)=@_)>1 or croak( "custom variable, array, hash, or hash element assignment expected" );
   my ($bunch, $var)=find_custom_var($self,$name,$alt);
   $var->set(@tail);
   $bunch->handler->need_save=1;
}

sub set_custom {
   _set_custom($_[0], name_of_custom_var(1));
}

sub _reset_custom {
   (my ($self, $name, $alt, @tail)=@_)>1 or croak( "custom variable, array, hash, or hash element expected" );
   my ($bunch, $var)=find_custom_var($self,$name,$alt);
   $var->reset(@tail);
   $bunch->handler->need_save=1;
}

sub reset_custom {
   _reset_custom($_[0], name_of_custom_var(0));
}
#################################################################################
sub add_top_label {
   my ($self, $name)=@_;
   my $label=( $self->prefs->labels->{$name} &&=
               croak( "multiple definition of label $name" ) )=new Preference::Label($name);
   $label->application=$self;
   $label->extension=$extension;
   $label
}

sub add_label {
   my ($self, $name)=@_;
   my $label=$self->prefs->find_label($name, 1) or do {
      $name =~ /^($id_re)/o;
      croak( "unknown label '$1'" );
   };
   $label->set_application($self, $extension);
   $label
}

sub add_labels {
   my ($self, $labels)=@_;
   map { add_label($self, $_) } split /\s*,\s*/, $labels
}
#################################################################################
sub prefer {
   my $self=shift;
   $self->prefs->add_preference(@_);
}

sub prefer_now {
   my $self=shift;
   unless ($self->temp_prefs) {
      $Scope->begin_locals;
      local_incr($self->temp_prefs);
      $Scope->end_locals;
   }
   $self->prefs->set_temp_preference($Scope, @_);
}

# an alias, for the sake of symmetry
*set_preference=\&prefer;

sub reset_preference {
   my $self=shift;
   if ($_[0] eq "all" || $_[0] eq "*") {
      $self->prefs->handler->reset_all($self);
   } else {
      $self->prefs->handler->reset($self, @_);
   }
}
#################################################################################

package Polymake::Core::Extension;
use Polymake::Struct (
   [ new => '$$;$' ],
   [ '$dir' => '#1' ],
   [ '$ord' => '#2' ],
   [ '$URI' => '#3' ],
   [ '$version' => 'undef' ],
   [ '$version_num' => 'undef' ],
);

declare (%by_dir, %by_URI, %refused);

sub new {
   my $self=&_new;
   if (-f $self->dir."/URI") {
      open my $U, $self->dir."/URI";
      my $URI=<$U>;
      chomp $URI;
      if ($URI =~ s/\#([\d.]+)$//) {
         $self->version=$1;
         $self->version_num=eval "v$1";
      }
      if (defined $self->URI && $URI ne $self->URI) {
         $Prefs->custom->set('%renamed_extensions', $self->URI, $URI);
      }
      $self->URI=$URI;
      delete $refused{$URI};

   } elsif (defined $self->URI) {
      die "The extension ", $self->dir, " does not have any URI while ", $self->URI, " was expected\n";

   } else {
      $self->URI="file://".$self->dir;
      open my $U, ">", $self->dir."/URI"
      or die "can't create file '", $self->dir."/URI': $!\n";
      print $U $self->URI, "\n";
      warn_print( "Assigned a preliminary URI ", $self->URI, " to the new extension.\n",
                  "If you are going to share it with other people, please choose a really unique identifier\n",
                  "looking like http://your.domain/polymake/extensions/your_name\n",
                  "and store it in ", $self->dir."/URI" );
   }
   $self;
}

sub add {
   my ($pkg, $ext_dir, $maybe_new)=@_;
   $by_dir{$ext_dir} ||= do {
      my $ord=0;
      foreach (@User::lookup_applications) {
         $maybe_new=0, last if $_ eq $ext_dir;
         ++$ord;
      }
      my $self=new($pkg,$ext_dir,$ord);
      if (exists $by_URI{$self->URI}) {
         die "Extension ", $self->URI, " already installed in ", $by_URI{$self->URI}->dir, "\n";
      }
      if ($maybe_new) {
         push @User::lookup_applications, $ext_dir;
         $Prefs->custom->set('@lookup_applications');
      }
      $by_URI{$self->URI}=$self
   }
}
#################################################################################
sub lookup { $by_dir{$_[1]} };
sub lookup_by_URI { $by_URI{$_[1]} }
#####################################################################################
sub versioned_URI {
   my $self=shift;
   $self->URI . (defined($self->version) && "#".$self->version)
}
#####################################################################################
sub app_dir { $_[0]->dir."/apps/".$_[1]->name }

sub load {
   my ($pkg, $URI, $obligatory)=@_;
   defined($by_URI{$URI} ||= do {
      if ($URI =~ m|^file://| and -d $') {
         return load_contents(add($pkg,$'));
      } elsif (defined (my $renamed_to=$User::renamed_extensions{$URI})) {
         $by_URI{$renamed_to} || load_contents(add($pkg,$renamed_to));
      } elsif (! $Shell->interactive) {
         if ($obligatory) {
            die "Extension $URI is required.  Retry loading in interactive mode.\n";
         } else {
            warn_print( "Extension $URI must be imported to load the data completely.\n" );
            return;
         }
      } elsif (exists $refused{$URI} || !defined (my $ext_dir=locate_unknown($URI))) {
         if ($refused{$URI} eq "ignore") {
            return 0;
         } elsif ($refused{$URI} eq "stop" || $obligatory) {
            die "Extension $URI is required.\n";
         } else {
            return;
         }
      } else {
         my $self=new($pkg, $ext_dir, scalar(@User::lookup_applications), $URI);
         $by_dir{$ext_dir}=$self;
         push @User::lookup_applications, $ext_dir;
         $Prefs->custom->set('@lookup_applications');
         load_contents($self);
      }
   })
}

sub load_contents {
   my $self=shift;
   foreach my $app_dir (glob($self->dir."/apps/*")) {
      $app_dir =~ $filename_re;
      if (defined (my $app=$repository{$1})) {
         $app->load_extension($app_dir,$self);
      }
   }
   $self
}

1

# Local Variables:
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
