##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn, ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de. ##
##########################################################################
=head1 NAME
PApp::Application - a class representing a single mountable application
=head1 SYNOPSIS
use PApp::Application;
# you don't normally use this class directly
=head1 DESCRIPTION
This class is the base class for all mountable PApp applications.
=over 4
=cut
package PApp::Application;
use PApp::Config qw(DBH);
use PApp::Util;
use PApp::SQL;
use PApp::Exception;
use PApp::I18n ();
use Convert::Scalar ();
use common::sense;
our $VERSION = 2.1;
=item $papp = new PApp::Application args...
=cut
sub new {
my $class = shift;
bless { @_ }, $class;
}
=item $ppkg->preprocess
Parse the package (including all subpackages) and store the configuration
and code data in the PApp Package Cache(tm) for use by load_config and
load_code.
=item $papp->mount
Do necessary bookkeeping to mount an application.
=cut
sub load_config { }
sub load_code { }
sub mount { }
sub unload {
my $self = shift;
# this is most important
sql_exec DBH, "delete from pkg where id = ? and ctime = ?", $self->{path}, $self->{ctime};
delete $self->{cb_src};
delete $self->{cb};
delete $self->{ctime};
delete $self->{compiled};
delete $self->{translate};
delete $self->{file};
delete $self->{root}; # this might trigger a lot of memory freeing!
}
=item $papp->upgrade
Called to upgrade an applicaiton.
=cut
sub upgrade {
# nop
}
=item $papp->event("event")
Distributes the event to all subpackages/submodules.
=cut
sub event($$) {
my $self = shift;
my $event = shift;
if ($self->{cb}{$event}) {
$self->{cb}{$event}();
delete $self->{cb}{$event} if $event eq "init";
}
}
=item $papp->load
Make sure the application is loaded (i.e. in-memory)
=cut
sub load {
my $self = shift;
$self->load_code;
}
=item $papp->surl(surl-args)
=item $papp->slink(slink-args)
Just like PApp::surl and PApp::slink, except that it also jumps into the
application (i.e. it switches applications). C<surl> will act as if you
were in the main module of the application.
=cut
sub surl {
my $self = shift;
push @_, "/papp_appid" => $self->{appid};
&PApp::surl;
}
sub slink {
my $content = splice @_, 1,1;
PApp::alink($content, &surl);
}
=item $changed = $papp->check_deps
Check dependencies and unload application if any dependencies have
changed.
=cut
sub check_deps($) {
my $self = shift;
my $reload;
while (my ($path, $v) = each %{$self->{file}}) {
$reload++ if (stat $path)[9] != $v->{mtime};
}
$self->reload if $reload;
$reload;
}
sub reload {
my $self = shift;
my $code = $self->{compiled};
warn "reloading application $self->{name}";
$self->unload;
$self->load_config;
$self->load_code if $code;
}
=item register_file($name, %attrs)
Register an additional file (for dependency tracking and i18n
scanning). There should never be a need to use this function. Example:
$papp->register_file("/etc/issue", lang => "en", domain => "mydomain");
=cut
sub register_file {
my $self = shift;
my $name = shift;
my %attr = @_;
$attr{lang} = PApp::I18n::normalize_langid $attr{lang};
$self->{file}{$name} = \%attr;
}
=item $papp->run
"Run" the application, i.e. find the current package & module and execute it.
=item $papp->uncaught_exception ($exception, $callback)
This method is called when a surl callback dies ($callback true) or
another exception is caught by papp ($callback false).This method is free
to call C<abort_to> or other functions. If it returns, the exception will
be ignored.
The default implementation just rethrows.
=cut
sub uncaught_exception {
PApp::handle_error ($_[1]);
}
package PApp::Application::Agni;
=back
=head2 PApp::Application::Agni
There is another Application type, Agni, which allows you to directly mount a specific
agni object. To do this, you have to specify the application path like this:
PApp::Application::Agni/path/gid
e.g., to mount the admin application in root/agni/, use this:
PApp::Application::Agni/root/agni/4295054263
=cut
use Carp 'croak';
use base "PApp::Application";
sub for_all_packages($&;$$) {
my $self = shift;
my $cb = shift;
my $path = shift || "";
#$self->{root}->for_all_packages($cb, $path, $self->{root}{name});
}
sub new {
my ($class, %arg) = @_;
require Agni;
$arg{path} =~ /^\/(.*\/)(\d+)$/
or croak "unable to parse agni path/gid from '$arg{path}'";
my ($path, $gid) = ($1, $2);
defined $Agni::pathid{$path}
or croak "can't resolve path '$path'";
my $obj = Agni::path_obj_by_gid($Agni::pathid{$path}, $gid)
or croak "unable to mount object $path$gid";
$class->SUPER::new(%arg, obj => $obj);
}
sub run {
local $PApp::papp = shift;
local $PApp::SQL::Database = $PApp::Config::Database;
local $PApp::SQL::DBH = $PApp::Config::DBH;
$PApp::papp->{obj}->show;
}
sub upgrade {
my $papp = shift;
Agni::agni_exec (sub {
$papp->{obj}->upgrade;
});
}
=over 4
=item $papp->uncaught_exception
The Agni-specific version of this method calls the C<uncaught_exception>
method of the mounted application.
=cut
sub uncaught_exception {
local $PApp::papp = shift;
local $PApp::SQL::Database = $PApp::Config::Database;
local $PApp::SQL::DBH = $PApp::Config::DBH;
$PApp::papp->{obj}->uncaught_exception ($_[0], $_[1]);
}
1;
=back
=head1 SEE ALSO
L<PApp>.
=head1 AUTHOR
Marc Lehmann <schmorp@schmorp.de>
http://home.schmorp.de/
=cut