Menu
▾
▴
[Openinteract-commits] CVS: OpenInteract/OpenInteract Config.pm,1.4,1.5 Error.pm,1.4,1.5 Request.pm,1.11,1.12 SPOPS.pm,1.13,1.14 SQLInstall.pm,1.16,1.17 Startup.pm,1.22,1.23 Utility.pm,1.2,1.3
|
From: Chris W. <la...@us...> - 2001-10-17 04:47:10
|
Update of /cvsroot/openinteract/OpenInteract/OpenInteract
In directory usw-pr-cvs1:/tmp/cvs-serv25485/OpenInteract
Modified Files:
Config.pm Error.pm Request.pm SPOPS.pm SQLInstall.pm
Startup.pm Utility.pm
Log Message:
modify to reflect server configuration file changes
Index: Config.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Config.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Config.pm 2001/07/11 12:26:27 1.4
--- Config.pm 2001/10/17 04:47:07 1.5
***************
*** 4,7 ****
--- 4,8 ----
use strict;
+ use OpenInteract::Error;
require Exporter;
***************
*** 15,18 ****
--- 16,20 ----
my %CONFIG_TYPES = (
'perl' => 'OpenInteract::Config::PerlFile',
+ 'ini' => 'OpenInteract::Config::IniFile',
);
***************
*** 35,39 ****
$type ||= 'perl';
! my $class = $CONFIG_TYPES{ $type };
die "No configuration class corresponding to type ($type)" unless ( $class );
eval "require $class";
--- 37,41 ----
$type ||= 'perl';
! my $class = $CONFIG_TYPES{ $type };
die "No configuration class corresponding to type ($type)" unless ( $class );
eval "require $class";
***************
*** 54,68 ****
sub flatten_action_config {
my ( $self ) = @_;
! my $default_action = $self->{action}->{_default_action_info_} || $self->{action}->{default};
my @names = ();
foreach my $action_key ( keys %{ $self->{action} } ) {
next if ( $action_key eq 'default' or $action_key =~ /^_/ );
foreach my $def ( keys %{ $default_action } ) {
! $self->{action}->{ $action_key }->{ $def } ||= $default_action->{ $def };
}
# Also ensure that the action information knows its own key
! $self->{action}->{ $action_key }->{name} = $action_key;
push @names, $action_key;
}
--- 56,70 ----
sub flatten_action_config {
my ( $self ) = @_;
! my $default_action = $self->{action_info}{default} || $self->{action}{_default_action_info_};
my @names = ();
foreach my $action_key ( keys %{ $self->{action} } ) {
next if ( $action_key eq 'default' or $action_key =~ /^_/ );
foreach my $def ( keys %{ $default_action } ) {
! $self->{action}{ $action_key }{ $def } ||= $default_action->{ $def };
}
# Also ensure that the action information knows its own key
! $self->{action}{ $action_key }{name} = $action_key;
push @names, $action_key;
}
***************
*** 137,140 ****
--- 139,160 ----
}
+
+
+ sub is_file_valid {
+ my ( $self, $filename ) = @_;
+
+ unless ( -f $filename ) {
+ my $msg = 'Cannot read configuration file!';
+ my $system_msg = "No valid filename ($filename) for reading configuration information!";
+ OpenInteract::Error->set({ user_msg => $msg,
+ type => 'config',
+ system_msg => $system_msg,
+ method => 'read_config',
+ extra => { filename => $filename } });
+ die $msg;
+ }
+ return 1;
+ }
+
# Allow you to call config keys as methods -- we should probably get
# rid of this and force you to use it as a hashref...
***************
*** 182,201 ****
{ RaiseError => 1 } );
! if ( my $debug = $config->{debugging} ) {
! print $LOG "Trace level $debug: fetching user $user_id...";
! if ( my $user = $self->fetch( $user_id ) ) {
! print $LOG "successful fetching $user_id\n";
! }
! else {
! print $LOG "No such user with ID $user_id",
! ;
! }
}
=head1 DESCRIPTION
! Allows you to embed a configuration object that responds
! to get/set requests. Different from just using key/value
! pairs within your object since you do not have to worry
about writing get/set methods, cluttering up your AUTOLOAD
routine, or things like that. It also allows us to create
--- 202,220 ----
{ RaiseError => 1 } );
! if ( my $debug = $config->{DEBUG} ) {
! print $LOG "Trace level $debug: fetching user $user_id...";
! if ( my $user = $self->fetch( $user_id ) ) {
! print $LOG "successful fetching $user_id\n";
! }
! else {
! print $LOG "No such user with ID $user_id";
! }
}
=head1 DESCRIPTION
! Allows you to embed a configuration object that responds
! to get/set requests. Different from just using key/value
! pairs within your object since you do not have to worry
about writing get/set methods, cluttering up your AUTOLOAD
routine, or things like that. It also allows us to create
***************
*** 225,229 ****
my $font_face = $config->set( font_face => 'Arial, Helvetica' );
! Note that you might want to use the get/set method calls
more frequently for the sake of clarity. Or not. TMTOWTDI.
--- 244,248 ----
my $font_face = $config->set( font_face => 'Arial, Helvetica' );
! Note that you might want to use the get/set method calls
more frequently for the sake of clarity. Or not. TMTOWTDI.
***************
*** 248,252 ****
=over 4
! =item *
B<type> ($)
--- 267,271 ----
=over 4
! =item *
B<type> ($)
***************
*** 302,306 ****
Retrieves the directory name for 'directory-tag', which
! within the Config object may depend on other settings.
For instance, you could have:
--- 321,325 ----
Retrieves the directory name for 'directory-tag', which
! within the Config object may depend on other settings.
For instance, you could have:
Index: Error.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Error.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Error.pm 2001/08/28 21:38:07 1.4
--- Error.pm 2001/10/17 04:47:07 1.5
***************
*** 90,94 ****
$p->{line} = $cline;
}
! my $error_obj_class = $R->CONFIG->{error_object_class};
return $error_obj_class->throw( $p );
}
--- 90,95 ----
$p->{line} = $cline;
}
! my $error_obj_class = $R->CONFIG->{error}{error_object_class} ||
! $R->CONFIG->{error_object_class};
return $error_obj_class->throw( $p );
}
Index: Request.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Request.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Request.pm 2001/08/18 19:17:06 1.11
--- Request.pm 2001/10/17 04:47:07 1.12
***************
*** 60,64 ****
sub db {
my ( $self, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{default_connection_db};
my $db = $self->get_stash( "db-$connect_key" );
return $db if ( $db );
--- 60,65 ----
sub db {
my ( $self, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{datasource}{default_connection_db} ||
! $self->CONFIG->{default_connection_db};
my $db = $self->get_stash( "db-$connect_key" );
return $db if ( $db );
***************
*** 79,83 ****
sub db_stash {
my ( $self, $dbh, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{default_connection_db};
return $self->stash( "db-$connect_key", $dbh );
}
--- 80,85 ----
sub db_stash {
my ( $self, $dbh, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{datasource}{default_connection_db} ||
! $self->CONFIG->{default_connection_db};
return $self->stash( "db-$connect_key", $dbh );
}
***************
*** 86,89 ****
--- 88,93 ----
sub ldap {
my ( $self, $connect_key ) = @_;
+ $connect_key ||= $self->CONFIG->{datasource}{default_connection_ldap} ||
+ $self->CONFIG->{default_connection_ldap};
my $ldap = $self->get_stash( "ldap-$connect_key" );
return $ldap if ( $ldap );
***************
*** 105,109 ****
sub ldap_stash {
my ( $self, $ldap, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{default_connection_ldap};
return $self->stash( "ldap-$connect_key", $ldap );
}
--- 109,114 ----
sub ldap_stash {
my ( $self, $ldap, $connect_key ) = @_;
! $connect_key ||= $self->CONFIG->{datasource}{default_connection_ldap} ||
! $self->CONFIG->{default_connection_ldap};
return $self->stash( "ldap-$connect_key", $ldap );
}
***************
*** 116,120 ****
my ( $self, $p ) = @_;
( $p->{package}, $p->{filename}, $p->{line} ) = caller;
! $p->{action} = $self->{current_context}->{action};
return $self->error->throw( $p );
}
--- 121,125 ----
my ( $self, $p ) = @_;
( $p->{package}, $p->{filename}, $p->{line} ) = caller;
! $p->{action} = $self->{current_context}{action};
return $self->error->throw( $p );
}
***************
*** 149,153 ****
sub ALIAS { return \%ALIAS }
! sub lookup_alias { return $ALIAS{ $_[1] }->{ $_[0]->{stash_class} } }
--- 154,158 ----
sub ALIAS { return \%ALIAS }
! sub lookup_alias { return $ALIAS{ $_[1] }{ $_[0]->{stash_class} } }
***************
*** 165,171 ****
no strict 'refs';
foreach my $alias ( keys %ALIAS ) {
! *{ $class . '::' . $alias } = sub {
my $self = shift; $self = $self->instance unless ( ref $self );
! return $ALIAS{ $alias }->{ $self->{stash_class} }
};
}
--- 170,176 ----
no strict 'refs';
foreach my $alias ( keys %ALIAS ) {
! *{ $class . '::' . $alias } = sub {
my $self = shift; $self = $self->instance unless ( ref $self );
! return $ALIAS{ $alias }{ $self->{stash_class} }
};
}
***************
*** 217,222 ****
sub lookup_conductor {
my ( $self, $action ) = @_;
! $action ||= shift @{ $self->{path}->{current} };
! $self->scrib( 1, "Find conductor for action <<$action>>" );
my ( $action_info, $action_method ) = $self->lookup_action( $action, { return => 'info' } );
$self->scrib( 2, "Info for action:\n", Dumper( $action_info ) );
--- 222,227 ----
sub lookup_conductor {
my ( $self, $action ) = @_;
! $action ||= shift @{ $self->{path}{current} };
! $self->scrib( 1, "Find conductor for action ($action)" );
my ( $action_info, $action_method ) = $self->lookup_action( $action, { return => 'info' } );
$self->scrib( 2, "Info for action:\n", Dumper( $action_info ) );
***************
*** 226,230 ****
return undef if ( $conductor eq 'null' );
! my $conductor_info = $self->CONFIG->{conductor}->{ lc $conductor };
my $method = $conductor_info->{method};
return ( $conductor_info->{class}, $method );
--- 231,235 ----
return undef if ( $conductor eq 'null' );
! my $conductor_info = $self->CONFIG->{conductor}{ lc $conductor };
my $method = $conductor_info->{method};
return ( $conductor_info->{class}, $method );
***************
*** 234,238 ****
# Find the package/class corresponding to a particular
# action tag
! #
# Possible $opt options:
# return => 'info' = return all action info
--- 239,243 ----
# Find the package/class corresponding to a particular
# action tag
! #
# Possible $opt options:
# return => 'info' = return all action info
***************
*** 241,259 ****
sub lookup_action {
my ( $self, $action_name, $opt ) = @_;
! $action_name ||= shift @{ $self->{path}->{current} };
my $action_list = ( ref $action_name eq 'ARRAY' ) ? $action_name : [ $action_name ];
ACTION:
foreach my $action ( @{ $action_list } ) {
$self->scrib( 1, "Find action corresponding to ($action)" );
! my $action_info = $self->CONFIG->{action}->{ lc $action };
$self->scrib( 2, "Info for action:\n", Dumper( $action_info ) );
# If we don't find a action, then we use the action from
! # '_notfound_'; since we put this before the looping to find
# 'action' references, this can simply be a pointer
unless ( $opt->{skip_default} or $action_info ) {
! $action_info = $self->CONFIG->{action}->{ '_notfound_' };
$self->scrib( 1, "Using 'notfound' action" );
}
--- 246,266 ----
sub lookup_action {
my ( $self, $action_name, $opt ) = @_;
! $action_name ||= shift @{ $self->{path}{current} };
my $action_list = ( ref $action_name eq 'ARRAY' ) ? $action_name : [ $action_name ];
+ my $CONFIG = $self->CONFIG;
ACTION:
foreach my $action ( @{ $action_list } ) {
$self->scrib( 1, "Find action corresponding to ($action)" );
! my $action_info = ( $action ) ? $CONFIG->{action}{ lc $action }
! : $CONFIG->{action_info}{none};
$self->scrib( 2, "Info for action:\n", Dumper( $action_info ) );
# If we don't find a action, then we use the action from
! # 'not_found'; since we put this before the looping to find
# 'action' references, this can simply be a pointer
unless ( $opt->{skip_default} or $action_info ) {
! $action_info = $CONFIG->{action_info}{not_found};
$self->scrib( 1, "Using 'notfound' action" );
}
***************
*** 262,266 ****
while ( my $action_redir = $action_info->{redir} ) {
! $action_info = $self->CONFIG->{action}->{ lc $action_redir };
$self->scrib( 3, "Info within redir ($action_redir):\n", Dumper( $action_info ) );
}
--- 269,273 ----
while ( my $action_redir = $action_info->{redir} ) {
! $action_info = $CONFIG->{action}{ lc $action_redir };
$self->scrib( 3, "Info within redir ($action_redir):\n", Dumper( $action_info ) );
}
Index: SPOPS.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/SPOPS.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** SPOPS.pm 2001/08/22 04:48:50 1.13
--- SPOPS.pm 2001/10/17 04:47:07 1.14
***************
*** 319,323 ****
eval { OpenInteract::Utility->send_email({
to => $p->{email},
! from => $R->CONFIG->{admin_email},
subject => $subject,
message => $msg }) };
--- 319,323 ----
eval { OpenInteract::Utility->send_email({
to => $p->{email},
! from => $R->CONFIG->{mail}{admin_email} || $R->CONFIG->{admin_email},
subject => $subject,
message => $msg }) };
Index: SQLInstall.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/SQLInstall.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** SQLInstall.pm 2001/10/05 12:52:17 1.16
--- SQLInstall.pm 2001/10/17 04:47:07 1.17
***************
*** 256,260 ****
elsif ( my $object_class = $action->{spops_class} ) {
! $object_class = $class->sql_class_to_website( $p->{config}{website_name}, $object_class );
DEBUG && _w( 1, "Reading data for class $object_class" );
my $fields = $action->{field_order};
--- 256,261 ----
elsif ( my $object_class = $action->{spops_class} ) {
! my $website_name = $p->{config}{server_info}{website_name} || $p->{config}{website_name};
! $object_class = $class->sql_class_to_website( $website_name, $object_class );
DEBUG && _w( 1, "Reading data for class $object_class" );
my $fields = $action->{field_order};
***************
*** 367,371 ****
sub _transform_class_to_website {
my ( $class, $action, $data_list, $p ) = @_;
! my $website_name = $p->{config}{website_name};
foreach my $data ( @{ $data_list } ) {
foreach my $website_field ( @{ $action->{transform_class_to_website} } ) {
--- 368,372 ----
sub _transform_class_to_website {
my ( $class, $action, $data_list, $p ) = @_;
! my $website_name = $p->{config}{server_info}{website_name} || $p->{config}{website_name};
foreach my $data ( @{ $data_list } ) {
foreach my $website_field ( @{ $action->{transform_class_to_website} } ) {
***************
*** 381,385 ****
sub _transform_class_to_oi {
my ( $class, $action, $data_list, $p ) = @_;
! my $website_name = $p->{config}{website_name};
foreach my $data ( @{ $data_list } ) {
foreach my $website_field ( @{ $action->{transform_class_to_oi} } ) {
--- 382,386 ----
sub _transform_class_to_oi {
my ( $class, $action, $data_list, $p ) = @_;
! my $website_name = $p->{config}{server_info}{website_name} || $p->{config}{website_name};
foreach my $data ( @{ $data_list } ) {
foreach my $website_field ( @{ $action->{transform_class_to_oi} } ) {
Index: Startup.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Startup.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** Startup.pm 2001/10/01 17:11:28 1.22
--- Startup.pm 2001/10/17 04:47:07 1.23
***************
*** 124,129 ****
# created
! my @system_alias_keys = grep ! /^$bc->{website_name}/, keys %{ $C->{system_alias} };
! $class->require_module({ class => \@system_alias_keys });
DEBUG && _w( 2, "Contents of INC: @INC" );
--- 124,129 ----
# created
! my @system_alias_classes = grep ! /^$bc->{website_name}/, values %{ $C->{system_alias} };
! $class->require_module({ class => \@system_alias_classes });
DEBUG && _w( 2, "Contents of INC: @INC" );
***************
*** 174,181 ****
alias_init => 1,
spops_init => 1 });
! my $REQUEST_CLASS = $C->{request_class};
my $R = $REQUEST_CLASS->instance;
! $R->{stash_class} = $C->{stash_class};
$R->stash( 'config', $C );
--- 174,181 ----
alias_init => 1,
spops_init => 1 });
! my $REQUEST_CLASS = $C->{server_info}{request_class};
my $R = $REQUEST_CLASS->instance;
! $R->{stash_class} = $C->{server_info}{stash_class};
$R->stash( 'config', $C );
***************
*** 220,228 ****
# mod_perl, and will be set in the returned config object in any case
! $C->{dir}{base} = $bc->{website_dir};
! $C->{dir}{interact} = $bc->{base_dir};
! $C->{request_class} = $bc->{request_class};
! $C->{stash_class} = $bc->{stash_class};
! $C->{website_name} = $bc->{website_name};
return $C;
}
--- 220,228 ----
# mod_perl, and will be set in the returned config object in any case
! $C->{dir}{base} = $bc->{website_dir};
! $C->{dir}{interact} = $bc->{base_dir};
! $C->{server_info}{request_class} = $bc->{request_class};
! $C->{server_info}{stash_class} = $bc->{stash_class};
! $C->{server_info}{website_name} = $bc->{website_name};
return $C;
}
***************
*** 504,509 ****
my ( $class, $p ) = @_;
my $CONF = $p->{config};
! my $REQUEST_CLASS = $CONF->{request_class};
! my $STASH_CLASS = $CONF->{stash_class};
# Create all the packages and subroutines on the fly as necessary
--- 504,509 ----
my ( $class, $p ) = @_;
my $CONF = $p->{config};
! my $REQUEST_CLASS = $CONF->{server_info}{request_class};
! my $STASH_CLASS = $CONF->{server_info}{stash_class};
# Create all the packages and subroutines on the fly as necessary
***************
*** 539,548 ****
DEBUG && _w( 1, "Setting up System aliases" );
! foreach my $sys_class ( keys %{ $CONF->{system_alias} } ) {
! next if ( $sys_class =~ /^_/ );
! foreach my $alias ( @{ $CONF->{system_alias}{ $sys_class } } ) {
! DEBUG && _w( 1, "Tagging $alias in $STASH_CLASS to be $sys_class" );
! $request_alias->{ $alias }{ $STASH_CLASS } = $sys_class;
! }
}
DEBUG && _w( 1, "Setup object and system aliases ok" );
--- 539,544 ----
DEBUG && _w( 1, "Setting up System aliases" );
! foreach my $alias ( keys %{ $CONF->{system_alias} } ) {
! $request_alias->{ $alias }{ $STASH_CLASS } = $CONF->{system_alias}{ $alias };
}
DEBUG && _w( 1, "Setup object and system aliases ok" );
Index: Utility.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Utility.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Utility.pm 2001/10/08 18:19:52 1.2
--- Utility.pm 2001/10/17 04:47:07 1.3
***************
*** 114,118 ****
my $R = OpenInteract::Request->instance;
return ( To => $p->{to} || $p->{email},
! From => $p->{from} || $R->CONFIG->{admin_email},
Subject => $p->{subject} || DEFAULT_SUBJECT );
}
--- 114,118 ----
my $R = OpenInteract::Request->instance;
return ( To => $p->{to} || $p->{email},
! From => $p->{from} || $R->CONFIG->{mail}{admin_email} || $R->CONFIG->{admin_email},
Subject => $p->{subject} || DEFAULT_SUBJECT );
}
***************
*** 122,126 ****
my ( $class, $p ) = @_;
my $R = OpenInteract::Request->instance;
! return $p->{smtp} || $R->CONFIG->{smtp_host};
}
--- 122,126 ----
my ( $class, $p ) = @_;
my $R = OpenInteract::Request->instance;
! return $p->{smtp} || $R->CONFIG->{mail}{smtp_host} || $R->CONFIG->{smtp_host};
}
***************
*** 228,232 ****
From whom the email will be sent. If not specified we use the value of
! the 'admin_email' key in your server configuration
(C<conf/server.perl> file).
--- 228,232 ----
From whom the email will be sent. If not specified we use the value of
! the 'mail'->'admin_email' key in your server configuration
(C<conf/server.perl> file).
***************
*** 312,316 ****
In the server configuration file, be able to do something like:
! 'email' => {
'smtp_host' => '127.0.0.1',
'admin_email' => 'ad...@my...',
--- 312,316 ----
In the server configuration file, be able to do something like:
! 'mail' => {
'smtp_host' => '127.0.0.1',
'admin_email' => 'ad...@my...',
|
