cvsuser 01/12/05 14:45:05
Modified: P5EEx/Blue MANIFEST
P5EEx/Blue/P5EEx/Blue Config.pm Config.pod Context.pm
Exceptions.pm Messaging.pm P5EE.pm Procedure.pm
Repository.pm Security.pm Serializer.pm Service.pm
Session.pm Widget.pm
P5EEx/Blue/examples Config.1
P5EEx/Blue/sbin perldocs
Added: P5EEx/Blue/P5EEx/Blue LogChannel.pm Template.pm
P5EEx/Blue/P5EEx/Blue/Config File.pm
P5EEx/Blue/P5EEx/Blue/Serializer Storable.pm XMLSimple.pm
P5EEx/Blue/examples Reference.1 config.ini config.properties
config.xml
Removed: P5EEx/Blue/P5EEx/Blue Log.pm Templates.pm
Log:
Got Config working with Serializer. Changed Templates to Template. Added Exceptions
and tests.
Revision Changes Path
1.4 +35 -5 p5ee/P5EEx/Blue/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/MANIFEST,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- MANIFEST 2001/11/22 05:16:58 1.3
+++ MANIFEST 2001/12/05 22:45:03 1.4
@@ -1,12 +1,42 @@
-CHANGES
-MANIFEST
Makefile.PL
README
TODO
-P5EEx/Blue/perlstyle.pod
-P5EEx/Blue/podstyle.pod
+CHANGES
+MANIFEST
P5EEx/Blue/P5EE.pm
+P5EEx/Blue/Exceptions.pm
+P5EEx/Blue/Reference.pm
P5EEx/Blue/Config.pm
+P5EEx/Blue/Config.pod
+P5EEx/Blue/Config/File.pm
+P5EEx/Blue/Config/File.pod
P5EEx/Blue/Context.pm
P5EEx/Blue/Context/CGI.pm
-P5EEx/Blue/Config/XML.pm
+P5EEx/Blue/Service.pm
+P5EEx/Blue/Serializer.pm
+P5EEx/Blue/Serializer/XMLSimple.pm
+P5EEx/Blue/Serializer/Ini.pm
+P5EEx/Blue/Serializer/Properties.pm
+P5EEx/Blue/Session.pm
+P5EEx/Blue/Security.pm
+P5EEx/Blue/Repository.pm
+P5EEx/Blue/Template.pm
+P5EEx/Blue/Widget.pm
+P5EEx/Blue/Messaging.pm
+P5EEx/Blue/Procedure.pm
+P5EEx/Blue/LogChannel.pm
+P5EEx/Blue/datetime.pod
+P5EEx/Blue/perlstyle.pod
+P5EEx/Blue/podstyle.pod
+sbin/perldocs
+htdocs/api/perldocs.css
+htdocs/style.css
+htdocs/images/logo.gif
+examples/Config.1
+examples/Config.1.out
+examples/config.ini
+examples/config.pl
+examples/config.xml
+examples/Reference.1
+examples/Reference.1.out
+t/Config.t
1.4 +7 -90 p5ee/P5EEx/Blue/P5EEx/Blue/Config.pm
Index: Config.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Config.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Config.pm 2001/11/22 05:16:59 1.3
+++ Config.pm 2001/12/05 22:45:03 1.4
@@ -1,101 +1,18 @@
#############################################################################
-## $Id: Config.pm,v 1.3 2001/11/22 05:16:59 spadkins Exp $
+## $Id: Config.pm,v 1.4 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Config;
-$VERSION = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.4 $=~/\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/
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
-
- my ($name, $args, $i);
- if ($#_ == -1) {
- $args = {};
- $name = "default";
- }
- else {
- if (ref($_[0]) eq "HASH") {
- $args = shift;
- $name = shift if ($#_ % 2 == 0);
- for ($i = 0; $i < $#_; $i++) {
- $args->{$_[$i]} = $_[$i+1];
- }
- }
- else {
- $name = shift if ($#_ % 2 == 0);
- $args = ($#_ > -1) ? { @_ } : {};
- }
- $name = $args->{name} if (!$name);
- $name = "default" if (!$name);
- }
-
- # bootstrap phase: bless an empty hash
- my $self = {};
- bless $self, $class;
-
- # load phase: replace empty hash with loaded hash, bless again
- $self = $self->load($args);
- bless $self, $class;
-
- $self->init($args); # allows a subclass to override this portion
+use P5EEx::Blue::P5EE;
+use P5EEx::Blue::Reference;
+@ISA = ( "P5EEx::Blue::Reference" );
- return $self;
-}
-
-sub init {
- my $self = shift;
-}
-
-sub load {
- my ($self, $args) = @_;
- local(*FILE);
-
- my ($file, @perl, $perl, $conf, $open);
- if (defined $args && $args->{configFile}) {
- $file = $args->{configFile};
- $open = open(main::FILE,"< $file");
- }
- else {
- $file = $0;
- $file =~ s!\.[^/]*$!!;
- $file .= ".pl";
- $open = open(main::FILE,"< $file");
- $open = open(main::FILE,"< config.pl") if (!$open);
- }
-
- $conf = {};
- if ($open) {
- @perl = <main::FILE>;
- close(main::FILE);
- $perl = join("",@perl);
- if ($perl =~ /^\$[a-zA-Z][a-zA-Z0-9_]* *= *(\{.*\};[ \n]*)$/s) {
- $perl = "\$conf = $1"; # untainted now
- eval($perl);
- P5EEx::Blue::Exception::Config->throw( error => $@ );
- }
- else {
- P5EEx::Blue::Exception::Config->throw( error =>
- "Data didn't have \"\$var = {...};\" format." );
- }
- }
- $conf;
-}
-
-use Data::Dumper;
+use strict;
-sub dump {
- my ($self) = @_;
- my $d = Data::Dumper->new([ $self ], [ "conf" ]);
- $d->Indent(1);
- return $d->Dump();
-}
+# there are no methods for this class yet
1;
1.4 +4 -4 p5ee/P5EEx/Blue/P5EEx/Blue/Config.pod
Index: Config.pod
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Config.pod,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Config.pod 2001/11/30 16:00:52 1.3
+++ Config.pod 2001/12/05 22:45:03 1.4
@@ -1,6 +1,6 @@
######################################################################
-## $Id: Config.pod,v 1.3 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Config.pod,v 1.4 2001/12/05 22:45:03 spadkins Exp $
######################################################################
=head1 NAME
@@ -32,7 +32,7 @@
$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->{Templates}{tt} # config settings for the Templates service named
"tt"
+ $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,
@@ -100,7 +100,7 @@
=back
-=head2 Class Group Requirements
+=head2 Requirements
The following are enumerated requirements for the Config Class Group.
It forms a high-level feature list.
@@ -136,7 +136,7 @@
* Throws: P5EEx::Blue::Exception::Config
* Since: 0.01
-=head2 Class Design
+=head2 Design
The P5EEx::Blue::Config class is a very thin code wrapper around a perl
data structure. Although they could access the data directly through
1.5 +5 -5 p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm
Index: Context.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- Context.pm 2001/11/30 16:00:52 1.4
+++ Context.pm 2001/12/05 22:45:03 1.5
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.4 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Context.pm,v 1.5 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context;
@@ -23,7 +23,7 @@
# any of the following named parameters may be specified
$context = P5EEx::Blue::P5EE->context(
contextClass => "P5EEx::Blue::Context::CGI",
- configClass => "P5EEx::Blue::Config::XML", # or any Config args
+ configClass => "P5EEx::Blue::Config::File", # or any Config args
);
# ... alternative way (used internally) ...
@@ -151,7 +151,7 @@
$context = P5EEx::Blue::Context->new();
$context = P5EEx::Blue::Context->new(
contextClass => 'P5EEx::Blue::Context::CGI',
- configClass => 'P5EEx::Blue::Config::XML',
+ configClass => 'P5EEx::Blue::Config::File',
configFile => 'config.xml',
);
@@ -188,7 +188,7 @@
$config_class = $args->{configClass};
$config_class = $ENV{P5EE_CONFIG_CLASS} if (! $config_class);
- $config_class = "P5EEx::Blue::Config" if (! $config_class);
+ $config_class = "P5EEx::Blue::Config::File" if (! $config_class);
$self->{config} = P5EEx::Blue::P5EE->new($config_class, "new", $args);
@@ -250,7 +250,7 @@
=head2 log()
The log() method writes a string (the concatenated list of @args) to
-a log file.
+the default log channel.
* Signature: $context->log(@args);
* Param: @args string [in]
1.3 +79 -7 p5ee/P5EEx/Blue/P5EEx/Blue/Exceptions.pm
Index: Exceptions.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Exceptions.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Exceptions.pm 2001/11/30 16:00:52 1.2
+++ Exceptions.pm 2001/12/05 22:45:03 1.3
@@ -8,38 +8,78 @@
use strict;
use vars qw($VERSION);
-$VERSION = sprintf '%2d.%02d', q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf '%2d.%02d', q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
my %e;
BEGIN {
%e = (
'P5EEx::Blue::Exception' => {
- description => 'An error occurred in P5EE.',
+ description => 'An exception in a core P5EE class.',
},
'P5EEx::Blue::Exception::Context' => {
- description => 'An error occurred in the Context.',
+ description => 'An exception in the Context service.',
isa => 'P5EEx::Blue::Exception',
},
'P5EEx::Blue::Exception::Config' => {
- description => 'An error occurred in the Config.',
+ description => 'An exception in the Config service.',
isa => 'P5EEx::Blue::Exception',
},
'P5EEx::Blue::Exception::Serializer' => {
- description => 'An error occurred in the Serializer.',
+ description => 'An exception in the Serializer service.',
isa => 'P5EEx::Blue::Exception',
},
+ 'P5EEx::Blue::Exception::Repository' => {
+ description => 'An exception in the Repository service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Security' => {
+ description => 'An exception in the Security service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Session' => {
+ description => 'An exception in the Session service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Widget' => {
+ description => 'An exception in the Widget service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Template' => {
+ description => 'An exception in the Template service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Procedure' => {
+ description => 'An exception in the Procedure service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::Messaging' => {
+ description => 'An exception in the Messaging service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
+ 'P5EEx::Blue::Exception::LogChannel' => {
+ description => 'An exception in the LogChannel service.',
+ isa => 'P5EEx::Blue::Exception',
+ },
+
);
}
use Exception::Class (%e);
-if ($ENV{P5EE_DEBUG})
-{
+#if ($ENV{P5EE_DEBUG})
+if (1) {
Exception::Class::Base->do_trace(1);
foreach my $class (keys %e) {
$class->do_trace(1);
@@ -96,6 +136,38 @@
=item * P5EEx::Blue::Exception::Serializer
Base class for all Serializer-related exceptions.
+
+=item * P5EEx::Blue::Exception::Repository
+
+Base class for all Repository-related exceptions.
+
+=item * P5EEx::Blue::Exception::Security
+
+Base class for all Security-related exceptions.
+
+=item * P5EEx::Blue::Exception::Session
+
+Base class for all Session-related exceptions.
+
+=item * P5EEx::Blue::Exception::Widget
+
+Base class for all Widget-related exceptions.
+
+=item * P5EEx::Blue::Exception::Template
+
+Base class for all Template-related exceptions.
+
+=item * P5EEx::Blue::Exception::Procedure
+
+Base class for all Procedure-related exceptions.
+
+=item * P5EEx::Blue::Exception::Messaging
+
+Base class for all Messaging-related exceptions.
+
+=item * P5EEx::Blue::Exception::LogChannel
+
+Base class for all LogChannel-related exceptions.
=back
1.3 +2 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Messaging.pm
Index: Messaging.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Messaging.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Messaging.pm 2001/11/30 16:00:52 1.2
+++ Messaging.pm 2001/12/05 22:45:03 1.3
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Messaging.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Messaging.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Messaging;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
1.5 +19 -15 p5ee/P5EEx/Blue/P5EEx/Blue/P5EE.pm
Index: P5EE.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/P5EE.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- P5EE.pm 2001/11/30 16:00:52 1.4
+++ P5EE.pm 2001/12/05 22:45:03 1.5
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: P5EE.pm,v 1.4 2001/11/30 16:00:52 spadkins Exp $
+## $Id: P5EE.pm,v 1.5 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::P5EE;
@@ -116,7 +116,7 @@
=item * Class Group: L<C<Session>|P5EEx::Blue::Session>
- represents the state associated with a sequence of multiple events
-=item * Class Group: L<C<Templates>|P5EEx::Blue::Templates>
+=item * Class Group: L<C<Template>|P5EEx::Blue::Template>
- encapsulates template system details
=item * Class Group: L<C<Procedure>|P5EEx::Blue::Procedure>
@@ -134,8 +134,8 @@
=item * Class Group: L<C<Security>|P5EEx::Blue::Security>
- provides authentication and authorization
-=item * Class Group: L<C<Log>|P5EEx::Blue::Log>
- - a logging service
+=item * Class Group: L<C<LogChannel>|P5EEx::Blue::LogChannel>
+ - a logging channel through which messages may be logged
=back
@@ -153,6 +153,10 @@
=item * Class: L<C<P5EEx::Blue::P5EE>|"Class: P5EEx::Blue::P5EE">
+=item * Class: L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Exceptions>
+
+=item * Class: L<C<P5EEx::Blue::Reference>|P5EEx::Blue::Reference>
+
=item * Class: L<C<P5EEx::Blue::Service>|P5EEx::Blue::Service>
=item * Document: L<C<Perlstyle, Perl Style Guide>|P5EEx::Blue::perlstyle>
@@ -323,23 +327,23 @@
return ($context{$name}) if (defined $context{$name});
if (! $args->{contextClass}) {
- if (defined $ENV{"P5EE_CONTEXT_CLASS"}) { # env variable set?
- $args->{contextClass} = $ENV{"P5EE_CONTEXT_CLASS"};
+ if (defined $ENV{P5EE_CONTEXT_CLASS}) { # env variable set?
+ $args->{contextClass} = $ENV{P5EE_CONTEXT_CLASS};
}
else { # try autodetection ...
- my $gateway = $ENV{"GATEWAY_INTERFACE"};
- if (defined $gateway && $gateway =~ /CGI-Perl/) { # running under
mod_perl?
+ my $gateway = $ENV{GATEWAY_INTERFACE};
+ if (defined $gateway && $gateway =~ /CGI-Perl/) { # mod_perl?
$args->{contextClass} = "P5EEx::Blue::Context::Modperl";
}
- elsif ($ENV{"HTTP_USER_AGENT"}) { # running as CGI script?
+ elsif ($ENV{HTTP_USER_AGENT}) { # running as CGI script?
$args->{contextClass} = "P5EEx::Blue::Context::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";
+ # let's be real... these next two are not critical right now
+ #elsif ($ENV{DISPLAY}) { # running with an X DISPLAY var set?
+ # $args->{contextClass} = "P5EEx::Blue::Context::Gtk";
#}
- #elsif ($ENV{"TERM"}) { # running with a TERM var to support
Curses?
- # $args->{context} = "P5EEx::Blue::Context::Curses";
+ #elsif ($ENV{TERM}) { # running with a TERM var for Curses?
+ # $args->{contextClass} = "P5EEx::Blue::Context::Curses";
#}
else { # fall back to CGI, because it works
OK in command mode
$args->{contextClass} = "P5EEx::Blue::Context::CGI";
1.2 +2 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Procedure.pm
Index: Procedure.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Procedure.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Procedure.pm 2001/11/30 16:00:52 1.1
+++ Procedure.pm 2001/12/05 22:45:03 1.2
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Procedure.pm,v 1.1 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Procedure.pm,v 1.2 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Procedure;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
1.3 +850 -3 p5ee/P5EEx/Blue/P5EEx/Blue/Repository.pm
Index: Repository.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Repository.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Repository.pm 2001/11/30 16:00:52 1.2
+++ Repository.pm 2001/12/05 22:45:03 1.3
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Repository.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Repository.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Repository;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
@@ -16,13 +17,102 @@
=head1 SYNOPSIS
- use P5EEx::Blue::P5EE;
+ use P5EEx::Blue::Repository;
$context = P5EEx::Blue::P5EE->context();
$repository = $context->service("Repository"); # or ...
$repository = $context->repository();
- ... TBD ...
+ $rep = Repository::Base->new(); # looks for %ENV, then config file
+ $rep = Repository::Base->new("sysdb"); # looks for %ENV, then config file using
"sysdb"
+ $rep2 = $rep->new(); # copies attributes of
existing $rep
+ $rep = Repository::Base->new(@positional_args); # undefined for
Repository::Base
+ $config = {
+ 'repository' => {
+ 'db' => {
+ 'arg1' => 'value1',
+ 'arg2' => 'value2',
+ },
+ 'rep2' => {
+ 'arg1' => 'value1',
+ 'arg2' => 'value2',
+ },
+ },
+ };
+ $rep = Repository::Base->new($config);
+ $rep = Repository::Base->new("rep2",$config);
+
+ ###################################################################
+ # The following methods are needed for SQL support
+ ###################################################################
+
+ $ok = $rep->connect(); # initialize repository (will happen
automatically in constructor)
+ $ok = $rep->disconnect(); # cleanup repository (will happen automatically
in destructor)
+ $rep->is_connected(); # returns 1 if connected (ready for use), 0 if
not
+ $errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
+ $numrows = $rep->numrows(); # returns the number of rows affected by prev op
+ print $rep->error(), "\n" if (!$rep->connect());
+ print $rep->error(), "\n" if ($rep->connect() != $rep->OK);
+
+ # DATA TYPE HELPER METHODS
+ $repdate = $rep->format_repdate($date_string); # free-form date string as
entered by a person
+
+ # META-DATA: (about the tables)
+ $rep->load_rep_metadata();
+ $rep->load_table_metadata($tablename);
+ $typenames = $rep->get_type_names(); # print
"@$typenames\n";
+ $typelabels = $rep->get_type_labels(); # print
"%$typelabels\n";
+ $typedef = $rep->get_type_def($typename); # print
"%$type\n";
+ $tablenames = $rep->get_table_names(); # print
"@$tablenames\n";
+ $tablelabels = $rep->get_table_labels(); # print
"%$tablelabels\n";
+ $tabledef = $rep->get_table_def($tablename); # print
"%$table\n";
+ $columnnames = $rep->get_column_names($tablename); # print
"@$columnnames\n";
+ $columnlabels = $rep->get_column_labels($tablename); # print
"%$columnlabels\n";
+ $columndef = $rep->get_column_def($tablename,$columnname); # print
"%$column\n";
+
+ # MEDIUM-LEVEL
+ $row = $rep->select_row ($table, \@cols, \@params,
\%paramvalues);
+ $rows = $rep->select_rows($table, \@cols, \@params,
\%paramvalues, \@ordercols, $startrow, $endrow);
+ $ok = $rep->insert_row ($table, \@cols, \@colvalues);
+ $ok = $rep->insert_rows($table, \@cols, \@rows);
+ $ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
+ $ok = $rep->update_rows($table, \@cols, \@colvalues, \@params,
\%paramvalues);
+ $ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx,
$update_first);
+ $ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx,
$update_first);
+ $ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
+ $ok = $rep->delete_rows($table, \@params,
\%paramvalues);
+
+ # HIGH-LEVEL (CACHED)
+
+ @keys = $rep->get_keys($table, \%paramvalues);
+ @keys = $rep->get_related_keys($table, $key, $related_table, $relation);
+
+ @values = $rep->get_values($table, $key, \@cols);
+ $value = $rep->get_value ($table, $key, "first_name");
+
+ $key = $rep->set_values($table, $key, \@cols, \@values);
+ $key = $rep->set_value ($table, $key, "first_name", $value);
+
+ $rows = $rep->get_rows($table, undef, \%paramvalues);
+ $rows = $rep->get_rows($table, \@cols, \%paramvalues);
+ $rows = $rep->get_rows($table, \@cols, \%paramvalues, \@keys);
+ $row = $rep->get_row ($table, $key);
+ @idx = $rep->get_column_idx($table, \@cols);
+ ($key, $first_name, $last_name) = @{$row}[@idx];
+
+ $rep->add_columns_fetched ($table, \@cols);
+ $rep->add_columns_fetched ($table, \@cols, \@colidx);
+ $rep->set_row_hint ($table, \%paramvalues);
+ $rep->clear_columns_fetched ($table);
+ $rep->clear_row_hint ($table);
+ @columns = $rep->get_required_columns($table);
+
+ $rep->load_cache();
+ $rep->clear_cache();
+ $rep->commit();
+ $rep->rollback();
+
+=cut
=head1 DESCRIPTION
@@ -126,6 +216,763 @@
sub tbd {
my ($self) = @_;
+}
+
+#############################################################################
+# CONSTANTS
+#############################################################################
+
+sub OK { 1; }
+
+#############################################################################
+# ATTRIBUTES
+#############################################################################
+
+# BASIC
+# $self->{name} # name of this repository (often "db")
+# $self->{config} # hash of config file data
+
+# CURRENT STATE
+# $self->{error} # most recent error generated from this module
+# $self->{numrows}
+
+# METADATA - Database Types
+# $self->{types}
+# $self->{type}{$type}
+# $self->{type}{$typenum}
+# $self->{type}{$type}{type_name}
+# $self->{type}{$type}{data_type}
+# $self->{type}{$type}{column_size}
+# $self->{type}{$type}{literal_prefix}
+# $self->{type}{$type}{literal_suffix}
+# $self->{type}{$type}{unsigned_attribute}
+# $self->{type}{$type}{auto_unique_value}
+# $self->{type}{$type}{quoted}
+
+# METADATA - Tables and Columns
+# $self->{tables}
+# $self->{table}{$table}{readonly}
+# $self->{table}{$table}{columns}
+# $self->{table}{$table}{column}{$column}
+# $self->{table}{$table}{column}{$column}{name}
+# $self->{table}{$table}{column}{$column}{type_name}
+# $self->{table}{$table}{column}{$column}{type}
+# $self->{table}{$table}{column}{$column}{notnull}
+# $self->{table}{$table}{column}{$column}{quoted}
+
+#############################################################################
+# CONSTRUCTOR
+#############################################################################
+
+# $rep = Repository::Base->new();
+
+sub new {
+ my $this = shift;
+ my ($class, $self);
+ $self = {};
+
+ # contructing a new object from scratch from the class
+ # i.e. $rep = Repository::Base->new(...);
+ if (ref($this) eq "") {
+ $class = $this; # must be a scalar, presumably a class name
+ bless $self, $class;
+ $self->init_base(@_);
+ }
+ # contructing a new object from another object
+ # $rep = $rep1->new();
+ else {
+ $class = ref($this);
+ bless $self, $class;
+ $self->init_base($this->{name},$this->{config});
+ }
+
+ $self->init();
+
+ if (!$self->connect()) {
+ my ($repname, $repconfig);
+ $repconfig = $self->{repconfig};
+
+ print STDERR "Error on connect():";
+ foreach (keys %$repconfig) {
+ print STDERR " $_=[", $repconfig->{$_}, "]";
+ }
+ print STDERR "\n";
+ return(undef);
+ }
+
+ $self->load_rep_metadata();
+
+ return $self;
+}
+
+#####################################################################
+# init_base()
+# initialize the {config} structure and the {name} attribute
+#####################################################################
+sub init_base {
+ my $self = shift;
+ my ($dbidriver, $dbname, $dbuser, $dbpass, $dbioptions, $dbschema);
+ my ($repname, $config, $repconfig);
+
+ # $rep = Repository::Base->new(); # looks for %ENV, then config
file
+ # $rep = Repository::Base->new($config); # a MySQL database named
"mydb" (the default)
+ # $rep = Repository::Base->new("sysdb"); # looks for %ENV, then config
file using "sysdb"
+ # $rep = Repository::Base->new("sysdb",$config); # an Oracle database named
"SYSDB"
+
+ if ($#_ == -1) {
+ $repname = "db";
+ $config = Repository->read_config();
+ }
+ elsif ($#_ == 0 && ref($_[0]) eq "") {
+ $repname = shift;
+ $config = Repository->read_config();
+ }
+ elsif ($#_ == 0 && (ref($_[0]) eq "HASH" || ref($_[0]) =~ /^Widget::/)) {
+ $repname = "db";
+ $config = shift;
+ }
+ elsif ($#_ == 1 && (ref($_[1]) eq "HASH" || ref($_[1]) =~ /^Widget::/)) {
+ $repname = shift;
+ $config = shift;
+ }
+ else {
+ $repname = "db";
+ $config = $self->make_config(@_);
+ }
+
+ $self->{name} = $repname;
+ $self->{config} = $config;
+
+ $self->{numrows} = 0;
+ $self->{error} = "";
+
+ $repconfig = $config->{repository}{$repname};
+ if (!$repconfig || ref($repconfig) ne "HASH") {
+ print STDERR "Error: config does not have an entry for the $repname
repository (\$conf->{repository}{$repname})\n";
+ return(undef);
+ }
+ $self->{repconfig} = $repconfig;
+}
+
+sub init { } # OVERRIDE IN SUBCLASS
+
+sub DESTROY {
+ my $self = shift;
+ $self->disconnect();
+}
+
+#############################################################################
+# CONFIG METHODS
+#############################################################################
+
+sub make_config { # OVERRIDE IN SUBCLASS
+ my $conf = {
+ 'repository' => {
+ 'db' => {
+ },
+ },
+ };
+ $conf;
+}
+
+sub read_config {
+ my ($self, $file) = @_;
+ return Repository->read_config($file);
+}
+
+#############################################################################
+# METHODS
+#############################################################################
+
+sub connect { 1; } # OVERRIDE IN SUBCLASS
+sub disconnect { 1; } # OVERRIDE IN SUBCLASS
+sub is_connected { 1; } # OVERRIDE IN SUBCLASS
+
+sub error { # OVERRIDE IN SUBCLASS
+ my $err = $_[0]->{error};
+ $err ? $err : "";
+}
+
+sub numrows { # OVERRIDE IN SUBCLASS
+ my $num = $_[0]->{numrows};
+ $num ? $num : 0;
+}
+
+# $repdate = $rep->format_repdate($date_string); # free-form date string as
entered by a person
+sub format_repdate {
+ my ($self, $datetext) = @_;
+ my ($monthtext, $mon, $day, $year, %mon, $date);
+ if ($datetext =~ /\b([a-zA-Z]+)[- ]+([0-9]{1,2})[- ,]+([0-9]{2,4})\b/) { #
i.e. December 31, 1999, 9-march-01
+ $monthtext = $1;
+ $day = $2;
+ $year = $3;
+ }
+ elsif ($datetext =~ /\b([0-9]{1,2})[- ]+([a-zA-Z]+)[- ]+([0-9]{2,4})\b/) { #
i.e. 31-Dec-1999, 9 march 01
+ $day = $1;
+ $monthtext = $2;
+ $year = $3;
+ }
+ elsif ($datetext =~ /\b([0-9]{4})([0-9]{2})([0-9]{2})\b/) { # i.e.
19991231, 20010309
+ $year = $1;
+ $mon = $2;
+ $day = $3;
+ }
+ elsif ($datetext =~ m!\b([0-9]{4})[- /]+([0-9]{1,2})[- /]+([0-9]{1,2})\b!) { #
i.e. 1999-12-31, 2001/3/09
+ $year = $1;
+ $mon = $2;
+ $day = $3;
+ }
+ elsif ($datetext =~ m!\b([0-9]{1,2})[- /]+([0-9]{1,2})[- /]+([0-9]{2,4})\b!) {
# i.e. 12/31/1999, 3-9-01
+ $mon = $1;
+ $day = $2;
+ $year = $3;
+ }
+ else {
+ return("");
+ }
+ if ($monthtext) {
+ if ($monthtext =~ /^jan/i) { $mon = 1; }
+ elsif ($monthtext =~ /^feb/i) { $mon = 2; }
+ elsif ($monthtext =~ /^mar/i) { $mon = 3; }
+ elsif ($monthtext =~ /^apr/i) { $mon = 4; }
+ elsif ($monthtext =~ /^may/i) { $mon = 5; }
+ elsif ($monthtext =~ /^jun/i) { $mon = 6; }
+ elsif ($monthtext =~ /^jul/i) { $mon = 7; }
+ elsif ($monthtext =~ /^aug/i) { $mon = 8; }
+ elsif ($monthtext =~ /^sep/i) { $mon = 9; }
+ elsif ($monthtext =~ /^oct/i) { $mon = 10; }
+ elsif ($monthtext =~ /^nov/i) { $mon = 11; }
+ elsif ($monthtext =~ /^dec/i) { $mon = 12; }
+ else { return(""); }
+ }
+ if ($year < 0) { return(""); }
+ elsif ($year < 50) { $year += 2000; }
+ elsif ($year < 100) { $year += 1900; }
+ elsif ($year < 1000) { return(""); }
+ return("") if ($mon > 12);
+ return("") if ($day > 31);
+ sprintf("%04d-%02d-%02d",$year,$mon,$day);
+}
+
+# $row = $rep->select_row ($table, \@cols, \@params, \%paramvalues);
+sub select_row { undef; } # OVERRIDE IN SUBCLASS
+
+# $rows = $rep->select_rows($table, \@cols, \@params, \%paramvalues, \@ordercols,
$startrow, $endrow);
+sub select_rows { undef; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->insert_row ($table, \@cols, \@colvalues);
+sub insert_row { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->insert_rows ($table, \@cols, \@rows);
+sub insert_rows { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->update_row ($table, \@cols, \@colvalues, \@keycolidx);
+sub update_row { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->update_rows($table, \@cols, \@colvalues, \@params, \%paramvalues);
+sub update_rows { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->store_row ($table, \@cols, \@colvalues, \@keycolidx, $update_first);
+sub store_row { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->store_rows ($table, \@cols, \@rows, \@keycolidx, $update_first);
+sub store_rows { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->delete_row ($table, \@cols, \@colvalues, \@keycolidx);
+sub delete_row { 0; } # OVERRIDE IN SUBCLASS
+
+# $ok = $rep->delete_rows($table, \@params, \%paramvalues);
+sub delete_rows { 0; } # OVERRIDE IN SUBCLASS
+
+#################################################################
+# LOADING METADATA
+#################################################################
+
+# load metadata about TYPES supported by the repository
+# and the list of TABLES in it.
+sub load_rep_metadata {
+ my ($self) = @_;
+
+ my ($repconfig, $table, $tables, $table_defs, $table_def, $native_table, $idx);
+ $repconfig = $self->{repconfig};
+
+ # start with the list of tables that was configured (or the empty list)
+ $tables = $repconfig->{tables};
+ $tables = [] if (!defined $tables);
+ $self->{tables} = $tables;
+
+ # start with the hash of tables defined (or the empty hash)
+ $table_defs = $repconfig->{table};
+ $table_defs = {} if (!defined $table_defs);
+ $self->{table} = $table_defs;
+
+ # for each table named in the configuration, give it a number up front
+ for ($idx = 0; $idx <= $#$tables; $idx++) {
+ $table = $tables->[$idx];
+ $table_defs->{$table}{idx} = $idx;
+ }
+
+ # for each table in the hash (random order), add them to the end
+ foreach $table (keys %$table_defs) {
+ $table_def = $table_defs->{$table};
+ $table_def->{name} = $table;
+ $table_def->{label} = $table if (! $table_def->{label});
+
+ # table has not been added to the list and it's not explicitly "hidden", so
add it
+ if (!defined $table_def->{idx} && ! $table_def->{hide}) {
+ push(@$tables, $table);
+ $table_def->{idx} = $#$tables;
+
+ # we're not hiding physical tables and a native table was defined, so
make an entry
+ if (! $self->{hide_physical}) {
+ $native_table = $table_def->{native_table};
+ if (defined $native_table) {
+ $table_defs->{$native_table} = $table_defs->{$table};
+ }
+ }
+ }
+
+ $self->{table_labels}{$table} = $table_def->{label};
+ }
+
+ my ($type, $types, $type_defs);
+
+ # start with the hash of types defined (or the empty hash)
+ $type_defs = $repconfig->{type};
+ $type_defs = {} if (!defined $type_defs);
+ $self->{type} = $type_defs;
+
+ # define the standard list of Repository types
+ $types = [ "string", "text", "integer", "float", "date", "time", "datetime",
"binary" ];
+ $self->{types} = $types;
+
+ # define the standard list of Repository labels
+ $self->{type_labels} = {
+ "string" => "Characters",
+ "text" => "Paragraph",
+ "integer" => "Integer",
+ "float" => "Number",
+ "date" => "Date",
+ "time" => "Time",
+ "datetime" => "Date and Time",
+ "binary" => "Binary Data",
+ };
+
+ # figure the index in the array of each type
+ for ($idx = 0; $idx <= $#$types; $idx++) {
+ $type = $types->[$idx];
+ $self->{type}{$type}{idx} = $idx;
+ }
+
+ # load up all additional information from the native metadata
+ $self->load_rep_metadata_auto();
+}
+
+# load detailed metadata about a particular table, including
+# the details about each column
+sub load_table_metadata {
+ my ($self, $table) = @_;
+
+ # if it's already been loaded, don't do it again
+ return if (defined $self->{table}{$table}{loaded});
+ $self->{table}{$table}{loaded} = 1; # mark it as having been loaded
+
+ my ($table_def, $columns, $column, $column_def, $idx, $native_column);
+
+ $table_def = $self->{table}{$table};
+ return if (!defined $table_def);
+
+ $columns = $table_def->{columns};
+ if (! defined $columns) {
+ $columns = [];
+ $table_def->{columns} = $columns;
+ }
+
+ # for each column named in the configuration, give it a number up front
+ for ($idx = 0; $idx <= $#$columns; $idx++) {
+ $column = $columns->[$idx];
+ $table_def->{column}{$column}{idx} = $idx;
+ }
+
+ # load up all additional information from the native metadata
+ $self->load_table_metadata_auto($table);
+
+ # for each column in the hash (random order), add them to the end
+ foreach $column (keys %{$table_def->{column}}) {
+ $column_def = $table_def->{column}{$column};
+ $column_def->{name} = $column;
+ $column_def->{label} = $column if (! $column_def->{label});
+
+ # column has not been added to the list and it's not explicitly "hidden",
so add it
+ if (!defined $column_def->{idx} && ! $column_def->{hide}) {
+ push(@$columns, $column);
+ $idx = $#$columns;
+ $column_def->{idx} = $idx;
+ $column_def->{alias} = "c$idx" if (!defined $column_def->{alias});
+
+ # we're not hiding physical columns and a native table was defined, so
make an entry
+ if (! $self->{hide_physical}) {
+ $native_column = $column_def->{native_column};
+ if (defined $native_column &&
+ $native_column ne $column &&
+ !defined $table_def->{column}{$native_column}) {
+ $table_def->{column}{$native_column} =
$table_def->{column}{$column};
+ }
+ }
+ }
+
+ $table_def->{column_labels}{$column} = $column_def->{label};
+ }
+
+ # if a primary key is not defined, assume it is the first column
+ if (!defined $table_def->{prikey}) {
+ $table_def->{prikey} = [ $table_def->{columns}[0] ];
+ }
+
+ # predefine that certain required columns will be in the result set
+ $self->set_required_columns_fetched($table);
+ $self->clear_cache();
+}
+
+sub load_rep_metadata_auto { # OVERRIDE IN SUBCLASS (IF DESIRED)
+ my ($self) = @_;
+}
+
+sub load_table_metadata_auto { # OVERRIDE IN SUBCLASS (IF DESIRED)
+ my ($self, $table) = @_;
+}
+
+#################################################################
+# ACCESSING METADATA
+#################################################################
+
+# $typenames = $rep->get_type_names(); # print "@$typenames\n";
+sub get_type_names {
+ my ($self) = @_;
+ $self->{types};
+}
+
+# $typelabels = $rep->get_type_labels(); # print "%$typelabels\n";
+sub get_type_labels {
+ my ($self) = @_;
+ $self->{type_labels};
+}
+
+# $type = $rep->get_type($typename); # print "%$type\n";
+sub get_type_def {
+ my ($self, $type) = @_;
+ $self->{type}{$type};
+}
+
+# $tablenames = $rep->get_table_names(); # print "@$tablenames\n";
+sub get_table_names {
+ my ($self) = @_;
+ $self->{tables};
+}
+
+# $tablelabels = $rep->get_table_labels(); # print "%$tablelabels\n";
+sub get_table_labels {
+ my ($self) = @_;
+ $self->{table_labels};
+}
+
+# $table = $rep->get_table($tablename); # print "%$table\n";
+sub get_table_def {
+ my ($self, $table) = @_;
+ $self->load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ $self->{table}{$table};
+}
+
+# $columnnames = $rep->get_column_names($tablename); # print "@columnnames\n";
+sub get_column_names {
+ my ($self, $table) = @_;
+ $self->load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ $self->{table}{$table}{columns};
+}
+
+# $columnlabels = $rep->get_column_labels($tablename); # print "%$columnlabels\n";
+sub get_column_labels {
+ my ($self, $table) = @_;
+ $self->load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ $self->{table}{$table}{column_labels};
+}
+
+# $column = $rep->get_column($tablename,$columnname); # print "%$column\n";
+sub get_column_def {
+ my ($self, $table, $column) = @_;
+ $self->load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ $self->{table}{$table}{column}{$column};
+}
+
+#################################################################
+# HIGH-LEVEL (CACHED) REPOSITORY OPERATIONS
+#################################################################
+
+# $rep->load_cache();
+sub load_cache {
+ my $self = shift;
+}
+
+# $rep->clear_cache();
+sub clear_cache {
+ my ($self, $table) = @_;
+ my (@tables, $rows);
+ @tables = (defined $table) ? ($table) : @{$self->{tables}};
+
+ foreach $table (@tables) {
+ $rows = $self->{table}{$table}{cache}{rows};
+ if (!defined $rows || ref($rows) ne "ARRAY" || $#$rows > -1) {
+ $self->{table}{$table}{cache}{rows} = [];
+ $self->{table}{$table}{cache}{rowidx} = {};
+ }
+ }
+}
+
+# $rep->add_columns_fetched ($table, \@cols);
+# $rep->add_columns_fetched ($table, \@cols, \@colidx);
+sub add_columns_fetched {
+ my ($self, $table, $colsref, $colidxref) = @_;
+ my ($colidx, $column, $colnum, $columns_added, $cachecolumns);
+
+ $colidx = $self->{table}{$table}{cache}{columnidx};
+ $cachecolumns = $self->{table}{$table}{cache}{columns};
+
+ $columns_added = 0;
+ for ($colnum = 0; $colnum <= $#$colsref; $colnum++) {
+ $column = $colsref->[$colnum];
+ if (!defined $colidx->{$column}) {
+ push(@$cachecolumns, $column);
+ $colidx->{$column} = $#$cachecolumns;
+ $columns_added = 1;
+ }
+ $colidxref->[$colnum] = $colidx->{$column} if (ref($colidxref) eq "ARRAY");
+ }
+ if ($columns_added) { # clear the cache
+ $self->clear_cache($table);
+ }
+}
+
+# $rep->set_required_columns_fetched($table);
+sub set_required_columns_fetched {
+ my ($self, $table) = @_;
+ my ($prikeycolumns, @prikeyidx);
+ $prikeycolumns = $self->{table}{$table}{prikey};
+ $self->add_columns_fetched($table, $prikeycolumns, \@prikeyidx);
+ $self->{table}{$table}{prikeyidx} = \@prikeyidx;
+}
+
+# $rep->clear_columns_fetched ($table);
+sub clear_columns_fetched {
+ my ($self, $table) = @_;
+ $self->{table}{$table}{cache}{columnidx} = {};
+ $self->{table}{$table}{cache}{columns} = [];
+ $self->set_required_columns_fetched($table);
+}
+
+# $rep->set_row_hint ($table, \%paramvalues);
+sub set_row_hint {
+ my ($self, $table, $paramvalueshashref) = @_;
+ $self->{table}{$table}{cache}{paramvalues} = { %$paramvalueshashref };
+}
+
+# $rep->clear_row_hint ($table);
+sub clear_row_hint {
+ my ($self, $table) = @_;
+ $self->{table}{$table}{cache}{paramvalues} = {};
+}
+
+# $rows = $rep->get_rows($table, undef, \%paramvalues);
+# $rows = $rep->get_rows($table, \@cols, \%paramvalues);
+# $rows = $rep->get_rows($table, \@cols, \%paramvalues, \@keys);
+sub get_rows {
+ my ($self, $table, $colsref, $paramvalueshashref, $keysref) = @_;
+ my ($rows, $row, $keycolidxref, $cacherows, $cacherowidx, $cachecolumns, $key);
+
+ $self->add_columns_fetched($table, $colsref) if (defined $colsref);
+
+ $cachecolumns = $self->{table}{$table}{cache}{columns};
+ $rows = $self->select_rows($table, $cachecolumns, undef, $paramvalueshashref);
+
+ $keycolidxref = $self->{table}{$table}{prikey};
+ $cacherows = $self->{table}{$table}{cache}{rows};
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx};
+
+ foreach $row (@$rows) {
+ $key = join(",", @{$row}[@$keycolidxref]);
+ if (!defined $cacherowidx->{$key}) {
+ push(@$cacherows, $row);
+ $cacherowidx->{$key} = $#$cacherows;
+ }
+ push (@$keysref, $key) if (ref($keysref) eq "ARRAY");
+ }
+
+ $rows;
+}
+
+# $row = $rep->get_row ($table, $key);
+sub get_row {
+ my ($self, $table, $key) = @_;
+ my ($row, $keycolidxref, $cacherows, $cacherowidx, $cacheparamvalues, $rowidx,
$cachecolumns);
+
+ $cacherows = $self->{table}{$table}{cache}{rows};
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx};
+
+ # if cache is empty, preload it with rows as hinted
+ if ($#$cacherows == -1) {
+ $cacheparamvalues = $self->{table}{$table}{cache}{paramvalues};
+ $self->get_rows($table, undef, $cacheparamvalues);
+ }
+
+ $rowidx = $cacherowidx->{$key}; # look in cache
+ if (defined $rowidx) { # if found...
+ $row = $cacherows->[$rowidx]; # we have our row!
+ }
+ else {
+ my (%paramvalues, $i, @key, $keycolidx);
+
+ $keycolidxref = $self->{table}{$table}{prikey};
+ $cachecolumns = $self->{table}{$table}{cache}{columns};
+
+ @key = split(/,/,$key);
+ for ($i = 0; $i <= $#key; $i++) {
+ $keycolidx = $keycolidxref->[$i];
+ $paramvalues{$cachecolumns->[$keycolidx]} = $key[$i];
+ }
+
+ $row = $self->select_row($table, $cachecolumns, undef, \%paramvalues);
+
+ $key = join(",", @{$row}[@$keycolidxref]);
+ push(@$cacherows, $row);
+ $cacherowidx->{$key} = $#$cacherows;
+ }
+
+ $row;
+}
+
+# @keys = $rep->get_keys($table, \%paramvalues);
+sub get_keys {
+ my ($self, $table, $paramvalueshashref) = @_;
+ my (@keys);
+ $self->get_rows($table, undef, $paramvalueshashref, \@keys);
+ if (wantarray) {
+ return (@keys)
+ }
+ else {
+ return ($#keys > -1) ? $keys[0] : undef;
+ }
+}
+
+# @keys = $rep->get_related_keys($table, $key, $related_table, $relation);
+# TODO:
+sub get_related_keys {
+ my ($self, $table, $key, $related_table, $relation) = @_;
+ my (@keys);
+}
+
+# @values = $rep->get_values($table, $key, \@cols);
+sub get_values {
+ my ($self, $table, $key, $colsref) = @_;
+ my (@colidx, $row);
+ $self->add_columns_fetched($table, $colsref, \@colidx);
+ $row = $self->get_row($table, $key);
+ @{$row}[@colidx];
+}
+
+# $value = $rep->get_value ($table, $key, $col);
+sub get_value {
+ my ($self, $table, $key, $column) = @_;
+ my ($value, $row, $colidx);
+ $colidx = $self->{table}{$table}{cache}{columnidx}{$column};
+ if (!defined $colidx) {
+ $self->add_columns_fetched($table, [ $column ]);
+ $colidx = $self->{table}{$table}{cache}{columnidx}{$column};
+ }
+ $row = $self->get_row($table, $key);
+ $row->[$colidx];
+}
+
+# $key = $rep->set_values($table, $key, \@cols, \@values);
+sub set_values {
+ my ($self, $table, $key, $colsref, $valuesref) = @_;
+ my (@colidx, $row, $i, $cacherowidx);
+ $self->add_columns_fetched($table, $colsref, \@colidx);
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx}{$key};
+ if (defined $cacherowidx) {
+ $row = $self->{table}{$table}{cache}{rows}[$cacherowidx];
+ }
+ else {
+ $row = $self->get_row($table, $key);
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx}{$key};
+ }
+ for ($i = 0; $i <= $#$colsref; $i++) {
+ $row->[$colidx[$i]] = $valuesref->[$i];
+ }
+ $self->{table}{$table}{cache}{rowchange}[$cacherowidx] = "U";
+}
+
+# $key = $rep->set_value ($table, $key, "first_name", $value);
+sub set_value {
+ my ($self, $table, $key, $column, $value) = @_;
+ my ($row, $colidx, $cacherowidx);
+ $colidx = $self->{table}{$table}{cache}{columnidx}{$column};
+ if (!defined $colidx) {
+ $self->add_columns_fetched($table, [ $column ]);
+ $colidx = $self->{table}{$table}{cache}{columnidx}{$column};
+ }
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx}{$key};
+ if (defined $cacherowidx) {
+ $row = $self->{table}{$table}{cache}{rows}[$cacherowidx];
+ }
+ else {
+ $row = $self->get_row($table, $key);
+ $cacherowidx = $self->{table}{$table}{cache}{rowidx}{$key};
+ }
+ $row->[$colidx] = $value;
+ $self->{table}{$table}{cache}{rowchange}[$cacherowidx] = "U";
+ $key;
+}
+
+# @idx = $rep->get_column_idx($table, \@cols);
+sub get_column_idx {
+ my ($self, $table, $colsref) = @_;
+ my (@idx);
+}
+
+# @columns = $rep->get_required_columns($table);
+sub get_required_columns {
+ my ($self, $table) = @_;
+ my (@columns);
+}
+
+# $rep->commit();
+sub commit {
+ my $self = shift;
+ my ($table, $rows, $rowidx, $rowchange, $change, $colref, $prikeyidx);
+ foreach $table (@{$self->{tables}}) {
+ $prikeyidx = $self->{table}{$table}{prikeyidx};
+ $rows = $self->{table}{$table}{cache}{rows};
+ $rowchange = $self->{table}{$table}{cache}{rowchange};
+ $colref = $self->{table}{$table}{cache}{columns};
+ if ($#$rowchange > -1) {
+ for ($rowidx = 0; $rowidx <= $#$rows; $rowidx++) {
+ $change = $rowchange->[$rowidx];
+ next if (!defined $change);
+ if ($change eq "U") {
+ $self->update_row($table, $colref, $rows->[$rowidx],
$prikeyidx);
+ $rowchange->[$rowidx] = "";
+ }
+ elsif ($change eq "I") {
+ $self->insert_row($table, $colref, $rows->[$rowidx]);
+ $rowchange->[$rowidx] = "";
+ }
+ }
+ }
+ }
+}
+
+# $rep->rollback();
+sub rollback {
+ my $self = shift;
}
=head1 ACKNOWLEDGEMENTS
1.3 +2 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Security.pm
Index: Security.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Security.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Security.pm 2001/11/30 16:00:52 1.2
+++ Security.pm 2001/12/05 22:45:03 1.3
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Security.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Security.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Security;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
1.3 +45 -10 p5ee/P5EEx/Blue/P5EEx/Blue/Serializer.pm
Index: Serializer.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Serializer.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Serializer.pm 2001/11/30 16:00:52 1.2
+++ Serializer.pm 2001/12/05 22:45:03 1.3
@@ -1,13 +1,20 @@
#############################################################################
-## $Id: Serializer.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Serializer.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Serializer;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
+use Data::Dumper;
+# use Compress::Zlib;
+# use MIME::Base64;
+# use Digest::HMAC_MD5;
+# use Crypt::CBC;
+
use strict;
=head1 NAME
@@ -59,9 +66,11 @@
=item * Class: P5EEx::Blue::Serializer::Storable
+=item * Class: P5EEx::Blue::Serializer::XMLSimple
+
=item * Class: P5EEx::Blue::Serializer::XML
-=item * Class: P5EEx::Blue::Serializer::IniFile
+=item * Class: P5EEx::Blue::Serializer::Ini
=item * Class: P5EEx::Blue::Serializer::Properties
@@ -159,6 +168,7 @@
=head2 deserialize()
* Signature: $serialized_data = $serializer->deserialize($data);
+ * Signature: $serialized_data = P5EEx::Blue::Serializer->deserialize($data);
* Param: $data ref
* Return: $serialized_data binary
* Throws: P5EEx::Blue::Exception::Serializer
@@ -176,8 +186,33 @@
sub deserialize {
my ($self, $serialized_data) = @_;
- my ($data);
+ my ($data, $serializer_class);
$data = {};
+ $serializer_class = "";
+
+ if ($self eq "P5EEx::Blue::Serializer") { # static method call
+
+ if ($serialized_data =~ s/#Serializer +([^ ]+) +\((.*)\)\n//) {
+ $serializer_class = $1;
+ }
+ elsif ($serialized_data =~ /^<!DOCTYPE/i) {
+ $serializer_class = "P5EEx::Blue::Serializer::XML";
+ }
+ elsif ($serialized_data =~ /^</) {
+ $serializer_class = "P5EEx::Blue::Serializer::XMLSimple";
+ }
+ }
+
+ if ($serializer_class) {
+ eval "use $serializer_class;";
+ if ($@) {
+ P5EEx::Blue::Exception::Serializer->throw(
+ error => "create(): error loading $serializer_class serializer
class\n"
+ );
+ }
+ $data = $serializer_class->deserialize($serialized_data);
+ }
+ else {
if ($serialized_data =~ /^\$[a-zA-Z][a-zA-Z0-9_]* *= *(\{.*\};[ \n]*)$/s) {
$serialized_data = "\$data = $1"; # untainted now
eval($serialized_data);
@@ -186,6 +221,8 @@
else {
die "Deserialization Error: Data didn't have \"\$var = {...};\" format.";
}
+ }
+
$data;
}
@@ -210,8 +247,6 @@
print $serializer->dump($data), "\n";
=cut
-
-use Data::Dumper;
sub dump {
my ($self, $data) = @_;
1.3 +3 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Service.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Service.pm 2001/11/30 16:00:52 1.2
+++ Service.pm 2001/12/05 22:45:03 1.3
@@ -1,11 +1,13 @@
#############################################################################
-## $Id: Service.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Service.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Service;
use strict;
+
+use P5EEx::Blue::P5EE;
=head1 NAME
1.2 +2 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Session.pm
Index: Session.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Session.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Session.pm 2001/11/30 16:00:52 1.1
+++ Session.pm 2001/12/05 22:45:03 1.2
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Session.pm,v 1.1 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Session.pm,v 1.2 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Session;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
1.3 +2 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Widget.pm
Index: Widget.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Widget.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Widget.pm 2001/11/30 16:00:52 1.2
+++ Widget.pm 2001/12/05 22:45:03 1.3
@@ -1,10 +1,11 @@
#############################################################################
-## $Id: Widget.pm,v 1.2 2001/11/30 16:00:52 spadkins Exp $
+## $Id: Widget.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Widget;
+use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/LogChannel.pm
Index: LogChannel.pm
===================================================================
#############################################################################
## $Id: LogChannel.pm,v 1.1 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::LogChannel;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
use strict;
=head1 NAME
P5EEx::Blue::LogChannel - Interface for logging
=head1 SYNOPSIS
use P5EEx::Blue::P5EE;
$context = P5EEx::Blue::P5EE->context();
$logchannel = $context->service("LogChannel"); # or ...
$logchannel = $context->logchannel();
=head1 DESCRIPTION
A LogChannel service is a means by which messages are logged through a
logging system. This perhaps ends up in a file, or perhaps it
ends up on someone's operator console screen somewhere.
=cut
#############################################################################
# CLASS GROUP
#############################################################################
=head1 Class Group: LogChannel
The following classes might be a part of the LogChannel Class Group.
=over
=item * Class: P5EEx::Blue::LogChannel
=item * Class: P5EEx::Blue::LogChannel::LogDispatch
=item * Class: P5EEx::Blue::LogChannel::NetDaemon
=item * Class: P5EEx::Blue::LogChannel::Tivoli
=back
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::LogChannel
A LogChannel service ...
* Throws: P5EEx::Blue::Exception::LogChannel
* Since: 0.01
=head2 Class Design
...
=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
#############################################################################
# log()
#############################################################################
=head2 log()
* Signature: $logchannel->log(@text);
* Param: @text array[string]
* Return: void
* Throws: P5EEx::Blue::Exception::LogChannel
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$logchannel = $context->service("LogChannel"); # or ...
$logchannel->log("Error occurred");
=cut
sub log {
my ($self, @text) = @_;
print STDERR @text, "\n";
}
=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/Template.pm
Index: Template.pm
===================================================================
#############################################################################
## $Id: Template.pm,v 1.1 2001/12/05 22:45:03 spadkins Exp $
#############################################################################
package P5EEx::Blue::Template;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Service;
@ISA = ( "P5EEx::Blue::Service" );
use strict;
=head1 NAME
P5EEx::Blue::Template - Interface for rendering HTML templates
=head1 SYNOPSIS
use P5EEx::Blue::P5EE;
$context = P5EEx::Blue::P5EE->context();
$template = $context->service("Template"); # or ...
$template = $context->template();
... TBD ...
=head1 DESCRIPTION
A Template Service is a means by which a template (such as an
HTML template) may be rendered (with variables interpolated).
=cut
#############################################################################
# CLASS GROUP
#############################################################################
=head1 Class Group: Template
The following classes might be a part of the Template Class Group.
=over
=item * Class: P5EEx::Blue::Template
=item * Class: P5EEx::Blue::Template::TemplateToolkit
=item * Class: P5EEx::Blue::Template::Embperl
=item * Class: P5EEx::Blue::Template::Mason
=item * Class: P5EEx::Blue::Template::AxKit
=item * Class: P5EEx::Blue::Template::ASP
=item * Class: P5EEx::Blue::Template::CGIFastTemplate
=item * Class: P5EEx::Blue::Template::TextTemplate
=item * Class: P5EEx::Blue::Template::HTMLTemplate
=back
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Template
A Template Service is a means by which a template (such as an
HTML template) may be rendered (with variables interpolated).
* Throws: P5EEx::Blue::Exception::Template
* Since: 0.01
=head2 Class Design
...
=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
#############################################################################
# TBD()
#############################################################################
=head2 TBD()
* Signature: $tbd_return = $repository->tbd($tbd_param);
* Param: $tbd_param integer
* Return: $tbd_return integer
* Throws: P5EEx::Blue::Exception::Repository
* Since: 0.01
Sample Usage:
$tbd_return = $repository->tbd($tbd_param);
=cut
sub tbd {
my ($self) = @_;
}
=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/Config/File.pm
Index: File.pm
===================================================================
#############################################################################
## $Id: File.pm,v 1.1 2001/12/05 22:45:04 spadkins Exp $
#############################################################################
package P5EEx::Blue::Config::File;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Config;
@ISA = ( "P5EEx::Blue::Config" );
use strict;
sub create {
my $self = shift;
my $args = $self->SUPER::create(@_);
local(*FILE);
my ($file, $testfile, $dir, @files, $filetype, $serializer_class, $open);
$file = $args->{configFile};
$file = $ENV{P5EE_CONFIG_FILE} if (!$file);
$serializer_class = $ENV{P5EE_CONFIG_FILE_SERIALIZER};
$dir = $0;
if ($dir =~ m!/[^/]+$!) {
$dir =~ s!/[^/]+$!!;
}
else {
$dir = ".";
}
$dir = "." if (!$dir);
if (!$file) { # no file specified
foreach $filetype qw(pl xml ini properties) {
$testfile = ($dir eq ".") ? "config.$filetype" : "$dir/config.$filetype";
if (-r $testfile) {
$file = $testfile;
last;
}
}
}
if (! -r $file && $dir ne ".") {
$testfile = "$dir/$file";
$file = $testfile if (-r $testfile);
}
if (!$file) {
P5EEx::Blue::Exception::Config->throw(
error => "create(): no config file specified or found\n"
);
}
if (! open(main::FILE,"< $file")) {
P5EEx::Blue::Exception::Config->throw(
error => "create(): [$file] $!\n"
);
}
my (@text, $text, $conf);
@text = <main::FILE>;
close(main::FILE);
$text = join("",@text);
if (!$serializer_class) {
$filetype = "";
if ($file =~ /\.([^\.]+)$/) {
$filetype = $1;
}
if ($filetype eq "pl") {
$serializer_class = "P5EEx::Blue::Serializer";
}
elsif ($filetype eq "stor") {
$serializer_class = "P5EEx::Blue::Serializer::Storable";
}
elsif ($filetype eq "xml") {
$serializer_class = "P5EEx::Blue::Serializer::XMLSimple";
}
elsif ($filetype eq "ini") {
$serializer_class = "P5EEx::Blue::Serializer::Ini";
}
elsif ($filetype eq "properties") {
$serializer_class = "P5EEx::Blue::Serializer::Properties";
}
elsif ($filetype) {
my $serializer = uc(substr($filetype,0,1)) . substr($filetype,1);
$serializer_class = "P5EEx::Blue::Serializer::$serializer";
}
else {
$serializer_class = "P5EEx::Blue::Serializer";
}
}
eval "use $serializer_class;";
if ($@) {
P5EEx::Blue::Exception::Config->throw(
error => "create(): error loading $serializer_class serializer class\n"
);
}
$conf = $serializer_class->deserialize($text);
$conf;
}
1;
1.1 p5ee/P5EEx/Blue/P5EEx/Blue/Serializer/Storable.pm
Index: Storable.pm
===================================================================
#############################################################################
## $Id: Storable.pm,v 1.1 2001/12/05 22:45:04 spadkins Exp $
#############################################################################
package P5EEx::Blue::Serializer::Storable;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Serializer;
@ISA = ( "P5EEx::Blue::Serializer" );
use strict;
=head1 NAME
P5EEx::Blue::Serializer::Storable - 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',
},
};
$stor = $serializer->serialize($data);
$data = $serializer->deserialize($stor);
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 Storable serializer uses
the Storable class to perform
the deserialization and serialization.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Serializer::Storable
* 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: $stor = $serializer->serialize($data);
* Param: $data ref
* Return: $stor binary
* 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',
},
};
$stor = $serializer->serialize($data);
=cut
use Storable qw(freeze thaw);
sub serialize {
my ($self, $data) = @_;
my ($stor);
$stor = freeze($data);
return $stor;
}
#############################################################################
# deserialize()
#############################################################################
=head2 deserialize()
* Signature: $data = $serializer->deserialize($stor);
* Signature: $data = P5EEx::Blue::Serializer->deserialize($stor);
* Param: $data ref
* Return: $stor binary
* 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($stor);
print $serializer->dump($data), "\n";
=cut
sub deserialize {
my ($self, $stor) = @_;
my ($data);
$data = thaw($stor);
return $data;
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
This method 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/XMLSimple.pm
Index: XMLSimple.pm
===================================================================
#############################################################################
## $Id: XMLSimple.pm,v 1.1 2001/12/05 22:45:04 spadkins Exp $
#############################################################################
package P5EEx::Blue::Serializer::XMLSimple;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Serializer;
@ISA = ( "P5EEx::Blue::Serializer" );
use strict;
=head1 NAME
P5EEx::Blue::Serializer::XMLSimple - 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',
},
};
$xml = $serializer->serialize($data);
$data = $serializer->deserialize($xml);
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 XMLSimple serializer uses non-validated XML as the serialized
form of the data. It uses the XML::Simple class to perform
the deserialization and serialization.
=cut
#############################################################################
# CLASS
#############################################################################
=head1 Class: P5EEx::Blue::Serializer::XMLSimple
* 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: $xml = $serializer->serialize($data);
* Param: $data ref
* Return: $xml 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',
},
};
$xml = $serializer->serialize($data);
=cut
use XML::Simple;
sub serialize {
my ($self, $data) = @_;
my ($xml, $xp);
$xp = XML::Simple->new(
'keyattr' => [ 'name', ], # turn off 'id' and 'key'
);
$xml = $xp->XMLout($data);
return $xml;
}
#############################################################################
# deserialize()
#############################################################################
=head2 deserialize()
* Signature: $data = $serializer->deserialize($xml);
* Signature: $data = P5EEx::Blue::Serializer->deserialize($xml);
* Param: $data ref
* Return: $xml 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($xml);
print $serializer->dump($data), "\n";
=cut
sub deserialize {
my ($self, $xml) = @_;
my ($data, $xp);
$xp = XML::Simple->new(
'keyattr' => [ 'name', ], # turn off 'id' and 'key'
);
$data = $xp->XMLin($xml);
return $data;
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
This method 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.2 +6 -8 p5ee/P5EEx/Blue/examples/Config.1
Index: Config.1
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/examples/Config.1,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- Config.1 2001/11/17 04:56:10 1.1
+++ Config.1 2001/12/05 22:45:04 1.2
@@ -1,18 +1,16 @@
#!/usr/local/bin/perl -wT
+use lib ".";
use lib "..";
use P5EEx::Blue::P5EE;
$config = P5EEx::Blue::P5EE->config();
print "FROM PERL: ", $config->dump(), "\n";
-$config = P5EEx::Blue::P5EE->config(
- configClass => "P5EEx::Blue::Config::XML",
-);
-print "FROM XML: ", $config->dump(), "\n";
+use P5EEx::Blue::Config::File;
-$config = P5EEx::Blue::P5EE->config(
- configClass => "P5EEx::Blue::Config::Inifiles",
-);
-print "FROM INI: ", $config->dump(), "\n";
+foreach $file qw(config.pl config.xml config.ini config.properties) {
+ $data = P5EEx::Blue::Config::File->new( configFile => $file );
+ print "FROM $file: ", $data->dump($data), "\n";
+}
1.1 p5ee/P5EEx/Blue/examples/Reference.1
Index: Reference.1
===================================================================
#!/usr/local/bin/perl -wT
use lib ".";
use lib "..";
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Reference;
$P5EEx::Blue::Context::DEBUG = 0;
$ref = P5EEx::Blue::Reference->new();
$ref->set("x.y.z.pi", 3.1416);
print "1. pi=", $ref->get("x.y.z.pi"), "\n";
$branch = $ref->get_branch("x.y.z");
print "2. pi=", $branch->{pi}, "\n";
$branch = $ref->get_branch("zeta.alpha");
print "Nonexistent branch: ", ($branch ? $branch : "[undef]"), "\n";
$branch = $ref->get_branch("zeta.alpha", 1);
print "Existent branch: ", ($branch ? "defined" : "[undef]"), "\n";
#print "dump:\n", $ref->dump(), "\n"; # use Data::Dumper to spit out the Perl
representation
$ref = P5EEx::Blue::Reference->new(
hello => "world",
quit => {
following => [ 1, 3, 4, "nine", ],
me => 1,
},
);
#print "dump:\n", $ref->dump(), "\n"; # use Data::Dumper to spit out the Perl
representation
exit 0;
try {
print "trying...\n";
$ref = P5EEx::Blue::Reference->new([], 1);
print "tried.\n";
}
catch P5EEx::Blue::Exception with {
my ($e) = @_;
printf "desc=[%s] error=[%s] pid=[%s] gid=[%s] euid=[%s] egid=[%s] time=[%s]
package=[%s] file=[%s] line=[%s]\n",
$e->description(),
$e->error(),
$e->pid(),
$e->uid(),
$e->gid(),
$e->euid(),
$e->egid(),
$e->time(),
$e->package(),
$e->file(),
$e->line();
}
finally {
print "done trying.\n";
};
$ref = P5EEx::Blue::Reference->new("x", 1, "y");
# accessors
#$property_value = $ref->get($property_name);
#$ref->set($property_name, $property_value);
# on-demand loading helper methods (private methods)
#$ref->overlay($ref2); # merge the two config structures using overlay rules
#$ref->overlay($ref1, $ref2); # merge $ref2 onto $ref1
#$ref->graft($branch_name, $ref2); # graft new config structure onto branch
1.1 p5ee/P5EEx/Blue/examples/config.ini
Index: config.ini
===================================================================
[Standard.Log-Dispatch]
logdir = /var/p5ee
[Authen]
passwd = /etc/passwd
seed = 303292
[Session.default]
sessionClass = P5EE::Blue::Session::CGI
1.1 p5ee/P5EEx/Blue/examples/config.properties
Index: config.properties
===================================================================
# this is a comment
Standard.Log-Dispatch.logdir = /var/p5ee
# regarding Authen ..
Authen.passwd = /etc/passwd
Authen.seed = 303292
# stuff about Session.default
Session.default.sessionClass = P5EE::Blue::Session::CGI
1.1 p5ee/P5EEx/Blue/examples/config.xml
Index: config.xml
===================================================================
<conf>
<Standard>
<Log-Dispatch logdir="/var/p5ee"/>
</Standard>
<Authen passwd="/etc/passwd" seed="303292"/>
<Session>
<default>
<sessionClass>P5EE::Blue::Session::CGI</sessionClass>
</default>
</Session>
</conf>
1.3 +88 -7 p5ee/P5EEx/Blue/sbin/perldocs
Index: perldocs
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/sbin/perldocs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- perldocs 2001/11/30 16:00:53 1.2
+++ perldocs 2001/12/05 22:45:04 1.3
@@ -741,7 +741,8 @@
sub write_class_group_tree {
my ($this_class_group) = @_;
- my ($html);
+ my ($html, $title);
+ $title = ($this_class_group eq "allclasses") ? "All Class Groups" :
"$this_class_group Class Group";
$html = <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0
Transitional//EN""http://www.w3.org/TR/REC-html40/loose.dtd";>
<!--NewPage-->
@@ -806,7 +807,7 @@
<HR>
<CENTER>
<H2>
-Hierarchy For All Class Groups</H2>
+Hierarchy For $title</H2>
</CENTER>
<DL>
<DT>
@@ -904,10 +905,12 @@
sub class_group_tree {
my ($class_group) = @_;
my ($class, $class2, $html, $children, $classes, @root_classes,
%selected_classes);
+ %selected_classes = ();
$html = "";
$classes = $data{classgroup}{$class_group}{classes};
if (defined $classes) {
- foreach $class (@$classes) {
+ foreach (sort @$classes) {
+ $class = $_;
while ($data{class}{$class}{parent}) {
$selected_classes{$class} = 1;
$class = $data{class}{$class}{parent};
@@ -917,7 +920,7 @@
$selected_classes{$class} = 1;
}
}
- foreach $class (@$classes) {
+ foreach $class (sort @$classes) {
$children = $data{class}{$class}{children};
if (defined $children) {
foreach $class2 (@$children) {
@@ -927,7 +930,7 @@
}
$html .= "<ul>\n";
- foreach $class (@root_classes) {
+ foreach $class (sort @root_classes) {
$html .= &class_tree($class, \%selected_classes);
}
$html .= "</ul>\n";
@@ -958,13 +961,91 @@
$children = $data{class}{$class}{children};
if (defined $children) {
$html .= "<ul>\n";
- foreach $class (@$children) {
+ foreach $class (sort @$children) {
if (!defined $selected_classes || !%$selected_classes ||
$selected_classes->{$class}) {
- $html .= &class_tree($class);
+ $html .= &class_tree($class, $selected_classes);
}
}
$html .= "</ul>\n";
}
+ $html;
+}
+
+sub navbar {
+ my ($level, $item) = @_;
+ my ($distribution, $classgroup, $class);
+ my (%level_label, $html);
+
+ %level_label = (
+ allclasses => "Site",
+ distribution => "Distribution",
+ classgroup => "Class-Group",
+ class => "Class",
+ );
+
+ $html = <<EOF;
+<!-- ========== START OF NAVBAR ========== -->
+<A NAME="navbar_top"><!-- --></A>
+<TABLE BORDER="0" WIDTH="100%" CELLPADDING="1" CELLSPACING="0">
+ <TR>
+ <TD COLSPAN=3 BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <A NAME="navbar_top_firstrow"><!-- --></A>
+ <TABLE BORDER="0" CELLPADDING="0" CELLSPACING="3">
+ <TR ALIGN="center" VALIGN="top">
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev">
+ <FONT CLASS="NavBarFont1Rev"><B>Site</B></FONT>
+ </TD>
+ <TD BGCOLOR="#FFFFFF" CLASS="NavBarCell1Rev">
+ <FONT CLASS="NavBarFont1Rev"><B>Distribution</B></FONT>
+ </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <FONT CLASS="NavBarFont1">Class-Group</FONT>
+ </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <FONT CLASS="NavBarFont1">Class</FONT>
+ </TD>
+
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <FONT CLASS="NavBarFont1">Use</FONT>
+ </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <A HREF="overview-tree.html"><FONT
CLASS="NavBarFont1"><B>Tree</B></FONT></A>
+ </TD>
+ <TD BGCOLOR="#EEEEFF" CLASS="NavBarCell1">
+ <A HREF="deprecated-list.html"><FONT
CLASS="NavBarFont1"><B>Deprecated</B></FONT></A>
+ </TD>
+ </TR>
+ </TABLE>
+ </TD>
+ <TD ALIGN="right" VALIGN="top" ROWSPAN=3>
+ <EM><b>$distname-$version</b></EM>
+ </TD>
+ </TR>
+
+ <TR>
+ <TD BGCOLOR="white" CLASS="NavBarCell2">
+ <FONT SIZE="-2"> PREV NEXT</FONT>
+ </TD>
+ <TD BGCOLOR="white" CLASS="NavBarCell2">
+ <FONT SIZE="-2">
+ <A HREF="index.html" TARGET="_top"><B>FRAMES</B></A>
+ <A HREF="overview-summary.html" TARGET="_top"><B>NO
FRAMES</B></A>
+ <SCRIPT>
+ <!--
+ if(window==top) {
+ document.writeln('<A HREF="allclasses-noframe.html" TARGET=""><B>All
Classes</B></A>');
+ }
+ //-->
+ </SCRIPT>
+ <NOSCRIPT>
+ <A HREF="allclasses-noframe.html" TARGET=""><B>All Classes</B></A>
+ </NOSCRIPT>
+ </FONT>
+ </TD>
+ </TR>
+</TABLE>
+<!-- =========== END OF NAVBAR =========== -->
+EOF
$html;
}
