File Coverage

blib/lib/WE_Frontend/Info.pm

Criterion	Covered	Total	%
statement	45	57	78.9
branch	10	18	55.5
condition	12	21	57.1
subroutine	16	20	80.0
pod			n/a
total	83	116	71.5

package WE_Frontend::Info;

use strict;
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/);

######################################################################
package WEsiteinfo::Paths;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(scheme servername serverport absoluteurl
			     livescheme liveservername liveserverport
			     liveabsoluteurl
			     hosturl livehosturl
			     uprootdir liveuprootdir
			     rooturl rootdir cgiurl cgidir
			     liverooturl liverootdir livecgiurl livecgidir
			     we_templatebase site_we_templatebase
			     site_templatebase we_htmldir we_htmlurl
			     we_datadir photodir downloaddir
			     pubhtmldir prototypedir
			     htuser htpassword
			    ));
# backward compat:
*we_htmlbase = \&we_htmldir;
*we_database = \&we_datadir;

sub new { bless {}, shift } # XXX this used to be __PACKAGE__ --- document!

# Provide sensible defaults
my %paths_constructed_member =
    (hosturl         => sub { $_[0]->scheme . "://" .
			      $_[0]->servername .
			      (defined $_[0]->serverport && $_[0]->serverport ne "80"
			       ? ":" . $_[0]->serverport
			       : "")
			  },
     livehosturl     => sub { $_[0]->livescheme . "://" .
			      $_[0]->liveservername .
			      (defined $_[0]->liveserverport && $_[0]->liveserverport ne "80"
			       ? ":" . $_[0]->liveserverport
			       : "")
			  },
     absoluteurl     => sub { $_[0]->hosturl . $_[0]->rooturl },
     liveabsoluteurl => sub { $_[0]->livehosturl . $_[0]->liverooturl },
     rooturl         => sub { "" },
     rootdir         => sub { $_[0]->uprootdir . "/htdocs" },
     liverooturl     => sub { "" },
     liverootdir     => sub { $_[0]->liveuprootdir . "/htdocs" },
     cgiurl          => sub { "/cgi-bin" },
     cgidir          => sub { $_[0]->uprootdir . "/cgi-bin" },
     livecgiurl      => sub { $_[0]->cgiurl },
     livecgidir      => sub { $_[0]->liveuprootdir . "/cgi-bin" },
     we_htmldir      => sub { $_[0]->rootdir . "/we" },
     we_htmlurl      => sub { $_[0]->rooturl . "/we" },
     we_templatebase => sub { $_[0]->we_htmldir . "/we_templates" },
     site_templatebase    => sub { $_[0]->we_htmldir . "/" .
				   $_[0]->{_parent}->project->name .
				   "_templates" },
     site_we_templatebase => sub { $_[0]->we_htmldir . "/" .
				   $_[0]->{_parent}->project->name .
				   "_we_templates" },
     prototypedir    => sub { $_[0]->we_htmldir . "/" .
			      $_[0]->{_parent}->project->name .
			      "_prototypes" },
     photodir        => sub { $_[0]->rootdir . "/photos" },
     pubhtmldir      => sub { $_[0]->rootdir },
     we_datadir      => sub { $_[0]->uprootdir . "/we_data" },
     scheme          => sub { "http" },
     livescheme      => sub { "http" },
    );
sub get {
    my($self, $key) = @_;
    if (!defined $self->{$key} && exists $paths_constructed_member{$key}) {
	$paths_constructed_member{$key}->($self);
    } else {
	$self->SUPER::get($key);
    }
}

######################################################################
package WEsiteinfo::SearchEngine;
use base qw(Class::Accessor);
# prelive_htdigconf and live_htdigconf is obsolete
__PACKAGE__->mk_accessors(qw(searchindexer htdigconf htdigconftemplate
			     prelive_htdigconf live_htdigconf
			     use_prelive_database));
sub new { bless {}, shift }

# Provide sensible defaults
my %searchengine_constructed_member =
    (searchindexer   => sub { "rundig" }, # XXX or htdig?
    );
sub get {
    my($self, $key) = @_;
    if (!defined $self->{$key} && exists $searchengine_constructed_member{$key}) {
	$searchengine_constructed_member{$key}->($self);
    } else {
	$self->SUPER::get($key);
    }
}

######################################################################
package WEsiteinfo::Staging;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(transport user password host directory
			     cgidirectory tempdirectory temp2directory
			     stagingext rsakey archivefile message));
sub new { bless {}, shift }

# Provide sensible defaults
my %staging_constructed_member =
    (directory       => sub { $_[0]->{_parent}->paths->liverootdir },
     cgidirectory    => sub { warn $_[0]->{_parent}->paths->livecgidir; $_[0]->{_parent}->paths->livecgidir },
    );
sub get {
    my($self, $key) = @_;
    if (!defined $self->{$key} && exists $staging_constructed_member{$key}) {
	$staging_constructed_member{$key}->($self);
    } else {
	$self->SUPER::get($key);
    }
}

######################################################################
package WEsiteinfo::Siteext;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(external_auth notify_mailer notify_background));
sub new { bless {}, shift }

######################################################################
package WEprojectinfo;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(name longname
			     sitelanguages editorlanguages pagetypes
			     defaulteditorlang cookieexpirationtime
			     productname templatefortype labelfortype
			     imagetypes imagesubtypes
			     iconfortype features projectext
			     class feclass
			     stagingexcept stagingexceptpat stagingextracgi
			     stagingadditional
			     adminmail developermail
			     sessionlocking useversioning
			     standardext
			    ));
sub new { bless {}, shift }

# Provide sensible defaults
my %projectinfo_constructed_member =
    (productname       => sub { "web.editor" },
     editorlanguages   => sub { [qw(de en)] },
     defaulteditorlang => sub { $_[0]->editorlanguages->[0] },
     cookieexpirationtime => sub { '+1d' },
     developermail     => sub { '[e-mail]' },
     standardext       => sub { ".html" }
    );

sub get {
    my($self, $key) = @_;
    if (!defined $self->{$key} && exists $projectinfo_constructed_member{$key}) {
	$projectinfo_constructed_member{$key}->($self);
    } elsif ($key eq 'features' && !exists $self->{features}) {
	return {};
    } elsif ($key eq 'longname' && !exists $self->{longname}) {
	return $self->{name};
    } elsif ($key =~ /^(?:sessionlocking|useversioning)$/) {
	return $self->get("features")->{$key};
    } else {
	$self->SUPER::get($key);
    }
}

sub set {
    my($self, $key, $val) = @_;
    if ($key =~ /^(?:sessionlocking|useversioning)$/) {
	return $self->{features}{$key} = $val;
    } else {
	$self->SUPER::set($key, $val);
    }
}

######################################################################
package WEsiteinfo;
use base qw(Exporter Class::Accessor);
__PACKAGE__->mk_accessors(qw(project paths searchengine staging debug siteext
			     liveconfig preliveconfig));
sub new { bless {}, shift }
@WEsiteinfo::EXPORT_OK = qw($c);

my %subobject = qw(project 1 paths 1 searchengine 1 staging 1 siteext 1);
sub set {
    my($self, $key, $val) = @_;
    if (exists $subobject{$key} && UNIVERSAL::isa($val, 'HASH')) {
	# provide "backlink" to parent object
	$val->{_parent} = $self;
    }
    $self->SUPER::set($key, $val);
}

1;

__END__