cvsuser 01/11/16 15:21:39
Added: P5EEx/Blue CHANGES MANIFEST Makefile.PL README TODO
P5EEx/Blue/P5EEx/Blue Config.pm Config.pod Context.pm
P5EE.pm datetime.pod podstyle.pod styleguide.pod
Log:
initial stuff
Revision Changes Path
1.1 p5ee/P5EEx/Blue/CHANGES
Index: CHANGES
===================================================================
#########################################
# CHANGE LOG
#########################################
1.1 p5ee/P5EEx/Blue/MANIFEST
Index: MANIFEST
===================================================================
CHANGES
MANIFEST
Makefile.PL
README
TODO
P5EEx/Blue/styleguide.pod
P5EEx/Blue/design.pod
P5EEx/Blue.pm
P5EEx/Blue/Config.pm
P5EEx/Blue/Context.pm
P5EEx/Blue/Context/CGI.pm
P5EEx/Blue/Config/XML.pm
P5EEx/Blue/Utils/Date.pm
P5EEx/Blue/Utils/HTML.pm
1.1 p5ee/P5EEx/Blue/Makefile.PL
Index: Makefile.PL
===================================================================
######################################################################
## File: $Id: Makefile.PL,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
%opts = (
'INSTALLDIRS' => 'perl',
'NAME' => 'P5EEx-Blue',
'DISTNAME' => 'P5EEx-Blue',
'VERSION' => '0.01',
'PMLIBDIRS' => [ 'P5EEx', ],
'linkext' => { LINKTYPE=>'' }, # no link needed
'dist' => {'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',
'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'}
);
######################################################################
# PREFIX
######################################################################
# I like setting the PREFIX variable in the environment,
# so I write my Makefile.PL to use it as a valid alternative
# to specifying it on the command line with
# "perl Makefile.PL PREFIX=/usr/foo".
if ($ENV{PREFIX}) {
$PREFIX = $ENV{PREFIX};
$opts{PREFIX} = $PREFIX;
}
else {
$PREFIX = "/usr/local";
}
######################################################################
# HTML FILES
######################################################################
if ($ENV{HTMLDIR}) {
$HTMLDIR = $ENV{HTMLDIR};
}
else {
$HTMLDIR = "$PREFIX/htdocs/api";
}
$opts{'INST_HTMLLIBDIR'} = 'htdocs'; # local build area
$opts{'INSTALLHTMLPRIVLIBDIR'} = "$HTMLDIR/$opts{NAME}"; # install area
######################################################################
# CGI SCRIPTS
######################################################################
if ($ENV{CGIDIR}) {
$CGIDIR = $ENV{CGIDIR};
}
else {
$CGIDIR = "$PREFIX/cgi-bin";
}
$opts{'INST_HTMLSCRIPTDIR'} = 'cgi-bin'; # local build area
$opts{'INSTALLHTMLSCRIPTDIR'} = "$CGIDIR/$opts{NAME}"; # install area
######################################################################
# TEMPLATES
######################################################################
if ($ENV{TEMPLATEDIR}) {
$TEMPLATEDIR = $ENV{TEMPLATEDIR};
}
else {
$TEMPLATEDIR = "$PREFIX/templates";
}
$opts{'INST_SCRIPT'} = 'templates'; # local build area
$opts{'INSTALLSCRIPT'} = "$TEMPLATEDIR/$opts{NAME}"; # install area
######################################################################
# MAKE THE MAKEFILE
######################################################################
WriteMakefile(%opts);
sub MY::postamble {
return <<'EOF';
all ::
@#rm -f $(INSTALLHTMLSCRIPTDIR)/cgi.conf
@#mkdir -p $(INSTALLHTMLSCRIPTDIR)
@#echo "perlinc = $(INSTALLPRIVLIB)" > $(INSTALLHTMLSCRIPTDIR)/cgi.conf
@#echo "templatedir = $(INSTALLSCRIPT)" >> $(INSTALLHTMLSCRIPTDIR)/cgi.conf
@#[ -f $(PREFIX)/.prefixvars ] && cat $(PREFIX)/.prefixvars >>
$(INSTALLHTMLSCRIPTDIR)/cgi.conf
EOF
}
1.1 p5ee/P5EEx/Blue/README
Index: README
===================================================================
######################################################################
## File: $Id: README,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
WHAT IS THIS?
This is the Perl 5 Enterprise Extensions (P5EE) distribution.
For more information, see the web pages and join the mailing list at
[EMAIL PROTECTED]
HOW DO I INSTALL IT?
To install this module, cd to the directory that contains this README
file and type the following:
perl Makefile.PL
make
make test
make install
1.1 p5ee/P5EEx/Blue/TODO
Index: TODO
===================================================================
######################################################################
## File: $Id: TODO,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
====================================
= TODO
====================================
Envisioned P5EE Components
o P5EE::Standard - Mainly documentation about modules that P5EE relies on.
o P5EE::Config - Configuration for all the other modules
o P5EE::Authen - Authentication
o P5EE::Authz - Authorization
Features
o none yet
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Config.pm
Index: Config.pm
===================================================================
######################################################################
## $Id: Config.pm,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
package P5EEx::Blue::Config;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use strict;
# NOTE: The pod material has been separated out to Config.pod because
# MakeMaker ignores files matching /(config|setup).*.pm/
######################################################################
# CONSTANTS
######################################################################
######################################################################
# ATTRIBUTES
######################################################################
# INPUTS FROM THE ENVIRONMENT
######################################################################
# CONSTRUCTOR
######################################################################
sub new {
my ($this) = @_;
my ($class, $self);
$class = ref($this) || $this;
# bootstrap phase: bless an empty hash
$self = {};
bless $self, $class;
# load phase: replace empty hash with loaded hash
$self = $self->load();
bless $self, $class;
$self->init(); # allows a subclass to override this portion
return $self;
}
# available for subclasses to override
sub init {
my $self = shift;
}
sub load {
local(*FILE);
my ($file, @perl, $perl, $conf, $open);
$file = $0;
$file =~ s!\.[^/]*$!!;
$file .= ".pl";
$conf = {};
$open = open(main::FILE,"< $file");
$open = open(main::FILE,"< widget.pl") if (!$open);
if ($open) {
@perl = <main::FILE>;
close(main::FILE);
$perl = join("",@perl);
eval($perl);
print STDERR "CONFIGURATION SYNTAX ERROR: $@\n" if ($@);
}
$conf;
}
######################################################################
# METHODS
######################################################################
use Data::Dumper;
sub dump {
my $self = shift;
my $d = Data::Dumper->new([ $self ], [ "data" ]);
$d->Indent(1);
return $d->Dump();
}
sub print {
my $self = shift;
print $self->dump();
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Config.pod
Index: Config.pod
===================================================================
######################################################################
## $Id: Config.pod,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
=head1 NAME
P5EEx::Blue::Config - Static site configuration data (used internally to the library)
=head1 SYNOPSIS
use P5EEx::Blue::Config;
$config = P5EEx::Blue::Config->new();
$config = P5EEx::Blue::Config->new("file" => $file);
$config = P5EEx::Blue::Config->new("file" => $file, "configClass" =>
"P5EEx::Blue::Config::XML");
print $config->dump(), "\n"; # use Data::Dumper to spit out the Perl
representation
$config->print($fh); # print out a config file
$config->overlay($config2); # merge the two config structures using
overlay rules
$config->overlay($config1, $config2); # merge $config2 onto $config1
# The configuration for each component within P5EEx::Blue will be located
# in the first level under the hash ref.
$config->{Standard} # config settings for the Standard component
$config->{Config} # config settings for the Config component
$config->{Auth} # config settings for the Auth component
# The default driver (if "configClass" not supplied) reads in a Perl
# data structure from the file. Alternate drivers can read a Storable,
# unvalidated XML, DTD-validated XML, RDF-validated XML, or any other
# file format or data source anyone cares to write a driver for.
$conf = { # must be named $conf
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee',
}
},
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => '303292',
},
};
# A comparable XML file would look like this.
<conf>
<Standard>
<Log-Dispatch logdir="/var/p5ee"/>
</Standard>
<Authen passwd="/etc/passwd" seed="303292"/>
</conf>
# A comparable properties file (.ini) would look like this.
[Standard.Log-Dispatch]
logdir = /var/p5ee
[Authen]
passwd = /etc/passwd
seed = 303292
=head1 DESCRIPTION
P5EEx::Blue::Config is the class which represents data which is configured
at application deployment time.
The P5EEx::Blue::Config class is a very thin code wrapper around a perl
data structure. The other P5EEx::Blue::* classes are "friends" (in a C++ sense)
in that they can (and usually do) access the configuration data directly
from the perl structure (without using special methods to do so).
The main function of the class is to load the data into the right structure
from an appropriately formatted configuration file.
There are also some helper functions.
A P5EEx::Blue::Config object is essentially read-only.
However, there may be some cases where data which is entirely derivable
from other data in the P5EEx::Blue::Config object may be stored there so
that the next time it is requested, it does not need to be derived
again.
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm
Index: Context.pm
===================================================================
######################################################################
## $Id: Context.pm,v 1.1 2001/11/16 23:21:38 spadkins Exp $
######################################################################
package P5EEx::Blue::Context;
use strict;
use Widget;
use CGI;
=head1 NAME
P5EEx::Blue::Context - Controller for sets of widgets in a CGI environment
=head1 SYNOPSIS
my ($wc, $widget, @widgets);
# ... official way to get a Controller object ...
use Widget;
$wc = Widget->controller(); # make factory which knows the
config info
$wc->dispatch_events();
$wc = Widget->controller("P5EEx::Blue::Context"); # use other than the
autodetected controller
print "wc is of type: ", ref($wc), "\n"; # should be the Controller class
instantiated
# ... alternative way (used internally) ...
use P5EEx::Blue::Context;
$wc = P5EEx::Blue::Context->new();
print "wc is of type: ", ref($wc), "\n"; # should be the Controller class
instantiated
# the rest represents what might be done with the resulting widget controller
$widget = $wc->widget("birth_dt"); # gets a widget
print $widget->html(), "\n"; # this works for an HTML widget
# or more generally... (maybe one day we will have Widget::Tk, Widget::Curses,
etc.?)
push(@widgets, $widget); # add widget to a list of widgets
$wc->display(@widgets); # controller renders list of widgets
on display
=cut
######################################################################
# CONSTANTS
######################################################################
######################################################################
# ATTRIBUTES
######################################################################
# $self->{widget} # {} cache of widgets (by widgetName)
# $self->{widgetconfig} # {} cache of widget configuration information (by
widgetName)
# $self->{messages} # "" HTML text (?) derived from the event handling
#
# MAJOR SECTIONS OF THE config STRUCTURE
# $self->{config} # {} global, read-only, config information
# $self->{config}{repository} # {} accessible repositories for data retrieval
# $self->{config}{domain} # {} domains of value/label pairs
# $self->{config}{widgetType} # {} widget configs ready for use in a widget
# $self->{config}{widget} # {} widget config info
#
# MAJOR SECTIONS OF THE state STRUCTURE
# $self->{state} # {} dynamic state
# $self->{state}{org} # {} dynamic state (for the user's current org)
# $self->{state}{user} # {} dynamic state (for the current user)
# $self->{state}{widget} # {} dynamic state (for the current state for each
widget)
# INPUTS FROM THE ENVIRONMENT
=head1 DESCRIPTION
This is a controller class for widgets running in a CGI environment.
=cut
######################################################################
# CONSTRUCTOR
######################################################################
sub new {
my ($this, $args) = @_;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
Widget->dbgprint("$class->new(" . join(", ",%$args) . ")")
if ($Widget::DEBUG && Widget->dbg(ref($self),"new"));
$self->{widget} = {}; # initialize empty cache of widgets
$self->{widgetconfig} = {}; # initialize empty cache of their effective config
my ($config_class, $state_class);
$config_class = $args->{config};
$config_class = "Widget::Config" if (!defined $config_class || $config_class
eq "");
$state_class = $args->{state};
$state_class = "Widget::State" if (!defined $state_class || $state_class eq
"");
$self->{config} = Widget->create($config_class, $args);
$self->{state} = Widget->create($state_class, $args);
# create the pseudo-widget "global" only as a widgetconfig
$self->{widgetconfig}{global}{lang} = "en_us";
# create the pseudo-widget "session"
$self->widget(
-name => "session",
-widgetClass => "Widget::Base",
-container => "global",
);
$self->init($args);
return $self;
}
# override this method to get custom constructor functionality
sub init {
my ($self, $args) = @_;
}
######################################################################
# METHODS
######################################################################
sub add_message {
my ($self, $msg) = @_;
if (defined $self->{messages}) {
$self->{messages} .= "<br>" . $msg;
}
else {
$self->{messages} = $msg;
}
}
# NOTE: This is a key method to override in the driver classes
sub dispatch_events {
my ($self, $eventarray) = @_;
# TODO: implement a default handler here
# $self->widget($name)->handle_event($ename, $event, @args);
}
# NOTE: This is a key method to override in the driver classes
sub display {
my $self = shift;
my ($widget);
foreach $widget (@_) {
$widget->display();
}
}
sub user {
my $self = shift;
"guest"; # improve this over time
}
sub state {
$_[0]->{state};
}
sub repository {
my ($self, $repname) = @_;
my ($config, $repdef, $instance, $key, $global, $var);
my ($class, $method, $args, @args, $argidx);
$repname = "db" if (!defined $repname || $repname eq "");
Widget->dbgprint("P5EEx::Blue::Context->repository($repname)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"repository"));
$config = $self->{config};
$repdef = $config->{repository}{$repname};
return undef if (!defined $repdef);
$instance = $self->{repository}{$repname};
if (! defined $instance) {
if ($repdef->{import}) {
$global = $self->{widgetconfig}{global};
foreach $key (keys %$repdef) {
$repdef->{$key} = $global->{$key} if (defined $global->{$key});
}
}
$class = $repdef->{class};
if (defined $class) {
$method = $repdef->{newmethod};
$method = "new" if (!defined $method);
$args = $repdef->{newmethod_args};
$args = [] if (!defined $args || ref($args) ne "ARRAY");
@args = @$args;
for ($argidx = 0; $argidx <= $#$args; $argidx++) {
if ($args->[$argidx] =~ /^\{(.+)\}$/) {
$var = $1;
if ($var eq "config") {
$args[$argidx] = $config;
}
elsif ($var eq "repconfig") {
$args[$argidx] = $repdef;
}
elsif (defined $repdef->{$var}) {
$args[$argidx] = $repdef->{$var};
}
}
}
Widget->dbgprint("P5EEx::Blue::Context->repository($repname):
$class->$method(@$args)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"repository"));
Widget->use($class);
$instance = $class->$method(@args);
$self->{repository}{$repname} = $instance;
}
}
$instance;
}
sub shutdown {
my $self = shift;
my ($config, $repdef, $repname, $instance);
my ($class, $method, $args, $argidx);
Widget->dbgprint("P5EEx::Blue::Context->shutdown()")
if ($Widget::DEBUG && Widget->dbg(ref($self),"shutdown"));
$config = $self->{config};
if (defined $self->{repository} && ref($self->{repository}) eq "HASH") {
foreach $repname (keys %{$self->{repository}}) {
$instance = $self->{repository}{$repname};
$repdef = $config->{repository}{$repname};
$method = $repdef->{finishmethod};
$method = "disconnect" if (!defined $method);
Widget->dbgprint("P5EEx::Blue::Context->shutdown():
$instance->$method()")
if ($Widget::DEBUG && Widget->dbg(ref($self),"shutdown"));
$instance->$method();
delete $self->{repository}{$repname};
}
}
}
sub domain {
my ($self, $domain) = @_;
my ($config, $domainref, $repository, $rep);
my ($values, $labels, $needs_loading, $time_to_live, $time);
my ($class, $method, $args, $rows, $row);
Widget->dbgprint("P5EEx::Blue::Context->domain($domain)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"domain"));
$config = $self->{config};
$domainref = $config->{domain}{$domain};
if (defined $domainref) {
$values = $domainref->{values};
$labels = $domainref->{labels};
$needs_loading = 0;
$repository = $domainref->{repository};
if (defined $repository && $repository ne "") {
if (!defined $values || !defined $labels) {
$needs_loading = 1;
}
else {
$time_to_live = $domainref->{time_to_live};
if (defined $time_to_live && $time_to_live ne "" && $time_to_live >=
0) {
if ($time_to_live == 0) {
$needs_loading = 1;
}
else {
if (time() >= $domainref->{time} + $time_to_live) {
$needs_loading = 1;
}
}
}
}
}
Widget->dbgprint("P5EEx::Blue::Context->domain($domain):
needs_loading=$needs_loading")
if ($Widget::DEBUG && Widget->dbg(ref($self),"domain"));
if ($needs_loading) {
$rep = $self->repository($repository);
if (defined $rep) {
$method = $domainref->{getmethod};
$method = "get" if (!defined $method);
$args = $domainref->{getmethod_args};
$args = [ $domain ] if (!defined $args);
Widget->dbgprint("P5EEx::Blue::Context->domain($domain):
$rep->$method(@$args)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"domain"));
$rows = ${rep}->${method}(@$args);
$values = [];
$labels = {};
foreach $row (@$rows) {
push(@$values, $row->[0]);
$labels->{$row->[0]} = $row->[1];
}
$domainref->{values} = $values;
$domainref->{labels} = $labels;
$time = time();
$domainref->{time} = $time;
}
}
$values = $domainref->{values};
$labels = $domainref->{labels};
}
$values = [] if (! defined $values);
$labels = {} if (! defined $labels);
return ($values, $labels);
}
# The widget config is a simple hash which is the result of several
# complementary sources:
# 1. config of the widget (in Config) (which override widgetType)
# 2. optional config of the widget's widgetType (in Config)
# 3. config of container widget
# 4. args to the widget_config() call, usually coming from the widget constructor
# some of these are defaults, other are overrides
# NOTES;
# * we don't want to copy *all* attributes of container config, so
# we need a list of "absorbable" attributes
# * all widget configuration happens before instantiation
# this allows you to override the widgetClass in time for instantiation
# * widget_config's are cached in the Controller because the controller
# needs to know the configuration before it can instantiate the widget.
# * A reference to this config is kept by the widget for its own convenience.
# Usage: $config = $wc->widget_config("last_name");
sub widget_config {
my ($self, $name, $args) = @_;
my ($confroot, $config, $readonly_config, $state, $widgetType, $attrib,
$override);
my ($new_config);
Widget->dbgprint("P5EEx::Blue::Context->widget_config($name, " . join(",
",(defined $args)?%$args:"") . ")")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget_config",3));
if (defined $self->{widgetconfig}{$name}) {
$config = $self->{widgetconfig}{$name};
$new_config = 0;
$state = $self->{state}{widget}{$name};
$state = {} if (!defined $state);
}
else {
################################################################
# set up the {config} and {state} hashrefs
################################################################
$config = {};
$self->{widgetconfig}{$name} = $config;
$new_config = 1;
$state = $self->{state}{widget}{$name};
$state = {} if (!defined $state);
################################################################
# start with runtime state for the widget from the state data
################################################################
%$config = %$state;
$config->{name} = $name;
################################################################
# overlay with attributes from the (read-only) config file
################################################################
$confroot = $self->{config};
$readonly_config = $confroot->{widget}{$name};
foreach $attrib (keys %$readonly_config) {
# include config attributes only if not provided in the state
if (!defined $config->{$attrib}) {
$config->{$attrib} = $readonly_config->{$attrib};
}
}
################################################################
# overlay with attributes from the "widgetType"
################################################################
$widgetType = $config->{widgetType};
if ($widgetType) {
$readonly_config = $confroot->{widgetType}{$widgetType};
foreach $attrib (keys %$readonly_config) {
# include widgetType configs only if not provided in the widget
configs
if (!defined $config->{$attrib}) {
$config->{$attrib} = $readonly_config->{$attrib};
}
}
}
}
my ($lightweight);
$lightweight = ($name =~ /[\[\]\{\}]/);
####################################################################
# include defaults/overrides from args to $wc->widget($name, $args);
####################################################################
if (defined $args && ref($args) eq "HASH") { # ... args were provided
$override = $args->{override}; # don't override by default
################################################################
# take care of attributes associated with widgetType first
################################################################
if ($args->{widgetType} &&
($override || !defined $config->{widgetType})) {
$widgetType = $args->{widgetType};
if (!$config->{widgetType} || $widgetType ne $config->{widgetType}) {
$readonly_config = $confroot->{widgetType}{$widgetType};
foreach $attrib (keys %$readonly_config) {
if (!defined $config->{$attrib} || $override) {
$config->{$attrib} = $readonly_config->{$attrib};
}
}
}
}
################################################################
# take care of all %$args attributes next
################################################################
foreach $attrib (keys %$args) {
# don't include the entry which says whether we are overriding or not
next if ($attrib eq "override");
# include attrib if overriding OR attrib not provided in the widget
configs already
if (!defined $config->{$attrib} ||
($override && $config->{$attrib} ne $args->{$attrib})) {
$config->{$attrib} = $args->{$attrib};
# don't store state for lightweight widgets
$state->{$attrib} = $args->{$attrib} if (! $lightweight);
}
Widget->dbgprint("Controller->widget_config() [arg=$attrib] name=$name
lw=$lightweight ovr=$override",
" config=", $config->{$attrib},
" state=", $state->{$attrib},
" args=", $args->{$attrib})
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget_config",6));
}
}
####################################################################
# infer a container (if none supplied, by the dots in the "name")
####################################################################
if (! defined $config->{container}) {
if ($name =~ /^(.+)\./) {
$config->{container} = $1;
}
elsif ($name eq "session") {
$config->{container} = "global";
}
elsif ($name ne "global") {
$config->{container} = "session";
}
if (defined $config->{widgetClass}) {
Widget->use($config->{widgetClass}); # load the perl code
$config->{absorbable_attribs} =
$config->{widgetClass}->absorbable_attribs();
}
}
# absorb attributes of the container config if ...
# TODO: sort out whether we need to absorb attributes more often
# (i.e. push model rather than a pull model)
if ($new_config && # ... it is the first time through
$config->{container} && # ... a container exists
$config->{absorbable_attribs}) { # ... there are known attributes to
absorb
my ($container, $container_config, $absorbable_attribs);
$container = $config->{container};
$container_config = $self->widget_config($container); # notice a recursion
here on containers
$absorbable_attribs = $config->{absorbable_attribs};
if (ref($absorbable_attribs) eq "") {
$absorbable_attribs = [ split(/ *, */,$absorbable_attribs) ];
}
if (ref($absorbable_attribs) eq "ARRAY") {
foreach $attrib (@$absorbable_attribs) {
if (!defined $config->{$attrib}) { # incorporate only if from no
other source
$config->{$attrib} = $container_config->{$attrib};
}
}
}
}
if (!defined $self->{state}{widget}{$name} && !$lightweight && (%$state)) {
$self->{state}{widget}{$name} = $state;
}
Widget->dbgprint("P5EEx::Blue::Context->widget_config($name) = [" . join(",
",(defined $config)?%$config:"") . "]")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget_config",3));
return $config;
}
# Usage: $widget = $wc->widget("first_name");
sub widget {
my $self = shift;
Widget->dbgprint("P5EEx::Blue::Context->widget(" . join(", ",@_) . ")")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget",3));
my ($args);
my ($name, $widget, $config, $class, $oldclass);
if ($#_ == -1) {
return undef; # we need at least a name
}
elsif (ref($_[0]) eq "HASH") {
$args = shift;
$name = $args->{name};
}
elsif ($_[0] =~ /^-/) {
$args = {};
my ($i, $var);
for ($i = 0; $i < $#_; $i += 2) {
$var = $_[$i];
$var =~ s/^-//;
$args->{$var} = $_[$i+1];
}
$name = $args->{name};
}
else {
$name = $_[0];
$args = $_[1];
# no other positional args for this class
}
Widget->dbgprint("P5EEx::Blue::Context->widget: name=[$name]")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget",3));
return undef if (! defined $name); # we need a name!
$config = $self->widget_config($name, $args);
Widget->dbgprint("P5EEx::Blue::Context->widget: returned from widget_config()")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget",3));
$class = $config->{"widgetClass"};
if (!defined $class || $class eq "") {
if ($name ne "global") {
$class = "Widget::HTML::TextField";
$config->{"widgetClass"} = $class;
$config->{backgroundColor} = "#ffcccc";
}
}
# NOTE: This does not allow widgets to change their class during execution
# i.e. once the widget is instantiated as a particular class, it is stored
# in the cache and never instantiated again. I think this is what we want.
# I could conceivably allow a widget to change its class. Then it would
# need to get reinstantiated as the new class, but I don't think this is
# what we want.
$widget = $self->{widget}{$name}; # check the cache
if (!defined $widget) {
Widget->dbgprint("P5EEx::Blue::Context->widget(): creating new widget (not
in cache)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget",3));
if (defined $class && $class ne "") {
Widget->use($class);
$widget = $class->new($name,$self,1);
}
else {
$widget = {};
$widget->{name} = $name;
$widget->{controller} = $self;
}
$self->{widget}{$name} = $widget;
}
Widget->dbgprint("P5EEx::Blue::Context->widget() = $widget")
if ($Widget::DEBUG && Widget->dbg(ref($self),"widget",3));
return $widget;
}
sub get_table_cell {
my ($self, $table, $rowkey, $colname) = @_;
my ($tablehash, $rowidx, $colidx);
$tablehash = $self->{config}{table}{$table};
return undef if (!defined $tablehash);
$rowidx = $tablehash->{rowindex}{$rowkey};
$colidx = $tablehash->{colindex}{$colname};
return "" if (!defined $rowidx || !defined $colidx);
return $tablehash->{data}[$rowidx][$colidx];
}
# $self->set("{arr}[1][2]", 14);
# $self->set("{arr.totals}[1][2]", 14);
#sub set {
# my ($self, $var, $value) = @_;
# my ($perl);
#
# if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
# $self->{$var} = $value;
# return;
# } # match {
# elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
# $var = $1;
# $self->{$var} = $value;
# return;
# } # match {
#
# $var =~ s/\{([^\}]+)\}/\{"$1"\}/g;
# $perl = "\$self->$var = \$value;";
# eval $perl;
# print STDERR "ERROR: P5EEx::Blue::Context->set($var,$value): eval ($perl):
$@\n" if ($@);
# return $value;
#}
sub wget_value {
my ($self, $name, $default, $setdefault) = @_;
my ($wname, $var, $value);
if ($name =~ /^(.+)\.([^\.]+)$/) {
$wname = $1;
$var = $2;
$value = $self->{widgetconfig}{$wname}{$var};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{state}{widget}{$wname}{$var} = $value;
$self->widget_config($wname) if (!defined
$self->{widgetconfig}{$wname});
$self->{widgetconfig}{$wname}{$var} = $value;
}
}
}
else {
$value = $self->{widgetconfig}{session}{$name};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{state}{widget}{session}{$name} = $value;
$self->{widgetconfig}{session}{$name} = $value;
}
}
}
return $value;
}
sub wset_value {
my ($self, $name, $value) = @_;
my ($wname, $var);
if ($name =~ /^(.+)\.([^\.]+)$/) {
$wname = $1;
$var = $2;
$self->{state}{widget}{$wname}{$var} = $value;
$self->widget_config($wname) if (!defined $self->{widgetconfig}{$wname});
$self->{widgetconfig}{$wname}{$var} = $value;
}
else {
$self->{state}{widget}{session}{$name} = $value;
$self->{widgetconfig}{session}{$name} = $value;
}
}
# $self->set("{arr}[1][2]", 14);
# $self->set("{arr.totals}[1][2]", 14);
sub wset {
my ($self, $name, $var, $value) = @_;
my ($perl, $multiple);
Widget->dbgprint("P5EEx::Blue::Context->wget($name,$var,$value)")
if ($Widget::DEBUG && Widget->dbg(ref($self),"wset",3));
if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
$self->{state}{widget}{$name}{$var} = $value;
$self->widget_config($name) if (!defined $self->{widgetconfig}{$name});
$self->{widgetconfig}{$name}{$var} = $value;
return;
} # match {
elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
$var = $1;
$self->{state}{widget}{$name}{$var} = $value;
$self->widget_config($name) if (!defined $self->{widgetconfig}{$name});
$self->{widgetconfig}{$name}{$var} = $value;
return;
} # match {
$self->widget_config($name) if (!defined $self->{widgetconfig}{$name});
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
$perl = "\$self->{state}{widget}{\$name}$var = \$value;
\$self->{widgetconfig}{\$name}$var = \$value;";
eval $perl;
print STDERR "ERROR: P5EEx::Blue::Context->wset($name,$var,$value): eval
($perl): $@\n" if ($@);
return $value;
}
sub wget {
my ($self, $name, $var, $default, $setdefault) = @_;
my ($perl, $value);
if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
$value = $self->{widgetconfig}{$name}{$var};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{state}{widget}{$name}{$var} = $value;
$self->widget_config($name) if (!defined
$self->{widgetconfig}{$name});
$self->{widgetconfig}{$name}{$var} = $value;
}
}
Widget->dbgprint("P5EEx::Blue::Context->wget($name,$var) (value) = [$value]")
if ($Widget::DEBUG && Widget->dbg(ref($self),"wget",3));
return $value;
} # match {
elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
$var = $1;
$value = $self->{widgetconfig}{$name}{$var};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{state}{widget}{$name}{$var} = $value;
$self->widget_config($name) if (!defined
$self->{widgetconfig}{$name});
$self->{widgetconfig}{$name}{$var} = $value;
}
}
Widget->dbgprint("P5EEx::Blue::Context->wget($name,$var) (attrib) =
[$value]")
if ($Widget::DEBUG && Widget->dbg(ref($self),"wget",3));
return $value;
} # match {
$self->widget_config($name) if (!defined $self->{widgetconfig}{$name});
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g;
$perl = "\$value = \$self->{widgetconfig}{\$name}$var;";
eval $perl;
print STDERR "ERROR: Widget::Base->get($var): eval ($perl): $@\n" if ($@);
Widget->dbgprint("P5EEx::Blue::Context->wget($name,$var) (indexed) = [$value]")
if ($Widget::DEBUG && Widget->dbg(ref($self),"wget",3));
return $value;
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/P5EE.pm
Index: P5EE.pm
===================================================================
#############################################################################
## $Id: P5EE.pm,v 1.1 2001/11/16 23:21:38 spadkins Exp $
#############################################################################
package P5EEx::Blue::P5EE;
use strict;
# eliminate warnings about uninitialized values
$SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /Use of uninitialized value/ };
use Date::Parse;
use Date::Format;
=head1 NAME
P5EEx::Blue::P5EE - Backplane for core P5EE services
=head1 SYNOPSIS
use P5EEx::Blue::P5EE;
# CONTEXT: SINGLETON ACCESS TO EXTERNAL ENVIRONMENT (cmd, CGI, mod_perl)
my ($c);
$c = P5EEx::Blue::P5EE->context();
$c = P5EEx::Blue::P5EE->context( # or you can specify any context class...
contextClass => "P5EEx::Blue::Context::CGI",
);
# CONVENIENCE ACCESS TO THE USER'S CONFIGURATION (via Context)
$config = P5EEx::Blue::P5EE->config(); # returns a hashref to config data
# FOUNDATION FOR A PLUGIN ARCHITECTURE
$obj = P5EEx::Blue::P5EE->object($type, $name, @args);
@retvals = P5EEx::Blue::P5EE->send($type, $name, $method, @args);
=head1 DESCRIPTION
The P5EEx::Blue::P5EE module is the module in from which core services are
called.
=head1 REQUIREMENTS
=head1 DESIGN
=cut
#############################################################################
# CONSTANTS
#############################################################################
#############################################################################
# ATTRIBUTES
#############################################################################
# INPUTS FROM THE ENVIRONMENT
=head1 DESCRIPTION
P5EEx::Blue::P5EE.pm is a convenience package for static methods for the
Perl P5EEx::Blue::P5EE Library. It also serves as a factory class,
producing objects whose class is driven by configuration
rather than being known at development time.
=cut
#############################################################################
# FACTORY
#############################################################################
$P5EEx::Blue::P5EE::DEBUG = 0 if (!defined $P5EEx::Blue::P5EE::DEBUG);
# The P5EEx::Blue::P5EE->new() method is *not* a constructor for a P5EEx::Blue::P5EE
class.
# It is simply a synonym for "P5EEx::Blue::P5EE->context()", which is a
# factory-style constructor for a class derived from P5EEx::Blue::Context.
# This is done for the sake of tools like the Template Toolkit, so
# that usage like [% USE wc = P5EEx::Blue::P5EE %] works.
sub new {
my $self = shift;
$self->context(@_);
}
my ($default_context); # singleton
sub context {
my $self = shift;
my ($args, $context);
if ($#_ == -1) {
$args = {};
}
elsif (ref($_[0]) eq "HASH") {
$args = shift;
}
elsif ($_[0] =~ /^-/) {
$args = {};
my ($i, $var);
for ($i = 0; $i < $#_; $i += 2) {
$var = $_[$i];
$var =~ s/^-//;
$args->{$var} = $_[$i+1];
}
}
else {
$args = {};
# no positional args for this method
}
if (! $args->{context}) {
if (defined $ENV{"P5EE_CONTEXT_CLASS"}) { # env variable set?
$args->{context} = $ENV{"P5EE_CONTEXT_CLASS"};
}
else { # try autodetection ...
my $gateway = $ENV{"GATEWAY_INTERFACE"};
if (defined $gateway && $gateway =~ /CGI-Perl/) { # running under
mod_perl?
$args->{context} = "P5EEx::Blue::Context::Modperl";
}
elsif ($ENV{"HTTP_USER_AGENT"}) { # running as CGI script?
$args->{context} = "P5EEx::Blue::Context::CGI";
$args->{state} = "P5EEx::Blue::State::CGI";
}
# let's be real... these next two are not really critical right now
#elsif ($ENV{"DISPLAY"}) { # running with an X DISPLAY var set?
# $args->{context} = "P5EEx::Blue::Context::Gtk";
#}
#elsif ($ENV{"TERM"}) { # running with a TERM var to support
Curses?
# $args->{context} = "P5EEx::Blue::Context::Curses";
#}
else { # fall back to CGI, because it works
OK in command mode
$args->{context} = "P5EEx::Blue::Context::CGI";
$args->{state} = "P5EEx::Blue::State::CGI";
}
}
}
if (!defined $args->{config} || $args->{config} eq "") {
if (defined $ENV{"P5EE_CONFIG_CLASS"}) {
$args->{config} = $ENV{"P5EE_CONFIG_CLASS"};
}
}
$context = $self->create($args->{context}, $args);
$default_context = $context if (!defined $default_context);
return $context;
}
sub default_context {
my $self = shift;
return ($default_context) if (defined $default_context);
return P5EEx::Blue->context(@_);
}
sub create {
my $self = shift;
my $class = shift;
eval("use $class;");
return undef if ($@);
return $class->new(@_);
}
#############################################################################
# METHODS
#############################################################################
sub current_directory {
eval("use Cwd;");
cwd();
}
sub command {
my $cmd = $0;
$cmd =~ s!^\.\/!!;
return $cmd;
}
#############################################################################
# DEBUG SUPPORT
#############################################################################
sub dbg {
my ($self, $class, $method, $level) = @_;
return 0 if (! $P5EEx::Blue::DEBUG); # if DEBUG is off, no debug
output should be created
return 0 if (defined $level && $P5EEx::Blue::DEBUG < $level); # if DEBUG level
is higher, no debug output
return 1 if (! defined $P5EEx::Blue::DEBUGSCOPE); # else, if no DEBUGSCOPE is
defined, we are debugging everything
return 1 if (! defined $class); # else, if no class was
specified, go ahead and debug it
return 1 if (defined $P5EEx::Blue::DEBUGSCOPE->{$class}); # else, if in the
scope specified, debug it
return 0 if (! defined $method); # else, if no method was
specified, suppress debug output
return 1 if (defined $method && defined
$P5EEx::Blue::DEBUGSCOPE->{"$class.$method"}); # else, debug if in scope
return 0; # else, suppress debug output
}
sub dbgprint {
my $self = shift;
print STDOUT @_, "\n";
#print "<!-- ", @_, " -->\n";
#print STDERR @_, "\n";
#local (*FILE);
#if (open(main::FILE, ">> debug.out")) {
# print main::FILE $self->now(), " ", @_, "\n";
# close(main::FILE);
#}
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/datetime.pod
Index: datetime.pod
===================================================================
#!perl -w
# run this document through perl to check its syntax
use Pod::Checker;
podchecker(\*DATA);
__END__
=head1 NAME
P5EE Date and Time Considerations
=head1 INTRODUCTION
Most Enterprise development includes processing of dates and times.
There are many date and time modules on CPAN, and choosing the right
one can be confusing.
API's for dates and times are not part of P5EE,
so some direction is needed.
This document represents the recommendations and collective wisdom
from the P5EE developers.
The short answer is that we recommend the following
for most common date and time operations.
Class::Date
Class::Date::Rel
However, other modules are appropriate in certain circumstances.
So for the longer answer, read on.
=head1 PERL 5 LANGUAGE SUPPORT
The native Perl 5 datetime type is an integer.
It is not different from other integers in any way other than
how it is used.
It represents the number of non-leap seconds since
January 1, 1970 UTC (the "Epoch" at GMT). The following internal
Perl function gets the current time.
$current_time = time;
$current_time = time();
Other Perl functions that return this "datetime" integer are
($dev, $ino, $mode, $nlink, $uid, $gid, $redev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat($filename);
($dev, $ino, $mode, $nlink, $uid, $gid, $redev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = lstat($filename);
where $atime, $mtime, and $ctime are the same kind of integers,
representing the access time, modification time, and change time
of a file.
These $time values may be converted to human-readable
form using the following internal perl functions.
(See the "perlfunc" man page for more information.)
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
Furthermore, the current time zone needs to be accessed through
the environment variable, "TZ".
$timezone = $ENV{TZ};
This leaves the Perl developer with lots of work to do in order to
process dates.
=over
=item * Formatting dates for output
=item * Parsing dates on input
=item * Comparing dates
=item * Date math (addition, subtraction)
=item * Other calendar-specific functions (i.e. holidays, days of week, etc)
=back
Numerous modules have been posted to CPAN allowing the Perl developer
to accomplish these tasks.
However, they have pros and cons related to the
following features.
=over
=item * Internationalization
=item * Speed
=item * Portability
=item * Ranges of Dates Supported
=item * Compliance with Perl Styleguide (function naming)
=back
=head1 FUNCTIONAL SOLUTIONS
Modules exist to allow you to process integers like those
returned by the time() function. They do not create "date" objects
with methods. They simply provide functions that allow you do the
required tasks.
=head2 Date::Parse, Date::Format
http://search.cpan.org/search?module=Date::Parse
http://search.cpan.org/search?module=Date::Format
Very simple, clean functions for parsing text dates and formatting
them for output in a variety of ways. The fact that these modules
work with integers implies that you can do date comparisons and
some degree of date math simply ($tomorrow = $today + 24*60*60;).
* Parses many different formats of dates
* Flexible formatting using POSIX strftime() format specifiers.
* Limited internationalization support.
* Limited date math support.
* Unknown support for dates outside [1970-2038]
=head2 Date::Calc
http://search.cpan.org/search?module=Date::Calc
Powerful, fast manipulation of dates.
* No explicit support for parsing or formatting dates.
* Non-perlstyle function names (internal caps, as in Add_Delta_YMD())
* Powerful, fast support for date math
* Support for all A.D. dates [1-9999]
=head2 Date::Manip
http://search.cpan.org/search?module=Date::Manip
The most powerful and slowest (all perl, large)
of date manipulation packages.
Includes many obscure calendar-related functions.
* Powerful parsing many different formats of dates
* No explicit support for or formatting dates.
* Non-perlstyle function names (internal caps, as in ParseDate())
* Powerful support for date math (but slower than Date::Calc)
* Support for all A.D. dates [1-9999]
* Function support for holidays, business days, etc.
=head2 HTTP::Date
http://search.cpan.org/search?module=HTTP::Date
This module is part of the larger libwww-perl bundle.
It seems to parse a wider variety of dates than Date::Parse,
but it is focused on those date formats which occur in HTTP headers.
It only formats dates in the format preferred by HTTP headers.
=head2 Time::HiRes
http://search.cpan.org/search?module=Time::HiRes
Completely separate from the modules above, which deal with dates,
there is sometimes a need to deal with times at the sub-second
level. Time::HiRes works in seconds and milliseconds.
It is particularly useful in timing sections of code.
=head1 OBJECT-ORIENTED SOLUTIONS
An alternative to the functional solutions described above is an
object-oriented solution that involves creating and manipulating
true "datetime" objects.
=head2 Time::Piece [Time::Object, Time::Seconds]
http://search.cpan.org/search?module=Time::Object
On the perl5-porters mailing
Larry Wall described some thoughts on how dates and times might become part
of the Perl language and sketched out an object-oriented interface.
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html
This interface was implemented in the Time::Piece package.
* OO interface
* Perl gmtime, localtime return objects of type Time::Object
* No explicit support for parsing dates.
* Flexible formatting using POSIX strftime() format specifiers.
* Limited internationalization support.
* Limited date math support.
* Unknown support for dates outside [1970-2038]
* Unsupported on Win32 platform.
=head2 Class::Date, Class::Date::Rel
http://search.cpan.org/search?module=Class::Date
This class started with Time::Object and was enhanced.
* Some native support for parsing dates.
* Uses Date::Parse internally for extended date parsing
* Better date math support.
* Supported on Win32 platform.
=head2 Date::Simple
http://search.cpan.org/search?module=Date::Simple
This is a simple, object-oriented class that deals with
dates only (not times at all).
=head2 Date::Calc::Object
http://search.cpan.org/search?module=Date::Calc::Object
Date::Calc has an object-oriented interface.
=cut
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/podstyle.pod
Index: podstyle.pod
===================================================================
#############################################################################
## $Id: podstyle.pod,v 1.1 2001/11/16 23:21:38 spadkins Exp $
#############################################################################
=head1 NAME
P5EEx::Blue::podstyle - Style-guide for writing embedded POD documentation
=head1 TERMINOLOGY
In Perl, the term "Package" refers to a namespace in which subroutines
and variables can be defined. In P5EE, the developer usually uses Packages
to write object-oriented code, so that a Package becomes a Module
(i.e. a Class). Thus, in object-oriented perl, all three names mean
approximately the same thing.
Confusingly, in UML and Java, "packages" are groups of related classes.
In Perl, related classes are usually kept in the same directory, so this
concept is called a "Class Set" or "Set of Classes".
A Distribution is a set of all classes bundled up along with their support
files (test scripts, examples, doc, etc.) and versioned together.
A Distribution generally comes in a gzipped tar file
(i.e. P5EEx-Blue-0.25.tar.gz).
=cut
#############################################################################
## TAGS
#############################################################################
=head1 COMMENT TAGS
The documentation specified here takes the form of a "head1" section,
a "head2" section, or bullet list with specialized keywords.
=head1 NAME
=head1 Distribution: <Dist-name> <description>
=item * Version: $Id: podstyle.pod,v 1.1 2001/11/16 23:21:38 spadkins Exp $
=item * Class Set: <Class-Set-name> <description>
=head1 Class Set: <Class-Set-name> <description>
=item * Class: <Class-name> <description>
=head1 SYNOPSIS
=head1 Class: <Class-name> <description>
=item * Throws: <Exception-Name>
=item * Deprecated: <Since-Version> <Planned-Discontinue-Version>
=item * Since: <Version-Number>
=item * See: L<Text|Link-Name>
=head1 Attributes:
=head2 Public Attributes: [<functional-category>]
=head2 Protected Attributes: [<functional-category>]
=head2 Private Attributes: [<functional-category>]
=item * Attribute: <Attribute-Name> <Type> <description>
=head1 Public Methods: [<functional-category>]
=head1 Protected Methods: [<functional-category>]
=head1 Private Methods: [<functional-category>]
=head2 Method: <Method-signature>
=item * Param: <Param-Name> <Type> <In/Out> <Undef-OK>
=item * Return: <Return-Name> <Type> <Undef-OK>
=item * Throws: <Exception-Name>
=item * Deprecated: <Since-Version> <Planned-Discontinue-Version>
=item * Since: <Version-Number>
=head1 SYNOPSIS
=item * Author: <author> [< <email-address> >]
=item * License: <licence>
=head1 SYNOPSIS
=head1 SEE ALSO
=over
=cut
#############################################################################
## DISTRIBUTION
#############################################################################
=head1 DOC FOR THE DISTRIBUTION
In some pod file, there should exist the documentation for the entire
distribution. There may be a naturally top-level package to put this
in (i.e. P5EEx::Blue.pm), or you may need to create a separate pod file
for this (i.e. P5EEx::Blue::distribution.pod).
The distribution documentation is composed of those specifications that
apply to the entire set of classes and accompanying files.
The following documentation must be included in a the Distribution doc.
=over
=item * Perl version required to run the Distribution
=item * Hard Dependencies (other Distributions, and their versions,
required to be installed)
=item * Soft Dependencies (other Distributions, and their versions,
optionally used if installed)
=item * All Exceptions Thrown by any Classes in the Distribution
=item * List of Class Sets in the Distribution (every Class should belong
to exactly one Class Set for the purposes of documentation)
=item * A link to the Exceptions documentation
=item * Requirements
=item * Design
=back
Note: Every P5EE-compliant distribution should include a
single Exceptions.pm file (i.e. P5EEx::Blue::Exceptions.pm).
=cut
#############################################################################
## SET OF CLASSES
#############################################################################
=head1 DOC FOR A SET OF CLASSES (DIRECTORY)
For each subset of classes in the distribution (typically a directory),
there should be additional documentation for that Set of Classes.
=over
=item * Description
=item * Platform Dependencies (OS/Hardware/Configuration)
=item * References to any external specifications
=back
=cut
#############################################################################
## CLASS
#############################################################################
=head1 DOC FOR A CLASS (MODULE/PACKAGE)
Each Class file (*.pm) should have Class documentation.
=over
=item * Class Description
=item * State/Transition Information (high level)
=item * Platform Dependencies (OS/Hardware/Configuration)
=item * Allowed Implementation Variances
=item * Security Constraints
=item * References to any External Secifications
=back
=cut
#############################################################################
## ATTRIBUTE
#############################################################################
=head1 DOC FOR AN ATTRIBUTE
The documentation for the attributes of the Class should follow immediately
after the Class documentation. For each attribute, consider including the
following type of information.
Put the public attributes first (users of the class should access this
attribute directly, rare!), then protected attributes (only other classes
in this Class Set should access the attribute directly), then private
attributes (only this class and derived classes should access the attribute
directly).
=over
=item * Description
=item * Range of valid values
=item * Intended Visibility (Public, Protected, Private)
=item * Undef Value Behavior
=back
=cut
#############################################################################
## METHOD
#############################################################################
=head1 DOC FOR A METHOD
Each method should have a section which explains the following.
Multiple sections of doc should exist for each possible method signature.
=over
=item * Description and Behavior
=item * State Transitions
=item * Range of Valid Argument Values
=item * Undef Argument Behavior
=item * Range of Return Values
=item * Algorithms Defined
=item * Platform Dependencies (OS/Hardware/Configuration)
=item * Allowed Implementation Variances
=item * Type and Cause of Exceptions
=item * Security Constraints
=back
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/styleguide.pod
Index: styleguide.pod
===================================================================
#!perl -w
# run this document through perl to check its syntax
use Pod::Checker;
podchecker(\*DATA);
__END__
=head1 NAME
styleguide - P5EE Style Guide
=head1 INTRODUCTION
All code and documentation that is submitted to be included in the P5EE
distribution should follow the style in this document. This is not to
try to stifle your creativity, but to make life easier for everybody who
has to work with your code, and to aid those who are not quite sure how
to do something. It also serves to resolve disputes so that no one takes
it personally.
These conventions below apply to perl modules, web (CGI/mod_perl) programs,
command-line programs, specifically, but also might apply to some
degree to any Perl code written for use in P5EE.
Note that these are all guidelines, not unbreakable rules. If you have
a really good need to break one of the rules herein, however, then it is
best to ask the core P5EE team first.
Note that with much of this document, it is not so much the Right Way as
it is Our Way. We need to have conventions in order to make life easier
for everyone.
If you have any questions, please ask us on the P5EE-development
mailing list, [EMAIL PROTECTED]
http://lists.perl.org/showlist.cgi?name=p5ee
Unofficial, proposed documentation for the P5EE project is at the
following sites.
http://www.officevision.com/pub/p5ee
This document can and will be modified over time.
We hope to add any significant changes at the bottom of the document.
=head1 CODING PRINCIPLES
=head2 Perl Version
We code everything to perl 5.005_03. Some day we may switch to take
advantage of perl 5.6 features. Regardless, all code should run on perl
5.005_03 or any later version of perl 5. All of the core P5EE code has
been tested on perl 5.005_03 and perl 5.6.0, though it has probably
been used more on perl 5.6.0.
=head2 Documentation
All modules will be documented using the POD examples in the module
boilerplate. The function, purpose, use of the module will be
explained, and each public API will be documented with name,
description, inputs, outputs, side effects, etc.
If an array or hash reference is returned, document the size of the
array (including what each element is, as appropriate) and name each key
in the hash. For complex data structures, map out the structure as
appropriate.
Also document what kind of data returned values are. Is it an integer,
a block of HTML, a boolean?
All command-line program options will be documented using the
boilerplate code for command-line programs. Each available function,
switch, etc. should be documented, along with a statement of function,
purpose, use of the program. Try not to use the same options as another
program, for a different purpose.
All web programs should be documented with a statement of function,
purpose, and use in the comments of the program.
Any external documents, and documentation for command-line programs and
modules, should be written in POD, where appropriate. From there, they
can be translated to many formats with the various pod2* translators.
Read the perlpod manpage before writing any POD, because although POD is
not difficult, it is not what most people are used to. It is not a
regular markup language; it is just a way to make easy documentation
for translating to other formats. Read, and understand, the perlpod
manpage, and ask us or someone else who knows if you have any questions.
=head2 Version
Use the boilerplate code for versions of modules, web programs, and
command-line programs. The $VERSION of the module will then reflect the
CVS revision.
The Makefile.PL should contain the distribution version, independent
of any individual file version within the CVS repository.
Also, XS modules should probably have $VERSION
also reflect the distribution, or else you'll need to recompile the
shared library every time you make a change to the file, which is
really a pain to do during development.
Our distribution versions use tuples, where the first number is the
major revision, the second number is the version, and third
number is the subversion. Odd-numbered versions are development
versions. Examples:
1.0.0 First release of P5EE 1
1.0.1 Second release of P5EE 1.0
1.0.10 etc.
1.1.0 First development release of P5EE 1.2 (or 2.0)
2.0.0 First release of P5EE 2
Versions can be modified with a hyphen followed by some text, for
special versions, or to give extra information. Examples:
1.1.4-bender Notes that this is a bender release
2.0.0-pre1 Notes that this is not final, but preview
In perl 5.6.0, you can have versions like C<v2.0.0>, but this is not
allowed in previous versions of perl. So to convert a tuple version
string to a string to use with $VERSION, use a regular integer for
the revision, and three digits for version and subversion. Examples:
1.1.6 -> 1.001006
2.0.0 -> 2.000000
This way, perl can use the version strings in greater-than and
less-than comparisons.
=head2 Comments
All code should be self-documenting as much as possible. Only include
necessary comments. Use names like "$story_count", so you don't need to
do something like:
# story count
my $sc = 0;
Include any comments that are, or might be, necessary in order for
someone else to understand the code. Sometimes a simple one-line
comment is good to explain what the purpose of the following code is
for. Sometimes each line needs to be commented because of a complex
algorithm. A good reference is Kernighan & Pike's
I<Practice of Programming> about commenting.
=head2 Warnings and Strict
All code must compile and run cleanly with "use strict" enabled and the
perl "-w" (warnings) option on. If you must do something that -w or
strict complains about, there are workarounds, but the chances that you
really need to do it that way are remote.
The one exception is the "Use of uninitialized variable" warnings.
We have those disabled in P5EE.pm, so by including "use
P5EE" you are disabling that warning in your code, too, and you don't
need to worry about them.
=head2 Lexical Variables
Use only lexical variables, except for special global variables
($VERSION, %ENV, @ISA, $!, etc.) or very special circumstances.
Global variables
for regular use are never appropriate. When necessary, "declare"
globals with "use vars", not with our() (our() was introduced in perl
5.6).
A lexical variable is created with my(). A global variable is
pre-existing (if it is a special variable), or it pops into existence
when it is used. local() is used to tell perl to assign a temporary
value to a variable. This should only be used with special variables,
like $/, or in special circumstances. If you must assign to any global
variable, consider whether or not you should use local().
local() may also be used on elements of arrays and hashes, though there
is seldom a need to do it, and you shouldn't.
=head2 Exporting
Do not export anything from a module by default.
Feel free to put anything you
want to in @EXPORT_OK, so users of your modules can explicitly ask
for symbols (e.g., "use P5EE::Something qw(getFoo setFoo)"), but
do not export them by default.
=head2 Pass by Reference
Arrays and hashes should be passed to and from functions by reference
only. Note that a list and an array are NOT the same thing. This
is perfectly fine:
return($user, $form, $constants);
An exception might be a temporary array of discrete arguments:
my @return = ($user, $form);
push @return, $constants if $flag;
return @return;
Although, usually, this is better (faster, easier to read, etc.):
if ($flag) {
return($user, $form, $constants);
} else {
return($user, $form);
}
=head2 Garbage Collection
Perl does pretty good garbage collection for you. It will automatically
clean up lexical variables that have gone out of scope and objects whose
references have gone away. Normally you don't need to worry about
cleaning up after yourself, if using lexicals.
However, some glue code, code compiled in C and linked to Perl, might
not automatically clean up for you. In such cases, clean up for
yourself. If there is a method in that glue to dispose or destruct,
then use it as appropriate.
Also, if you have a long-running function that has a large data
structure in it, it is polite to free up the memory as soon as you are
done with it, if possible.
my $huge_data_structure = get_huge_data_structure();
do_something_with($huge_data_structure);
undef $huge_data_structure;
=head2 __END__ and __DATA__ and __PACKAGE__
Do not use __END__ or __DATA__ in web programs. They break mod_perl.
Also, __PACKAGE__ will likely not return the value you expect in web
programs. These are all fine for modules.
=head2 Tests
Modules should provide test code, with documentation on how to use
it.
=head2 STDIN/STDOUT
Always report errors using the (yet-to-be-defined) P5EE logging
facility. Never print directly to STDERR.
Do not print directly to STDOUT, unless you need to
print directly to the user's browser.
In command-line programs, feel free to print to STDERR and STDOUT as
needed.
=head2 Files and Globs
For constructing and parsing file paths, use File::Spec::Functions
and File::Basename. For creating or removing paths, use File::Path.
This increases portability to non-Un*x platforms.
my $path = "$dir/$file"; # wrong
my $path = catfile($dir, $file); # right
my $dir = "."; # wrong
my $dir = curdir(); # right
mkdir("/path"), mkdir("/path/to"), ... # wrong
`mkdir /path`; `mkdir /path/to`, ... # very wrong
mkpath("/path/to/my/dir", 0, 0775); # right
Do not use the glob operator (C<glob('*')> or C<E<lt>*E<gt>>). Use
opendir() with readdir() instead. Note that glob() is much more
portable in perl 5.6 than it was in previous versions of perl, but
its behavior is still unreliable, as each perl installation can
choose to implement perl using local conventions instead of the
default, which is via the File::Glob module.
Do not use symbol table globs (not the same kind of glob as above!) like
C<*foo> for anything, except for when direct symbol table manipulation
is necessary, which it almost never is.
=head2 System Calls
Always check return values from system calls, including open(),
close(), mkdir(), or anything else that talks directly to the system.
Perl built-in system calls return the error in $!; some functions in
modules might return an error in $@ or some other way, so read the module's
documentation if you don't know. Always do something, even if it is
just calling errorLog(), when the return value is not what you'd expect.
=head1 STYLE
Much of the style section is taken from the perlstyle manpage. We make
some changes to it here, but it wouldn't be a bad idea to read that
document, too.
=head2 Terminology
=over 4
=item P5EE
The name of the project is "P5EE".
There is no "P5EE1" or "P5EE2".
To specify a version, use "P5EE 2.0" or "P5EE 2.0.1".
=item function vs. sub(routine) vs. method
"Method" should be used only to refer to a subroutine that are object
methods or class methods; that is, these are functions that are used
with OOP that always take either an object or a class as the first
argument. Regular subroutines, ones that are not object or class
methods, are functions. Class methods that create and return an object
are optionally called constructors.
=back
=head2 Names
Don't use single-character variables, except as iterator variables.
Don't use two-character variables just to spite us over the above rule.
Constants are in all caps; these are variables whose value will I<never>
change during the course of the program.
$Minimum = 10; # wrong
$MAXIMUM = 50; # right
Other variables are lowercase, with underscores separating the words.
They words used should, in general, form a noun (usually singular),
unless the variable is a flag used to denote some action that should be
taken, in which case they should be verbs (or gerunds, as appropriate)
describing that action.
$thisVar = 'foo'; # wrong
$this_var = 'foo'; # right
$work_hard = 1; # right, verb, boolean flag
$running_fast = 0; # right, gerund, boolean flag
Arrays and hashes should be plural nouns, whether as regular arrays and
hashes or array and hash references. Do not name references with "ref"
or the data type in the name.
@stories = (1, 2, 3); # right
$comment_ref = [4, 5, 6]; # wrong
$comments = [4, 5, 6]; # right
$comment = $comments->[0]; # right
Make the name descriptive. Don't use variables like "$sc" when you
could call it "$story_count". See L<"Comments">.
Methods and Functions (except for special cases, like AUTOLOAD) begin
with a verb, with words following to complete the action.
Multi-word names should be all lower-case, separated by underscores,
in keeping with the "perlstyle" guide and most of the modules
already on CPAN. They
should as clearly as possible describe the activity to be peformed, and
the data to be returned.
$obj->getStory(); # wrong.
$obj->setStoryByName(); # wrong again.
$obj->getStoryByID(); # wrong again. This isn't Java!
$obj->get_story(); # right.
$obj->set_story_by_name(); # right.
$obj->get_story_by_id(); # right.
Methods and Functions beginning with C<_> are special:
they are not to be used
outside the current file (i.e. "private").
This is not enforced by the code itself,
but by programmer convention only.
For large for() loops, do not use $_, but name the variable.
Do not use $_ (or assume it) except for when it is absolutely
clear what is going on, or when it is required (such as with
map() and grep()).
for (@list) {
print; # OK; everyone knows this one
print uc; # wrong; few people know this
print uc $_; # better
}
Note that the special variable C<_> I<should> be used when possible.
It is a placeholder that can be passed to stat() and the file test
operators, that saves perl a trip to re-stat the file. In the
example below, using C<$file> over for each file test, instead of
C<_> for subsequent uses, is a performance hit. You should be
careful that the last-tested file is what you think it is, though.
if (-d $file) { # $file is a directory
# ...
} elsif (-l _) { # $file is a symlink
# ...
}
Package names begin with a capital letter in each word, followed by
lower case letters.
P5EE::Standard # good
P5EE::Authz # good
P5EE::MainCode # good
Use all lower case for POD files which are documentation only.
P5EE::styleguide # good for doc only
Naming for modules should be according to the following general rules.
All P5EE components which have *broad* support from the
[EMAIL PROTECTED] list would go into the "P5EE" package
Naming style is similar to other modules on CPAN
Naming choice draws from precedent of other modules on CPAN
Naming choice draws from precedent of J2EE
Packages which aren't intended to be instantiated as objects may
have an "adjective" or "concept" for a name
(i.e. P5EE::Standard). Packages which are
Modules/Classes and are intended to be instantiated as objects
should be nouns, potentially accompanied by modifying adjectives
(i.e. P5EE::Authen::Principal).
=head2 Indents, Line Lengths, and Blank Space
Code checked into CVS must never contain tabs.
Patches of code with tabs do not email well, and different people
have their tabstops set different ways.
If you want to set tab stops on your editor, just make sure it
converts tabs to spaces when it saves the file.
Indentation for normal block-style coding should be 4 spaces.
The settings for Emacs and vim are as follows.
=over
=item * x?emacs: cperl-mode
.xemacs/custom.el:
------------------
(custom-set-variables
'(cperl-indent-level 4)
'(cperl-continued-statement-offset 4)
'(cperl-tab-always-indent t)
'(indent-tabs-mode nil)
)
=item * vim
.vimrc:
-------
set expandtab " replaces any tab keypress with the appropriate number of spaces
set tabstop=4 " sets tabs to 4 spaces
=back
Maximum line lengths should be 77 columns (or 75 columns for
an unbroken line of characters).
This is for maximum portability to different people's
development environments and for decent transmission
through e-mail to a wide array of e-mail clients
(i.e. for patches).
Example: Eudora 3.0.6 wraps a solid, single line of 80 non-whitespace
characters (i.e. ######...#####) at character 76. If there are
spaces in the line, it allows lines up to character 78 before wrapping
the last words down to the next line. If sources have no more than
77 characters in a line, a "diff -u" patch will add a column, and the
lines will escape being folded.
No space before a semicolon that closes a statement.
foo(@bar) ; # wrong
foo(@bar); # right
Line up corresponding items vertically.
my $foo = 1;
my $bar = 2;
my $xyzzy = 3;
open(FILE, $fh) or die $!;
open(FILE2, $fh2) or die $!;
$rot13 =~ tr[abcedfghijklmnopqrstuvwxyz]
[nopqrstuvwxyzabcdefghijklm];
# note we use a-mn-z instead of a-z,
# for readability
$rot13 =~ tr[a-mn-z]
[n-za-m];
Put blank lines where they make sense for readability, such as
the following.
Put blank lines between groups of code that do different things. Put
blank lines after your variable declarations. Put a blank line before a
final return() statement. Put a blank line following a block (and
before, with the exception of comment lines).
An example:
# this is my function!
sub foo {
my (@data) = @_;
my $obj = new Constructor;
my ($var1, $var2);
$obj->setFoo($data[1]);
$var1 = $obj->getFoo(1);
$var2 = $obj->getFoo($var1);
display($var1, $var2);
return($data[0]);
}
print 1;
=head2 Parentheses
For control structures, there is a space between the keyword and opening
parenthesis. For functions, there is not.
for(@list) # wrong
for (@list) # right
my ($ref) # OK
my ($ref) # preferred
localtime ($time); # wrong
localtime($time); # right
Be careful about list vs. scalar context with parentheses!
my @array = ('a', 'b', 'c');
my ($first_element) = @array; # a
my ($first_element) = ('a', 'b', 'c'); # a
my $element_count = @array; # 3
my $last_element = ('a', 'b', 'c'); # c
Always include parentheses after functions, even if there are no arguments.
There are some exceptions, such as list operators (like print) and unary
operators (like undef, delete, uc).
There is no space inside the parentheses, unless it is needed for
readability.
for ( map { [ $_, 1 ] } @list ) # OK
for ( @list ) # not really OK, not horrible
On multi-line expressions, match up the closing parenthesis with either
the opening statement, or the opening parenthesis, whichever works best.
Examples:
@list = qw(
bar
baz
); # right
if ($foo && $bar && $baz
&& $buz && $xyzzy
) {
print $foo;
}
Whether or not there is space following a closing parenthesis is
dependent on what it is that follows.
print foo(@bar), baz(@buz) if $xyzzy;
Note also that parentheses around single-statement control expressions,
as in C<if $xyzzy>, are optional (and discouraged) C<if> it is I<absolutely>
clear -- to a programmer -- what is going on. There is absolutely no
need for parentheses around C<$xyzzy> above, so leaving them out enhances
readability. Use your best discretion. Better to include them, if
there is any question.
The same essentially goes for perl's built-in functions, when there is
nothing confusing about what is going on (for example, there is only one
function call in the statement, or the function call is separated by a
flow control operator). User-supplied functions must always include
parentheses.
print 1, 2, 3; # good
delete $hash{key} if isAnon($uid); # good
However, if there is any possible confusion at all, then include the
parentheses. Remember the words of Larry Wall in the perlstyle manpage:
When in doubt, parenthesize. At the very least it will
let some poor schmuck bounce on the % key in vi.
Even if you aren't in doubt, consider the mental welfare
of the person who has to maintain the code after you, and
who will probably put parens in the wrong place.
So leave them out when it is absoutely clear to a programmer, but if
there is any question, leave them in.
=head2 Braces
(This is about control braces, not hash/data structure braces.)
There is always a space befor the opening brace.
while (<$fh>){ # wrong
while (<$fh>) { # right
A one-line block may be put on one line, and the semicolon may be
omitted.
for (@list) { print }
Otherwise, finish each statement with a semicolon, put the keyword and
opening curly on the first line, and the ending curly lined up with the
keyword at the end.
for (@list) {
print;
smell();
}
perlstyle likes to have "uncuddled elses":
# right
if ($foo) {
print;
}
else {
die;
}
# wrong
if ($foo) {
print;
} else {
die;
}
=head2 Operators
Put space around most operators. The primary exception is the for
aesthetics; e.g., sometimes the space around "**" is ommitted,
and there is never a space before a ",", but always after.
print $x , $y; # wrong
print $x, $y; # right
$x = 2 >> 1; # good
$y = 2**2; # ok
Note that "&&" and "||" have a higher precedence than "and" and "or".
Other than that, they are exactly the same. It is best to use the lower
precedence version for control, and the higher for testing/returning
values. Examples:
$bool = $flag1 or $flag2; # WRONG (doesn't work)
$value = $foo || $bar; # right
open(FILE, $file) or die $!;
$true = foo($bar) && baz($buz);
foo($bar) and baz($buz);
Note that "and" is seldom ever used, because the statement above is
better written using "if":
baz($buz) if foo($bar);
Most of the time, the confusion between and/&&, or/|| can be alleviated
by using parentheses. If you want to leave off the parentheses then you
I<must> use the proper operator. But if you use parentheses -- and
normally, you should, if there is any question at all -- then it doesn't
matter which you use. Use whichever is most readable and aesthetically
pleasing to you at the time, and be consistent within your block of code.
Break long lines AFTER operators, except for "and", "or", "&&", "||".
Try to keep the two parts to a binary operator (an operator that
has two operands) together when possible.
print "foo" . "bar" . "baz"
. "buz"; # wrong
print "foo" . "bar" . "baz" .
"buz"; # right
print $foo unless $x == 3 && $y ==
4 && $z == 5; # wrong
print $foo unless $x == 3 && $y == 4
&& $z == 5; # right
=head2 Other
Put space around a complex subscript inside the brackets or braces.
$foo{$bar{baz}{buz}}; # OK
$foo{ $bar{baz}{buz} }; # better
In general, use single-quotes around literals, and double-quotes
when the text needs to be interpolated.
It is OK to omit quotes around names in braces and when using
the => operator, but be careful not to use a name that doubles as
a function; in that case, quote.
$what{'time'}{it}{is} = time();
When making compound statements, put the primary action first.
open(FILE, $fh) or die $!; # right
die $! unless open(FILE, $fh); # wrong
print "Starting\n" if $verbose; # right
$verbose && print "Starting\n"; # wrong
Use here-docs instead of repeated print statements.
print <<EOT;
This is a whole bunch of text.
I like it. I don't need to worry about messing
with lots of print statements and lining them up.
EOT
Just remember that unless you put single quotes around your here-doc
token (<<'EOT'), the text will be interpolated, so escape any "$" or "@"
as needed.
=head1 REQUIREMENTS RFC AND CODING PROCEDURE
This is for new programs, modules, specific APIs, or anything else.
Contact for core team is the P5EE-development mailing list.
Discuss all ideas there.
The basic process for a new P5EE component is:
get the blessing from the P5EE list for a top-level package name
(i.e. "P5EE::NewModule")
begin a CPAN-able source directory skeleton
write the spec (no code) as POD inside the target module(s)
publish HTML to the web
announce whenever progress is made so that comments can be sought
code is added after there is broad support for the API spec
and supporting doc
=head1 BUG REPORTS, PATCHES, CVS
We don't have bug tracking set up yet.
Use C<diff -u> for patches.
Do not add anything to the main branches in CVS without approval from
a member of the core team.
=head1 TO DO
lots
=head1 ACKNOWLEDGEMENTS
This style guide was based on the slashcode style guide.
It is also in conformance with the mod_perl style guide
and is in the spirit of the C-language Apache style guide.
http://slashcode.com/docs/slashstyle.html
http://cvs.apache.org/viewcvs.cgi/modperl-docs/src/devel/modperl_style/modperl_style.pod?rev=1.5
http://dev.apache.org/styleguide.html
=head1 CHANGES
$Log: styleguide.pod,v $
Revision 1.1 2001/11/16 23:21:38 spadkins
initial stuff
=head1 VERSION
$Id: styleguide.pod,v 1.1 2001/11/16 23:21:38 spadkins Exp $
