cvsuser 02/01/03 10:19:16
Added: P5EEx/Blue/P5EEx/Blue Reference.pm exceptions.pod
P5EEx/Blue/P5EEx/Blue/Config File.pod
P5EEx/Blue/P5EEx/Blue/Context CGI.pm
P5EEx/Blue/P5EEx/Blue/Serializer Ini.pm Properties.pm
P5EEx/Blue/examples Config.1.out Reference.1.out
P5EEx/Blue/sbin perlchanges
Log:
added missing files
Revision Changes Path
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Reference.pm
Index: Reference.pm
===================================================================
#############################################################################
## $Id: Reference.pm,v 1.1 2002/01/03 18:19:15 spadkins Exp $
#############################################################################
package P5EEx::Blue::Reference;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use strict;
use P5EEx::Blue::P5EE;
=head1 NAME
P5EEx::Blue::Reference - a Perl reference, blessed so it can be accessed with methods
=head1 SYNOPSIS
use P5EEx::Blue::Reference;
$ref = P5EEx::Blue::Reference->new();
$ref = P5EEx::Blue::Reference->new("file" => $file);
print $ref->dump(), "\n"; # use Data::Dumper to spit out the Perl representation
# accessors
$property_value = $ref->get($property_name);
$branch = $ref->get_branch($branch_name,$create_flag); # get hashref
$ref->set($property_name, $property_value);
# on-demand loading helper methods (private methods)
$ref->overlay($ref2); # merge the two structures using overlay rules
$ref->overlay($ref1, $ref2); # merge $ref2 onto $ref1
$ref->graft($branch_name, $ref2); # graft new structure onto branch
=head1 DESCRIPTION
P5EEx::Blue::Reference is a very thin class which wraps a few simple
methods around a perl reference which may contain a multi-level data
structure.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Reference
* Throws: P5EEx::Blue::Exception
* Since: 0.01
=head2 Requirements
The P5EEx::Blue::Reference class satisfies the following requirements.
o Minimum performance penalty to access perl data
o Ability to bless any reference into this class
o Ability to handle ARRAY and HASH references
=cut
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
This constructor is used to create Reference objects.
Customized behavior for a particular type of Reference
is achieved by overriding the init() method.
* Signature: $ref = P5EEx::Blue::Reference->new($array_ref)
* Signature: $ref = P5EEx::Blue::Reference->new($hash_ref)
* Signature: $ref = P5EEx::Blue::Reference->new("array",@args)
* Signature: $ref = P5EEx::Blue::Reference->new(%named)
* Param: $array_ref []
* Param: $hash_ref {}
* Return: $ref P5EEx::Blue::Reference
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
use "P5EEx::Blue::Reference";
$ref = P5EEx::Blue::Reference->new("array", "x", 1, -5.4, { pi => 3.1416 });
$ref = P5EEx::Blue::Reference->new( [ "x", 1, -5.4 ] );
$ref = P5EEx::Blue::Reference->new(
arg1 => 'value1',
arg2 => 'value2',
);
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
# bootstrap phase: bless an empty hash
my $self = {};
bless $self, $class;
# create phase: replace empty hash with created hash, bless again
$self = $self->create(@_);
bless $self, $class;
$self->init(@_); # allows a subclass to override this portion
return $self;
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods:
=cut
#############################################################################
# get()
#############################################################################
=head2 get()
* Signature: $property_value = $ref->get($property_name);
* Param: $property_name string
* Return: $property_value string
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$dbi = $ref->get("Repository.default.dbi");
$dbuser = $ref->get("Repository.default.dbuser");
$dbpass = $ref->get("Repository.default.dbpass");
=cut
sub get {
print "get(@_)\n" if ($P5EEx::Blue::Context::DEBUG);
my ($self, $property_name, $ref) = @_;
$ref = $self if (!defined $ref);
if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
my ($branch_name, $attrib, $type, $branch);
$branch_name = $1;
$type = $2;
$attrib = $3;
$branch = ref($ref) eq "ARRAY" ? undef : $ref->{_branch}{$branch_name};
$branch = $self->get_branch($1,0,$ref) if (!defined $branch);
return undef if (!defined $branch || ref($branch) eq "");
return $branch->[$attrib] if (ref($branch) eq "ARRAY");
return $branch->{$attrib};
}
else {
return $self->{$property_name};
}
}
#############################################################################
# get_branch()
#############################################################################
=head2 get_branch()
* Signature: $branch = $ref->get_branch($branch_name);
* Param: $branch_name string
* Return: $branch {}
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$branch_name = "Repository.default";
$branch = $ref->get_branch($branch_name);
foreach $key (keys %$branch) {
$property = "${branch_name}.${key}";
print $property, "=", $branch->{$key}, "\n";
}
$dbi = $branch->{dbi};
$dbuser = $branch->{dbuser};
$dbpass = $branch->{dbpass};
=cut
sub get_branch {
print "get_branch(@_)\n" if ($P5EEx::Blue::Context::DEBUG);
my ($self, $branch_name, $create, $ref) = @_;
my ($sub_branch_name, $branch_piece, $attrib, $type, $branch, $cache_ok);
$ref = $self if (!defined $ref);
# check the cache quickly and return the branch if found
$cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self); # only cache from $self
$branch = $ref->{_branch}{$branch_name} if ($cache_ok);
return ($branch) if (defined $branch);
# not found, so we need to parse the $branch_name and walk the $ref tree
$branch = $ref;
$sub_branch_name = "";
# these: "{field1}" "[3]" "field2." are all valid branch pieces
while ($branch_name =~ s/^([\{\[]?)([^\.\[\]\{\}]+)([\.\]\}]?)//) {
$branch_piece = $2;
$type = $3;
$sub_branch_name .= ($3 eq ".") ? "$1$2" : "$1$2$3";
if (ref($branch) eq "ARRAY") {
if (! defined $branch->[$branch_piece]) {
if ($create) {
$branch->[$branch_piece] = ($type eq "]") ? [] : {};
$branch = $branch->[$branch_piece];
$ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
}
else {
return(undef);
}
}
else {
$branch = $branch->[$branch_piece];
$sub_branch_name .= "$1$2$3"; # accumulate the $sub_branch_name
}
}
else {
if (! defined $branch->{$branch_piece}) {
if ($create) {
$branch->{$branch_piece} = ($type eq "]") ? [] : {};
$branch = $branch->{$branch_piece};
$ref->{_branch}{$sub_branch_name} = $branch if ($cache_ok);
}
else {
return(undef);
}
}
else {
$branch = $branch->{$branch_piece};
}
}
$sub_branch_name .= $type if ($type eq ".");
}
return $branch;
}
#############################################################################
# set()
#############################################################################
=head2 set()
* Signature: $ref->get($property_name, $property_value);
* Param: $property_name string
* Param: $property_value string
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$dbi = $ref->get("Repository.default.dbi");
$dbuser = $ref->get("Repository{default}{dbuser}");
$dbpass = $ref->get("Repository.default{dbpass}");
=cut
sub set {
print "set(@_)\n" if ($P5EEx::Blue::Context::DEBUG);
my ($self, $property_name, $property_value, $ref) = @_;
$ref = $self if (!defined $ref);
my ($branch_name, $attrib, $type, $branch, $cache_ok);
if ($property_name =~ /^(.*)([\.\{\[])([^\.\[\]\{\}]+)([\]\}]?)$/) {
$branch_name = $1;
$type = $2;
$attrib = $3;
$cache_ok = (ref($ref) ne "ARRAY" && $ref eq $self);
$branch = $ref->{_branch}{$branch_name} if ($cache_ok);
$branch = $self->get_branch($1,1,$ref) if (!defined $branch);
}
else {
$branch = $ref;
$attrib = $property_name;
}
if (ref($branch) eq "ARRAY") {
$branch->[$attrib] = $property_value;
}
else {
$branch->{$attrib} = $property_value;
}
}
#############################################################################
# overlay()
#############################################################################
=head2 overlay()
* Signature: $ref->overlay($ref2);
* Signature: $ref->overlay($ref1, $ref2);
* Param: $ref1 {}
* Param: $ref2 {}
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
# merge the two config structures using overlay rules
$ref->overlay($ref2);
# merge $ref2 onto $ref1
$ref->overlay($ref1, $ref2);
=cut
sub overlay {
}
#############################################################################
# graft()
#############################################################################
=head2 graft()
* Signature: $ref->graft($branch_name, $ref2);
* Param: $branch_name string
* Param: $ref2 {}
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
# graft new config structure onto branch
$ref->graft($branch_name, $ref2);
=cut
sub graft {
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
* Signature: $perl = $ref->dump();
* Param: void
* Return: $perl text
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$ref = $context->config();
print $ref->dump(), "\n";
=cut
use Data::Dumper;
sub dump {
my ($self) = @_;
my $d = Data::Dumper->new([ $self ], [ "conf" ]);
$d->Indent(1);
return $d->Dump();
}
#############################################################################
# PROTECTED METHODS
#############################################################################
=head1 Protected Methods:
The following methods are intended to be called by subclasses of the
current class.
=cut
#############################################################################
# create()
#############################################################################
=head2 create()
The create() method is used to create the Perl structure that will
be blessed into the class and returned by the constructor.
It may be overridden by a subclass to provide customized behavior.
* Signature: $ref = P5EEx::Blue::Reference->create("array", @args)
* Signature: $ref = P5EEx::Blue::Reference->create($arrayref)
* Signature: $ref = P5EEx::Blue::Reference->create($hashref)
* Signature: $ref = P5EEx::Blue::Reference->create($hashref, %named)
* Signature: $ref = P5EEx::Blue::Reference->create(%named)
* Param: $hashref {}
* Param: $arrayref []
* Return: $ref ref
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
=cut
sub create {
my $self = shift;
print "create(@_)\n" if ($P5EEx::Blue::Context::DEBUG);
return {} if ($#_ == -1);
if (ref($_[0]) ne "") {
return $_[0] if ($#_ == 0);
P5EEx::Blue::Exception->throw(error => "create(): Args supplied with an
ARRAY ref\n")
if (ref($_[0]) eq "ARRAY");
my ($ref, $i);
$ref = shift;
for ($i = 0; $i < $#_; $i += 2) {
$ref->{$_[$i]} = $_[$i+1];
}
return $ref;
}
if ($_[0] eq "array") {
shift;
return [ @_ ];
}
elsif ($#_ % 2 == 0) {
P5EEx::Blue::Exception->throw(error => "create(): Odd number of named
parameters\n");
}
return { @_ };
}
#############################################################################
# init()
#############################################################################
=head2 init()
The init() method is called from within the standard Reference constructor.
The init() method in this class does nothing.
It allows subclasses of the Reference to customize the behavior of the
constructor by overriding the init() method.
* Signature: init($named)
* Param: $named {} [in]
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$ref->init($args);
=cut
sub init {
my $self = shift;
}
#############################################################################
# PRIVATE METHODS
#############################################################################
=head1 Private Methods:
The following methods are intended to be called only within this class.
=cut
=head1 ACKNOWLEDGEMENTS
* Author: Stephen Adkins <[EMAIL PROTECTED]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
=head1 SEE ALSO
none
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/exceptions.pod
Index: exceptions.pod
===================================================================
#!perl -w
# run this document through perl to check its syntax
use Pod::Checker;
podchecker(\*DATA);
__END__
=head1 NAME
P5EEx::Blue::exceptions - P5EE Programming with Exceptions
=head1 INTRODUCTION
Programming with Exceptions
is a much more reliable way to prepare for unusual conditions
than trying to handle error codes returned from functions and methods
That is why programming with exceptions is an Enterprise Programming
topic. However, Perl has not always supported programming with
exceptions, and many Perl programmers are not familiar with this
style of programming using Perl.
This document was written to explain the support within the Perl
language for programming using exceptions in general. It also explains
the standards for exception programming in the P5EE framework.
This document represents the recommendations and collective wisdom
from the P5EE developers.
The short answer is that we recommend the following modules
to assist in exception programming.
Carp
CGI::Carp
Fatal
Error
Exception::Class
Devel::Stacktrace
However, it is important to understand what each does for you,
why, and how they all fit together.
So for the longer answer, read on.
=head1 IMPORTANCE OF EXCEPTION PROGRAMMING
Exception Programming is a technique to deal with exceptional
conditions (i.e. errors) encountered during runtime.
It is contrasted with the more common technique of
Error Checking.
Error Checking is a technique where an operation is performed.
Then all possible error conditions are checked and handled.
This requires the developer to address the following challenges.
=over
=item 1. Error Completeness
The developer must consider all possible error conditions
(difficult to foresee and consider at every level).
=item 2. Error Propagation
The developer must add quite a bit of additional logic
to allow subsequent statements after the error condition
to be skipped and the error to be propagated upward in
the call stack to the place where
it can be acted on appropriately.
=back
The problems with Error Checking is that it is so difficult
to do and so rarely done completely.
Since the program runs fine when no errors are
encountered, the developer invariably fails to put in all of
the error checks and the accompanying error propagation logic.
Exception Programming addresses these problems using the
following methods.
=over
=item 1. Error Completeness
Exceptions are grouped into an exception hierarchy.
Therefore, high level code needs only make the distinctions
between exceptions that it thinks are relevant. If additional
exceptions are added later by low level code, they will be
handled in accordance with the upper levels of the exception
hierarchy which are already known.
=item 2. Error Propagation
Exceptions take advantage of built-in language support
(longjmp() in C) to unravel the call stack. Additional
logic is not required by the developer to propagate the
error to a place that is prepared to handle it.
=back
Because Exception Programming addresses the issue of
software reliability (one of the Attributes of Enterprise
Systems), it is necessarily an Enterprise Programming issue.
=head1 PERL 5 LANGUAGE SUPPORT
Perl did not always support exception programming.
Even in Perl 5.6.1, the support for exception programming
is somewhat scattered.
The following are features of the language which are relevant.
=head2 die
Camel Book: Chapter 3: Functions, "die"
Online Doc: man perlfunc (or "perldoc perlfunc")
The "die" function prints its arguments to STDERR and causes
the program to exit. It has some extra features, like appending
__FILE__ and __LINE__ strings if the args don't end with a
newline. The biggest feature is that it may be "caught"
if it is executed within an eval statement.
Simply put, "die" is the native Perl way of "throwing" an
exception. The only "attributes" of the "exception" is the
message (concatenated args) of the "die" itself.
if ($error_condition_xyz_exists) {
die "Error XYZ occurred";
}
The "warn" function is similar to "die", in that it prints out
its arguments to STDERR in the same way, but it does not try
to exit or throw an exception in any way. Therefore, it's not
relevant for this discussion.
die "I'm dying"; # print msg to STDERR and exit
=head2 croak and confess
Camel Book: Chapter 7: The Standard Perl Library, "Carp"
Online Doc: man Carp (or "perldoc Carp")
The Carp.pm module is part of the Standard Perl Library
It allows you to throw exceptions (like "die"), but it reports
the line number and file name from the perspective of the
caller of the function/method that died.
This is useful for library code, so that the programmer sees
where he invoked the function that failed rather than seeing
where within that function the failure occurred.
use Carp;
croak "We're outta here!"; # like "die", but line # from caller
confess "It was my fault: $!"; # like "croak" but with stack trace
Using "croak" to throw an exception references the line # and
file name of the caller.
Using "confess" to throw an exception causes a
stack trace to be printed also.
=head2 CGI::Carp
Online Doc: man CGI::Carp (or "perldoc CGI::Carp")
If you are developing perl scripts which will be run
by a web server, the STDERR stream is usually redirected
the web server error log. However, the output generated
by "die" is not formatted nicely, with a datetime stamp
and filename, as is customary with error log entries.
The CGI::Carp package replaces die, croak, and confess
with versions which work the same but format the output
a little more nicely for the web server error log.
You can even direct fatal errors to the browser.
use CGI::Carp;
die "I'm dying"; # print msg to log and exit
warn "I'm confused"; # print msg to log
croak "We're outta here!"; # like "die", but line # from caller
confess "It was my fault: $!"; # like "croak" but with stack trace
carp "It was your fault!"; # like "warn", but line # from caller
use CGI::Carp qw(fatalsToBrowser);
die "Fatal error messages are now sent to browser";
=head2 $!
Camel Book: Chapter 2: The Gory Details/Special Variables, $!
Online Doc: man perlvar (or "perldoc perlvar")
If used in a string context, yields the error string
from the last system call error in the currently executing perl
interpreter.
You shouldn't depend on $! being
anything in particular unless you've gotten a specific error
indicating a system error.
So when you get a system call error returned from a perl function
(system calls usually relate to files, networking,
processes, or interprocess communication), you can check $!.
If you want to use good exception programming techniques, every
perl function which can fail from a system call error should
be checked for its return value so that an exception may be
thrown.
$file = "foo.txt";
open(FILE, "< $file") || die "Error opening [$file]: $!";
Of course, if your program's requirements allow you to
handle the error locally without
throwing an exception, you are welcome to.
However, every possible error needs to be thought about
and accounted for.
$file = "foo.txt";
if (open(FILE, "< $file")) { # if file doesn't exist, that's ok
@data = <FILE>;
close(FILE);
}
=head2 eval
Camel Book: Chapter 3: Functions, "eval"
Online Doc: man perlfunc (or "perldoc perlfunc")
Eval serves as Perl's version of a "try {}" block.
If a "die" (an exception) occurs within an "eval", the program
is not terminated, only the "eval". All of the code
that was eval'ed, after the exception, is skipped.
Eval has two syntaxes, "eval EXPR" and "eval BLOCK".
The "eval EXPR" syntax causes the code contained in the
EXPR expression to be compiled every time the
statement is executed during runtime.
eval "&do_big_function();";
$code = "&do_another_big_operation();";
eval $code;
The "eval BLOCK" syntax causes the code contained in the
BLOCK to be compiled only once (at script compile time),
so it is much more efficient and appropriate for
exception programming.
eval {
&do_big_function();
}
If any exception ("die") is thrown within the do_big_function(),
the program will not terminate. Control will simply be returned
to the end of the eval block.
=head2 $@
Camel Book: Chapter 2: The Gory Details/Special Variables, $@
Online Doc: man perlvar (or "perldoc perlvar")
The is the Perl synax error message from the last "eval" command.
Alternatively, it is the message of an exception that was thrown
(using "die").
If null, the last eval was parsed and executed correctly, with
no exceptions.
Thus, perl exception programming can be done with the following.
eval {
&do_big_function();
}
if ($@) {
# handle the exception ($@ is the exception message)
}
sub do_big_function {
...
if ($error_condition_xyz_exists) {
die "Error XYZ occurred";
}
...
}
=head2 $SIG{__DIE__}
Camel Book: Chapter 2: The Gory Details/Special Variables, %SIG
Online Doc: man perlvar (or "perldoc perlvar")
This handler is not necessary to know about to do exception
programming in Perl. However, it may be used modules which assist
in exception handling tasks.
The %SIG hash contains references to subroutines which are called
in response to signals received by the process. "__DIE__" is a
special internal hook which is not really an external signal.
So if you desired to do some additional processing between the
time that the "die" exception was thrown and the time it was
handled, you could replace the $SIG{__DIE__} handler.
$SIG{__DIE__} = sub {
# do something (@_ are the args of the "die")
};
=head2 caller
Camel Book: Chapter 3: Functions, "caller"
Online Doc: man perlfunc (or "perldoc perlfunc")
The "caller" function allows you to examine the call stack
in order (for example) to print stack traces.
=head2 Weaknesses in the Native Perl Exception Support
The eval/die pair provides the critical language support
necessary for Error Propagation.
However, the single
attribute of an exception, the message, leaves the
developer without an exception hierarchy which would
allow him to ensure Error Completeness in his
exception handling.
Furthermore, the Perl functions themselves must be
checked for errors rather than throwing exceptions.
=head1 EXCEPTION PROGRAMMING USING Fatal.pm
Causes all of the perl functions to throw exceptions
rather than simply return error codes or set error
flags.
=head1 EXCEPTION PROGRAMMING USING Error.pm
Introduces the ability to have an Exception Class
(not just a message) and to use "try/catch"
syntax.
It does this be defining try() and catch() subroutines
with appropriate prototypes, using the "{}" blocks
as closures (or anonymous subroutines). See the following
references.
Camel Book: Chapter 2: The Gory Details, Subroutines, Prototypes
Camel Book: Chapter 4: References and Nested Data Structures, Using Hard
References, Closures
=head1 EXCEPTION PROGRAMMING USING Exception::Class
Introduces the capability to collect exception
classes easily in a class hierarchy. This helps
address the issue of Error Completeness.
=head1 EXCEPTION PROGRAMMING USING Devel::Stacktrace
Adds the capability to print out more detailed
stack trace information than was possible with
"confess".
=cut
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Config/File.pod
Index: File.pod
===================================================================
######################################################################
## $Id: File.pod,v 1.1 2002/01/03 18:19:15 spadkins Exp $
######################################################################
=head1 NAME
P5EEx::Blue::Config::File - Load and access configuration data
=head1 SYNOPSIS
use P5EEx::Blue::Config;
$config = P5EEx::Blue::Config->new();
$config = P5EEx::Blue::Config->new(configFile => $file);
print $config->dump(), "\n"; # use Data::Dumper to spit out the Perl
representation
# accessors
$property_value = $config->get($property_name);
$branch = $config->get_branch($branch_name); # get hashref of properties
# on-demand loading helper methods (private methods)
$config->overlay($config2); # merge the two config structures using
overlay rules
$config->overlay($config1, $config2); # merge $config2 onto $config1
$config->graft($branch_name, $config2); # graft new config structure onto branch
# By convention, the configurations for each P5EE service will be located
# two levels under the hash ref as shown.
$config->{Config} # config settings for all Config services
$config->{Config}{default} # config settings for the default Config service
$config->{Security} # config settings for all Security services
$config->{Security}{default} # config settings for the default Security service
$config->{Template}{tt} # config settings for the Template service named "tt"
# 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 = {
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee',
}
},
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => '303292',
},
};
# A comparable unvalidating XML file would look like this.
<conf>
<Standard>
<Log-Dispatch logdir="/var/p5ee"/>
</Standard>
<Authen passwd="/etc/passwd" seed="303292"/>
</conf>
# A comparable ini file (.ini) would look like this.
[Standard.Log-Dispatch]
logdir = /var/p5ee
[Authen]
passwd = /etc/passwd
seed = 303292
# A comparable Java properties-like file would look like this.
Standard.Log-Dispatch.logdir = /var/p5ee
Authen.passwd = /etc/passwd
Authen.seed = 303292
=head1 DESCRIPTION
P5EEx::Blue::Config::File is the class which represents configuration
data in a file. The type of Serializer used to deserialize the
data is determined by the extension on the file name and contents
of the beginning of the file.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Config::File
* Throws: P5EEx::Blue::Exception::Config
* Since: 0.01
=head2 Design
The P5EEx::Blue::Config::File class extends the P5EEx::Blue::Config class,
overriding the create() method.
=cut
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
The constructor is inherited from
L<C<P5EEx::Blue::Config>|P5EEx::Blue::Config/"new()">.
=cut
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods:
=cut
#############################################################################
# get()
#############################################################################
=head2 get()
The constructor is inherited from
L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Reference/"get()">.
=cut
#############################################################################
# get_branch()
#############################################################################
=head2 get_branch()
The constructor is inherited from
L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Reference/"get_branch()">.
=cut
#############################################################################
# dump()
#############################################################################
=head2 dump()
The constructor is inherited from
L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Reference/"dump()">.
=cut
#############################################################################
# PROTECTED METHODS
#############################################################################
=head1 Protected Methods:
The following methods are intended to be called by subclasses of the
current class.
=cut
#############################################################################
# create()
#############################################################################
=head2 create()
* Signature: $config_data = $config->create($named);
* Param: void
* Param: configFile string
* Return: $config_data {}
* Throws: P5EEx::Blue::Exception::Config
* Since: 0.01
Sample Usage:
$config_data = $config->create();
$config_data = $config->create(
configFile => "config.xml",
);
This method overrides the default create() method for a Reference.
=cut
=head1 ACKNOWLEDGEMENTS
* Author: Stephen Adkins <[EMAIL PROTECTED]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
=head1 SEE ALSO
L<C<P5EEx::Blue::P5EE>|P5EEx::Blue::P5EE>,
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context>,
L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Reference>,
L<C<P5EEx::Blue::Config>|P5EEx::Blue::Config>
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Context/CGI.pm
Index: CGI.pm
===================================================================
#############################################################################
## $Id: CGI.pm,v 1.1 2002/01/03 18:19:16 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context::CGI;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Context;
@ISA = ( "P5EEx::Blue::Context" );
use strict;
use CGI;
#############################################################################
# PROTECTED METHODS
#############################################################################
=head1 Protected Methods:
The following methods are intended to be called by subclasses of the
current class.
=cut
#############################################################################
# init()
#############################################################################
=head2 init()
The init() method is called from within the standard Context constructor.
The CGI Context implements the init() method to take into account that
a CGI object might have been passed in as an argument.
If a CGI object is not passed in as an argument, a new CGI object is
created, thus parsing the CGI request.
* Signature: $context->init($args)
* Param: $args hash{string} [in]
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$context->init($args);
=cut
sub init {
my ($self, $args) = @_;
my ($lang);
if (defined $ENV{"HTTP_ACCEPT_LANGUAGE"}) {
$lang = $ENV{"HTTP_ACCEPT_LANGUAGE"};
$lang =~ s/ *,.*//;
$lang =~ s/-/_/g;
# do something with the $lang ...
}
if (defined $args && ref($args) eq "HASH") {
if (! defined $args->{cgi}) {
$args->{cgi} = CGI->new();
}
$self->{cgi} = $args->{cgi}; # save the CGI object reference
}
else {
$self->{cgi} = CGI->new();
}
}
#############################################################################
# dispatch_events()
#############################################################################
=head2 dispatch_events()
The dispatch_events() method is called by the CGI script
in order to get the Context object rolling. It causes the program to
process the CGI request, interpret and dispatch encoded events in the
request and exit.
In concept, the dispatch_events() method would not return until all
events for a Session were dispatched. However, the reality of the CGI
context is that events associated with a Session occur in many different
processes over different CGI requests. Therefore, the CGI Context
implements the dispatch_events() method to return after processing
all of the events of a single request, assuming that it will be called
again when the next CGI request is received.
It is considered "protected" because no classes should be calling it.
* Signature: $context->dispatch_events()
* Param: void
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$context->dispatch_events();
=cut
sub dispatch_events {
my ($self) = @_;
my $cgi = $self->{cgi};
if (defined $cgi) {
my ($session, $wname);
$session = $self->session(); # get the Session
$wname = $cgi->param("wname"); # the "wname" variable is treated
specially
$wname = "" if (!defined $wname);
$session->set("Widget.default.wname", $wname) if ($wname ne "");
##########################################################
# For each CGI variable, do the appropriate thing
# 1. "p5ee.event.*" variable is an event and gets handled last
# 2. "p5ee.*" variable is a "multi-level hash key" under $self
# 3. "wname{m}[1]" variable is a "multi-level hash key" under
$self->{widget}{$wname}
# 4. "wname" variable is a "multi-level hash key"
##########################################################
my (@eventvars, $var, @values, $value, $mlhashkey, $name, $multiple);
@eventvars = ();
foreach $var ($cgi->param()) {
if ($var =~ /^p5ee\.event/) {
push(@eventvars, $var);
}
elsif ($var =~ /^p5ee.session/) {
# do nothing.
# these vars are used in the Session restore() to restore state.
}
else {
@values = $cgi->param($var);
if ($#values > 0) {
$value = [ @values ];
}
elsif ($#values == 0) {
$value = $values[0];
}
else {
$value = "";
}
# Indexed vars: e.g. "table_editor{data}[1][5]"
if ($var =~ /[\[\]\{\}]/) {
$session->set("Widget.$var", $value);
}
else {
# check to see if the value should be multi-valued
$multiple = $session->get("Widget.{$var}.multiple");
if ($multiple && ref($value) eq "") {
$value = [ $value ];
}
# Subwidget vars: e.g. "app.nav.toolbar"
if ($var =~ /\./) {
$session->set("Widget.$var", $value);
}
# Autoattribute vars: e.g. "width" (an attribute of widget named
in request)
elsif ($wname) {
$session->set("Widget.{$wname}.$var", $value);
}
# Simple vars: e.g. "width" (gets dumped in the "default" widget)
else {
$session->set("Widget.default.$var", $value);
}
}
}
}
my ($key, $fullkey, $args, @args, $event, %x, %y, $x, $y);
foreach $key (@eventvars) {
# These events come from <input type=submit> type controls
# The format is name="p5ee.event.{widgetName}.{event}(args)"
# Note: this format is important because the "value" is needed for
display purposes
if ($key =~ /^p5ee\.event\./) {
$args = "";
@args = ();
if ($key =~ /\((.*)\)/) { # look for anything inside
parentheses
$args = $1;
}
@args = split(/ *, */,$args) if ($args ne "");
# <input type=image name=joe> returns e.g. joe.x=20 joe.y=35
# these two variables get turned into one event with $x, $y added to
the end of the @args
$fullkey = $key;
if ($key =~ /^(.*)\.x$/) {
$key = $1;
$x{$key} = $cgi->param($fullkey);
next if (!defined $y{$key});
push(@args, $x{$key}); # tack $x, $y coordinates on
at the end
push(@args, $y{$key});
}
elsif ($key =~ /^(.*)\.y$/) {
$key = $1;
$y{$key} = $cgi->param($fullkey);
next if (!defined $x{$key});
push(@args, $x{$key}); # tack $x, $y coordinates on
at the end
push(@args, $y{$key});
}
else {
push(@args, $cgi->param($key)); # tack the label on at the end
}
$key =~ s/^p5ee\.event\.//; # get rid of prefix
$key =~ s/\(.*//; # get rid of args
if ($key =~ /^([^()]+)\.([a-zA-Z0-9_-]+)$/) {
$name = $1;
$event = $2;
#$self->add_message("Event (input): name=[$name] event=[$event]
args=[@args]\n");
$self->dbgprint(ref($self), "->process_request(button):
$name->$event(@args)")
if ($Widget::DEBUG && $self->dbg(ref($self),
"process_request", 1));
$self->widget($name)->handle_event($name, $event, @args);
}
}
elsif ($key eq "p5ee.event") {
# These events come from <input type=hidden> type controls
# They are basically call-backs so that the widget could clean up
something before being viewed
# The format is name="p5ee.event" value="{widgetName}.{event}"
foreach $value ($cgi->param($key)) {
if ($value =~ /^([^()]+)\.([a-zA-Z0-9_-]+)/) {
$name = $1;
$event = $2;
$args = "";
@args = ();
if ($value =~ /\((.*)\)/) { # look for anything inside
parentheses
$args = $1;
}
@args = split(/ *, */,$args) if ($args ne "");
#$self->add_message("Event (hidden): name=[$name]
event=[$event] args=[@args]\n");
$self->dbgprint(ref($self), "->process_request(hidden):
$name->$event(@args)")
if ($Widget::DEBUG && $self->dbg(ref($self),
"process_request", 1));
$self->widget($name)->handle_event($name, $event, @args);
}
}
}
}
}
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods:
=cut
#############################################################################
# log()
#############################################################################
=head2 log()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"log()">.
=cut
#############################################################################
# user()
#############################################################################
=head2 user()
The user() method returns the username of the authenticated user.
The special name, "guest", refers to the unauthenticated (anonymous) user.
* Signature: $username = $context->user();
* Param: void
* Return: string
* Throws: <none>
* Since: 0.01
Sample Usage:
$username = $context->user();
=cut
sub user {
my $self = shift;
my ($user);
$user = $self->{cgi}->remote_user();
$user = "guest" if (!$user);
$user;
}
#############################################################################
# config()
#############################################################################
=head2 config()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"config()">.
=cut
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods: Debugging
=cut
#############################################################################
# dbg()
#############################################################################
=head2 dbg()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbg()">.
=cut
#############################################################################
# dbgprint()
#############################################################################
=head2 dbgprint()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgprint()">.
=cut
#############################################################################
# dbglevel()
#############################################################################
=head2 dbglevel()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbglevel()">.
=cut
#############################################################################
# dbgscope()
#############################################################################
=head2 dbgscope()
This method is inherited from
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgscope()">.
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Serializer/Ini.pm
Index: Ini.pm
===================================================================
#############################################################################
## $Id: Ini.pm,v 1.1 2002/01/03 18:19:16 spadkins Exp $
#############################################################################
package P5EEx::Blue::Serializer::Ini;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Serializer;
@ISA = ( "P5EEx::Blue::Serializer" );
use P5EEx::Blue::Reference;
use strict;
=head1 NAME
P5EEx::Blue::Serializer::Ini - Interface for serialization and deserialization
=head1 SYNOPSIS
use P5EEx::Blue::P5EE;
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = {
an => 'arbitrary',
collection => [ 'of', 'data', ],
of => {
arbitrary => 'depth',
},
};
$inidata = $serializer->serialize($data);
$data = $serializer->deserialize($inidata);
print $serializer->dump($data), "\n";
=head1 DESCRIPTION
A Serializer allows you to serialize a structure of data
of arbitrary depth to a scalar and deserialize it back to the
structure.
The Ini serializer reads and writes data which conforms to
the standards of Windows INI files.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Serializer::Ini
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
=head2 Design
The class is entirely made up of static (class) methods.
However, they are each intended to be
called as methods on the instance itself.
=cut
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
The constructor is inherited from
L<C<P5EEx::Blue::Service>|P5EEx::Blue::Service/"new()">.
=cut
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods:
=cut
#############################################################################
# serialize()
#############################################################################
=head2 serialize()
* Signature: $inidata = $serializer->serialize($data);
* Param: $data ref
* Return: $inidata text
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = {
an => 'arbitrary',
collection => [ 'of', 'data', ],
of => {
arbitrary => 'depth',
},
};
$inidata = $serializer->serialize($data);
=cut
sub serialize {
my ($self, $data) = @_;
my ($inidata);
return $inidata;
}
#############################################################################
# deserialize()
#############################################################################
=head2 deserialize()
* Signature: $data = $serializer->deserialize($inidata);
* Signature: $data = P5EEx::Blue::Serializer->deserialize($inidata);
* Param: $data ref
* Return: $inidata text
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = $serializer->deserialize($inidata);
print $serializer->dump($data), "\n";
=cut
sub deserialize {
my ($self, $inidata) = @_;
my ($data, $r, @inidata, $line, $branch_name, $branch, $attrib, $value);
$r = P5EEx::Blue::Reference->new(); # dummy ref (shorthand for static calls)
$data = {};
foreach $line (split(/\n/, $inidata)) {
next if ($line =~ /^;/); # ignore comments
next if ($line =~ /^#/); # ignore comments
if ($line =~ /^\[([^\[\]]+)\] *$/) { # i.e. [Repository.default]
$branch_name = $1;
$branch = $r->get_branch($branch_name,1,$data);
}
elsif ($line =~ /^ *([^ =]+) *= *(.*)$/) {
$attrib = $1;
$value = $2;
if ($branch) {
$r->set($attrib, $value, $branch);
}
else {
$r->set($attrib, $value, $data);
}
}
}
return $data;
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
The constructor is inherited from
L<C<P5EEx::Blue::Serializer>|P5EEx::Blue::Serializer/"dump()">.
=head1 ACKNOWLEDGEMENTS
* Author: Stephen Adkins <[EMAIL PROTECTED]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
=head1 SEE ALSO
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context>,
L<C<P5EEx::Blue::Service>|P5EEx::Blue::Service>
=cut
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Serializer/Properties.pm
Index: Properties.pm
===================================================================
#############################################################################
## $Id: Properties.pm,v 1.1 2002/01/03 18:19:16 spadkins Exp $
#############################################################################
package P5EEx::Blue::Serializer::Properties;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Serializer;
@ISA = ( "P5EEx::Blue::Serializer" );
use P5EEx::Blue::Reference;
use strict;
=head1 NAME
P5EEx::Blue::Serializer::Properties - Interface for serialization and deserialization
=head1 SYNOPSIS
use P5EEx::Blue::P5EE;
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = {
an => 'arbitrary',
collection => [ 'of', 'data', ],
of => {
arbitrary => 'depth',
},
};
$propdata = $serializer->serialize($data);
$data = $serializer->deserialize($propdata);
print $serializer->dump($data), "\n";
=head1 DESCRIPTION
A Serializer allows you to serialize a structure of data
of arbitrary depth to a scalar and deserialize it back to the
structure.
The Properties serializer reads and writes data which conforms to
the standards of Java properties files.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Serializer::Properties
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
=head2 Design
The class is entirely made up of static (class) methods.
However, they are each intended to be
called as methods on the instance itself.
=cut
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
The constructor is inherited from
L<C<P5EEx::Blue::Service>|P5EEx::Blue::Service/"new()">.
=cut
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods:
=cut
#############################################################################
# serialize()
#############################################################################
=head2 serialize()
* Signature: $propdata = $serializer->serialize($data);
* Param: $data ref
* Return: $propdata text
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = {
an => 'arbitrary',
collection => [ 'of', 'data', ],
of => {
arbitrary => 'depth',
},
};
$propdata = $serializer->serialize($data);
=cut
sub serialize {
my ($self, $data) = @_;
my ($propdata);
return $propdata;
}
#############################################################################
# deserialize()
#############################################################################
=head2 deserialize()
* Signature: $data = $serializer->deserialize($propdata);
* Signature: $data = P5EEx::Blue::Serializer->deserialize($propdata);
* Param: $data ref
* Return: $propdata text
* Throws: P5EEx::Blue::Exception::Serializer
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$serializer = $context->service("Serializer"); # or ...
$serializer = $context->serializer();
$data = $serializer->deserialize($propdata);
print $serializer->dump($data), "\n";
=cut
sub deserialize {
my ($self, $propdata) = @_;
my ($data, $r, $line, $attrib, $value);
$r = P5EEx::Blue::Reference->new(); # dummy ref (shorthand for static calls)
$data = {};
foreach $line (split(/\n/, $propdata)) {
next if ($line =~ /^#/); # ignore comments
if ($line =~ /^ *([^ =]+) *= *(.*)$/) {
$attrib = $1;
$value = $2;
$r->set($attrib, $value, $data);
}
}
return $data;
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
The constructor is inherited from
L<C<P5EEx::Blue::Serializer>|P5EEx::Blue::Serializer/"dump()">.
=head1 ACKNOWLEDGEMENTS
* Author: Stephen Adkins <[EMAIL PROTECTED]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
=head1 SEE ALSO
L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context>,
L<C<P5EEx::Blue::Service>|P5EEx::Blue::Service>
=cut
1;
1.1 p5ee/P5EEx/Blue/examples/Config.1.out
Index: Config.1.out
===================================================================
FROM PERL: $conf = bless( {
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => 303292
},
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee'
}
},
'Session' => {
'default' => {
'sessionClass' => 'P5EE::Blue::Session::CGI'
}
}
}, 'P5EEx::Blue::Config::File' );
FROM config.pl: $conf = bless( {
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => 303292
},
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee'
}
},
'Session' => {
'default' => {
'sessionClass' => 'P5EE::Blue::Session::CGI'
}
}
}, 'P5EEx::Blue::Config::File' );
FROM config.xml: $conf = bless( {
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => '303292'
},
'Session' => {
'default' => {
'sessionClass' => 'P5EE::Blue::Session::CGI'
}
},
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee'
}
}
}, 'P5EEx::Blue::Config::File' );
FROM config.ini: $conf = bless( {
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => '303292'
},
'Session' => {
'default' => {
'sessionClass' => 'P5EE::Blue::Session::CGI'
}
},
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee'
}
}
}, 'P5EEx::Blue::Config::File' );
FROM config.properties: $conf = bless( {
'Authen' => {
'passwd' => '/etc/passwd',
'seed' => '303292'
},
'Session' => {
'default' => {
'sessionClass' => 'P5EE::Blue::Session::CGI'
}
},
'Standard' => {
'Log-Dispatch' => {
'logdir' => '/var/p5ee'
}
}
}, 'P5EEx::Blue::Config::File' );
1.1 p5ee/P5EEx/Blue/examples/Reference.1.out
Index: Reference.1.out
===================================================================
1. pi=3.1416
2. pi=3.1416
Nonexistent branch: [undef]
Existent branch: defined
1.1 p5ee/P5EEx/Blue/sbin/perlchanges
Index: perlchanges
===================================================================
#!/usr/local/bin/perl
$SRCDIR = "/usr/local/src/perl-5.6.1";
$HTMLDIR = "htdocs/delta";
@functions = (
#Functions for SCALARs or strings
"chomp", "chop", "chr", "crypt", "index", "lc", "lcfirst", "length", "ord",
"q", "qq", "reverse", "rindex", "sprintf", "substr", "tr", "uc", "ucfirst", "y",
#Regular expressions and pattern matching
"m", "pos", "quotemeta", "s", "split", "study", "qr",
#Numeric functions
"abs", "atan2", "cos", "exp", "hex", "int", "log", "oct", "rand", "sin", "sqrt",
"srand",
#Functions for real @ARRAYs
"pop", "push", "shift", "splice", "unshift",
#Functions for list data
"grep", "join", "map", "qw", "reverse", "sort",
#Functions for real %HASHes
"delete", "each", "exists", "keys", "values",
#Input and output functions
"binmode", "close", "closedir", "dbmclose", "dbmopen", "eof", "fileno", "flock",
"format",
"getc", "print", "printf", "read", "readdir", "rewinddir", "seek", "seekdir",
"select", "syscall",
"sysread", "sysseek", "syswrite", "tell", "telldir", "truncate", "warn", "write",
#Functions for fixed length data or records
"pack", "unpack", "vec",
#Functions for filehandles, files, or directories
"-X", "chdir", "chmod", "chown", "chroot", "fcntl", "glob", "ioctl", "link",
"lstat", "mkdir", "open",
"opendir", "readlink", "rename", "rmdir", "stat", "symlink", "umask", "unlink",
"utime",
#Keywords related to the control flow of your perl program
"caller", "continue", "die", "dump", "eval", "exit", "goto", "last", "next",
"redo", "return",
"sub", "wantarray",
#Keywords related to scoping
"import", "local", "my", "our", "package", "use",
#Miscellaneous functions
"defined", "formline", "reset", "scalar", "undef",
#Functions for processes and process groups
"alarm", "exec", "fork", "getpgrp", "getppid", "getpriority", "kill", "pipe",
"qx", "setpgrp",
"setpriority", "sleep", "system", "wait", "waitpid",
#Keywords related to perl modules
"do", "no", "require", "isa",
#Keywords related to classes and object-orientedness
"bless", "ref", "tie", "tied", "untie",
#Low-level socket functions
"accept", "bind", "connect", "getpeername", "getsockname", "getsockopt",
"listen", "recv", "send",
"setsockopt", "shutdown", "socket", "socketpair",
#System V interprocess communication functions
"msgctl", "msgget", "msgrcv", "msgsnd", "semctl", "semget", "semop", "shmctl",
"shmget", "shmread",
"shmwrite",
#Fetching user and group info
"endgrent", "endhostent", "endnetent", "endpwent", "getgrent", "getgrgid",
"getgrnam", "getlogin",
"getpwent", "getpwnam", "getpwuid", "setgrent", "setpwent",
#Fetching network info
"endprotoent", "endservent", "gethostbyaddr", "gethostbyname", "gethostent",
"getnetbyaddr", "getnetbyname",
"getnetent", "getprotobyname", "getprotobynumber", "getprotoent",
"getservbyname", "getservbyport",
"getservent", "sethostent", "setnetent", "setprotoent", "setservent",
#Time-related functions
"gmtime", "localtime", "time", "times",
#Functions new in perl5
"prototype", "readline", "readpipe", "sysopen",
);
@variables = (
'$ARG',
'$_', #The default input and pattern-searching space.
'$<digits>',
'$1',
'$MATCH',
'$&', #The string matched by the last successful pattern
'$PREMATCH',
'$`', #The string preceding whatever was matched by the
'$POSTMATCH',
'$\'', #The string following whatever was matched by the
'$LAST_PAREN_MATCH',
'$+', #The last bracket matched by the last search pat�
'@LAST_MATCH_END',
'@+', #This array holds the offsets of the ends of the
'$MULTILINE_MATCHING',
'$*', #Set to a non-zero integer value to do multi-line
'input_line_number', #HANDLE EXPR
'$INPUT_LINE_NUMBER',
'$NR',
'$.', #The current input record number for the last file
'input_record_separator', #HANDLE EXPR
'$INPUT_RECORD_SEPARATOR',
'$RS',
'$/', #The input record separator, newline by default.
'autoflush', #HANDLE EXPR
'$OUTPUT_AUTOFLUSH',
'$|', #If set to nonzero, forces a flush right away and
'output_field_separator', #HANDLE EXPR
'$OUTPUT_FIELD_SEPARATOR',
'$OFS',
'$,', #The output field separator for the print operator.
'output_record_separator', #HANDLE EXPR
'$OUTPUT_RECORD_SEPARATOR',
'$ORS',
'$\\', #The output record separator for the print opera�
'$LIST_SEPARATOR',
'$""', #This is like "$," except that it applies to array
'$SUBSCRIPT_SEPARATOR',
'$SUBSEP',
'$;', #The subscript separator for multidimensional array
'$OFMT',
'$#', #The output format for printed numbers. This vari�
'format_page_number', #HANDLE EXPR
'$FORMAT_PAGE_NUMBER',
'$%', #The current page number of the currently selected
'format_lines_per_page', #HANDLE EXPR
'$FORMAT_LINES_PER_PAGE',
'$=', #The current page length (printable lines) of the
'format_lines_left', #HANDLE EXPR
'$FORMAT_LINES_LEFT',
'$-', #The number of lines left on the page of the cur�
'@LAST_MATCH_START',
'@-', #$-[0] is the offset of the start of the last suc�
'format_name', #HANDLE EXPR
'$FORMAT_NAME',
'$~', #The name of the current report format for the cur�
'format_top_name', #HANDLE EXPR
'$FORMAT_TOP_NAME',
'$^', #The name of the current top-of-page format for the
'format_line_break_characters', #HANDLE EXPR
'$FORMAT_LINE_BREAK_CHARACTERS',
'$:', #The current set of characters after which a string
'format_formfeed', #HANDLE EXPR
'$FORMAT_FORMFEED',
'$^L', #What formats output as a form feed. Default is
'$ACCUMULATOR',
'$^A', #The current value of the write() accumulator for
'$CHILD_ERROR',
'$?', #The status returned by the last pipe close, back�
'$OS_ERROR',
'$ERRNO',
'$!', #If used numerically, yields the current value of
'$EXTENDED_OS_ERROR',
'$^E', #Error information specific to the current operat�
'$EVAL_ERROR',
'$@', #The Perl syntax error message from the last eval()
'$PROCESS_ID',
'$PID',
'$$', #The process number of the Perl running this
'$REAL_USER_ID',
'$UID',
'$<', #The real uid of this process. (Mnemonic: it's the...)
'$EFFECTIVE_USER_ID',
'$EUID',
'$>', #The effective uid of this process. Example:
'$REAL_GROUP_ID',
'$GID',
'$(', #The real gid of this process. If you are on a
'$EFFECTIVE_GROUP_ID',
'$EGID',
'$)', #The effective gid of this process. If you are on
'$PROGRAM_NAME',
'$0', #Contains the name of the program being executed.
'$[', #The index of the first element in an array, and of
'$]', #The version + patchlevel / 1000 of the Perl inter�
'$COMPILING',
'$^C', #The current value of the flag associated with the
'$DEBUGGING',
'$^D', #The current value of the debugging flags.
'$SYSTEM_FD_MAX',
'$^F', #The maximum system file descriptor, ordinarily 2.
'$^H', #WARNING: This variable is strictly for internal
'%^H', #WARNING: This variable is strictly for internal
'$INPLACE_EDIT',
'$^I', #The current value of the inplace-edit extension.
'$^M', #By default, running out of memory is an untrap�
'$OSNAME',
'$^O', #The name of the operating system under which this
'$PERLDB',
'$^P', #The internal variable for debugging support. The
'$LAST_REGEXP_CODE_RESULT',
'$^R', #The result of evaluation of the last successful
'$EXCEPTIONS_BEING_CAUGHT',
'$^S', #Current state of the interpreter. Undefined if
'$BASETIME',
'$^T', #The time at which the program began running, in
'$PERL_VERSION',
'$^V', #The revision, version, and subversion of the Perl
'$WARNING',
'$^W', #The current value of the warning switch, initially
'${^WARNING_BITS}',
'${^WIDE_SYSTEM_CALLS}',
'$EXECUTABLE_NAME',
'$^X', #The name that the Perl binary itself was executed
'$ARGV', #contains the name of the current file when reading
'@ARGV', #The array @ARGV contains the command-line argu�
'@INC', #The array @INC contains the list of places that
'@_', #Within a subroutine the array @_ contains the
'%INC', #The hash %INC contains entries for each filename
'%ENV',
'$ENV{',
'%SIG',
'$SIG{',
'STDIN',
'STDOUT',
'STDERR',
'ARGVOUT',
);
if (! -d $HTMLDIR) {
mkdir($HTMLDIR, 0777);
}
foreach $basefile qw(Changes Changes5.005 Changes5.004 Changes5.003 Changes5.002
Changes5.001 Changes5.000) {
$changefile = "$SRCDIR/$basefile";
open(FILE, "< $changefile") || die "Unable to open [$changefile]: $!";
$htmlfile = "$HTMLDIR/${basefile}.html";
open(HTML, "> $htmlfile") || die "Unable to open [$htmlfile]: $!";
print "File: $changefile\n";
print HTML <<EOF;
<html>
<head>
<title>$basefile</title>
</head>
<body bgcolor="white">
<pre>
EOF
$lineno = 1;
$version = "";
while (<FILE>) {
chomp;
$line = $_;
$htmlline = $line;
$htmlline =~ s{&}{&}gso;
$htmlline =~ s{<}{<}gso;
$htmlline =~ s{>}{>}gso;
$htmlline =~ s{\"}{"}gso;
print HTML "<a name=\"$lineno\"></a>", $htmlline, "\n";
if ($line =~ /^Version[^0-9]+([0-9][0-9\._a-z]+)/i) {
$version = $1;
print "Version: $version\n";
}
if ($version) {
if ($line !~ /From:/) {
if (($basefile eq "Changes" && $line =~ /Log:/) ||
($basefile eq "Changes5.005" && $line =~ /Log:/) ||
($basefile eq "Changes5.004" && $line =~ /Title:/) ||
($basefile eq "Changes5.003") ||
($basefile eq "Changes5.002" && $line =~ /^NET/) ||
($basefile eq "Changes5.001" && $line =~ /^NET/) ||
($basefile eq "Changes5.000")) {
$htmlline =~ s/^ +//;
foreach $function (@functions) {
if ($line =~ /\b$function\b/) {
$function_xref{$function} .= " [<a
href=\"${basefile}.html#$lineno\">$version</a>] $htmlline\n";
}
}
foreach $variable (@variables) {
if (index($line, $variable) > -1) {
$variable_xref{$variable} .= " [<a
href=\"${basefile}.html#$lineno\">$version</a>] $htmlline\n";
}
}
}
}
}
$lineno++;
}
print HTML <<EOF;
</pre>
</body>
</html>
EOF
close(HTML);
close(FILE);
}
$htmlfile = "$HTMLDIR/index.html";
open(HTML, "> $htmlfile") || die "Unable to open [$htmlfile]: $!";
print HTML <<EOF;
<html>
<head>
<title>Perl Changes Cross-Reference</title>
</head>
<body bgcolor="white">
<h1>Perl Changes Cross-Reference</h1>
<hr>
EOF
print HTML "<b>Functions:</b>\n";
foreach $function (sort @functions) {
print HTML " [<a href=\"#$function\">$function</a>]\n";
}
print HTML "<p>\n";
print HTML "<b>Variables:</b>\n";
foreach $variable (@variables) {
$variable_html = $variable;
$variable_html =~ s{&}{&}gso;
$variable_html =~ s{<}{<}gso;
$variable_html =~ s{>}{>}gso;
$variable_html =~ s{\"}{"}gso;
$variable_anchor = $variable;
$variable_anchor =~ s!([ -\/\{-\~\@\[-\`])!uc sprintf("X%02x",ord($1))!eg;
print HTML " [<a href=\"#$variable_anchor\">$variable_html</a>]\n";
}
print HTML "<hr>\n";
print HTML "<h2>Functions</h2>\n";
print HTML "<pre>\n";
foreach $function (sort @functions) {
print HTML "<a name=\"$function\">$function</a>\n", $function_xref{$function},
"\n";
}
print HTML "</pre>\n";
print HTML "<hr>\n";
print HTML "<h2>Variables</h2>\n";
print HTML "<pre>\n";
foreach $variable (@variables) {
$variable_html = $variable;
$variable_html =~ s{&}{&}gso;
$variable_html =~ s{<}{<}gso;
$variable_html =~ s{>}{>}gso;
$variable_html =~ s{\"}{"}gso;
$variable_anchor = $variable;
$variable_anchor =~ s!([ -\/\{-\~\@\[-\`])!uc sprintf("X%02x",ord($1))!eg;
print HTML "<a name=\"$variable_anchor\">$variable_html</a>\n",
$variable_xref{$variable}, "\n";
}
print HTML "</pre>\n";
print HTML <<EOF;
</body>
</html>
EOF
