Menu
▾
▴
openinteract-commits — CVS updates for OpenInteract/SPOPS
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(381) |
Nov
(176) |
Dec
(310) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2002 |
Jan
(334) |
Feb
(96) |
Mar
(149) |
Apr
(214) |
May
(120) |
Jun
(56) |
Jul
(10) |
Aug
(273) |
Sep
(182) |
Oct
(56) |
Nov
(125) |
Dec
(22) |
| 2003 |
Jan
(63) |
Feb
(181) |
Mar
(498) |
Apr
(433) |
May
(39) |
Jun
(512) |
Jul
(276) |
Aug
(156) |
Sep
(101) |
Oct
(66) |
Nov
(24) |
Dec
(161) |
| 2004 |
Jan
(1) |
Feb
(377) |
Mar
(68) |
Apr
(26) |
May
(107) |
Jun
(333) |
Jul
(13) |
Aug
|
Sep
(76) |
Oct
(88) |
Nov
(170) |
Dec
(91) |
| 2005 |
Jan
(52) |
Feb
(239) |
Mar
(402) |
Apr
(15) |
May
(2) |
Jun
(1) |
Jul
(13) |
Aug
|
Sep
(71) |
Oct
(34) |
Nov
|
Dec
|
| 2006 |
Jan
(5) |
Feb
(5) |
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
(3) |
Sep
(7) |
Oct
(2) |
Nov
|
Dec
|
| 2007 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Chris W. <la...@us...> - 2001-10-24 16:05:46
|
Update of /cvsroot/openinteract/OpenInteract/OpenInteract/Template
In directory usw-pr-cvs1:/tmp/cvs-serv5848
Modified Files:
Plugin.pm
Log Message:
added 'is_admin' property, along with documentation
Index: Plugin.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Template/Plugin.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Plugin.pm 2001/10/18 02:11:24 1.15
--- Plugin.pm 2001/10/24 16:05:43 1.16
***************
*** 348,351 ****
--- 348,356 ----
+ sub is_admin {
+ return OpenInteract::Request->instance->{auth}{is_admin};
+ }
+
+
sub return_url {
my $R = OpenInteract::Request->instance;
***************
*** 891,894 ****
--- 896,915 ----
[% IF OI.logged_in %]
<p>You are very special, logged-in user!</p>
+ [% END %]
+
+ B<is_admin()>
+
+ True/false depending on whether the user is an administrator. The
+ definition of 'is an administrator' depends on the authentication
+ class being used -- by default it means that the user is the superuser
+ or a member of the 'site admin' group. But you can modify this based
+ on your needs, and make the result available to all templates with
+ this property.
+
+ Example:
+
+ [% IF OI.is_admin %]
+ <p>You are an administrator -- you have the power! It feels great,
+ eh?</p>
[% END %]
|
|
From: Chris W. <la...@us...> - 2001-10-24 11:31:38
|
Update of /cvsroot/openinteract/OpenInteract/OpenInteract
In directory usw-pr-cvs1:/tmp/cvs-serv17845
Modified Files:
SPOPS.pm
Log Message:
updated notify() and added docs for its parameters
Index: SPOPS.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/SPOPS.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** SPOPS.pm 2001/10/20 15:17:44 1.15
--- SPOPS.pm 2001/10/24 11:31:35 1.16
***************
*** 286,303 ****
my $subject = $p->{subject} || "Object notification: $num_objects objects in mail";
my $separator = '=' x 25;
! my $msg = ( $p->{notes} ) ? join( "\n", 'Notes', "$separator$p->{notes}", $separator, "\n" ) : '';
foreach my $obj ( @{ $p->{object} } ) {
my $info = $obj->object_description;
my $object_url = join( '', 'http://', $R->{server_name}, $info->{url} );
! $msg .= "Begin $p->{type} object\n$separator\n" .
! $obj->as_string . "\n" .
! "View this object at: $object_url\n" .
! "\n$separator\nEnd $p->{type} object\n\n\n";
}
! eval { OpenInteract::Utility->send_email({
! to => $p->{email},
! from => $R->CONFIG->{mail}{admin_email} || $R->CONFIG->{admin_email},
! subject => $subject,
! message => $msg }) };
if ( $@ ) {
$R->throw({ code => 203 });
--- 286,314 ----
my $subject = $p->{subject} || "Object notification: $num_objects objects in mail";
my $separator = '=' x 25;
! my $msg = ( $p->{notes} ) ?
! join( "\n", 'Notes', "$separator$p->{notes}", $separator, "\n" ) : '';
foreach my $obj ( @{ $p->{object} } ) {
my $info = $obj->object_description;
my $object_url = join( '', 'http://', $R->{server_name}, $info->{url} );
! $msg .= <<OBJECT;
! Begin $info->{name} object
! $separator
! @{[ $obj->as_string ]}
!
! View this object at: $object_url
! $separator
! End $p->{name} object
!
! OBJECT
}
! my $from_email = $p->{email_from} ||
! $R->CONFIG->{mail}{admin_email} ||
! $R->CONFIG->{admin_email};
! eval {
! OpenInteract::Utility->send_email({ to => $p->{email},
! from => $from_email,
! subject => $subject,
! message => $msg });
! };
if ( $@ ) {
$R->throw({ code => 203 });
***************
*** 474,477 ****
--- 485,528 ----
information in your class configuration which specifies the fields you
want to use in the listing along with associated labels.
+
+ Parameters:
+
+ =over 4
+
+ =item *
+
+ B<email> ($)
+
+ Address to which we should send the notification.
+
+ =item *
+
+ B<email_from> ($) (optional)
+
+ Address from which the email should be sent. If not specified this
+ defaults to the 'admin_email' setting in your server configuration
+ (under 'mail').
+
+ =item *
+
+ B<subject> ($) (optional)
+
+ Subject of email. If not specified the subject will be 'Object
+ notification # objects in mail'.
+
+ =item *
+
+ B<object> (\@) (optional if called from an object)
+
+ If not called from an object, this should be an arrayref of objects to
+ notify someone about.
+
+ =item *
+
+ B<notes> ($) (optional)
+
+ Notes that lead off an email.
+
+ =back
=head1 TO DO
|
|
From: Chris W. <la...@us...> - 2001-10-24 03:04:14
|
Update of /cvsroot/openinteract/OpenInteract/pkg/base_error/template In directory usw-pr-cvs1:/tmp/cvs-serv31322 Removed Files: err_not_found.meta err_not_found.tmpl err_task_forbidden.meta err_task_forbidden.tmpl err_task_no_default.meta err_task_no_default.tmpl Log Message: moved to main template directory --- err_not_found.meta DELETED --- --- err_not_found.tmpl DELETED --- --- err_task_forbidden.meta DELETED --- --- err_task_forbidden.tmpl DELETED --- --- err_task_no_default.meta DELETED --- --- err_task_no_default.tmpl DELETED --- |
|
From: Chris W. <la...@us...> - 2001-10-24 03:03:00
|
Update of /cvsroot/openinteract/OpenInteract/template In directory usw-pr-cvs1:/tmp/cvs-serv30906 Added Files: error_not_found error_task_forbidden error_task_no_default Log Message: moved error message templates from base_error package --- NEW FILE: error_not_found --- <div align="center"> <h1>File not found</h1> <table width="50%" border="0" cellpadding="5" cellspacing="0"> <tr><td align="left"> The URL you entered does not correspond to a page currently on this website. Please check the url and try again. </td></tr> <tr><td align="right">Sincerely,<br> The Management </td></tr> [% IF err.referer %] <tr><td> <a href="[% err.referer %]">Back</a> to the page that brought you here </td></tr> [% END %] </table> </div> --- NEW FILE: error_task_forbidden --- <div align="center"> <h1>Task is Forbidden</h1> <table width="50%" border="0" cellpadding="5" cellspacing="0"> <tr><td align="left"> You cannot accomplish the task you have requested due to security restrictions. If you believe there is a mistake, please contact <a href="mailto:[% admin_email %]">The Administrator</a>. </td></tr> <tr><td align="right">Sincerely,<br> The Management </td></tr> </table> </div> --- NEW FILE: error_task_no_default --- <div align="center"> <h1>Task Cannot be Completed</h1> <table width="50%" border="0" cellpadding="5" cellspacing="0"> <tr><td align="left"> The module you requested does not have a default task defined. Therefore your task cannot be completed. An email has already been sent to the module author, but if you'd like you can <a href="mailto:[% author_email %]">do so yourself</a>. </td></tr> <tr><td align="right">Sincerely,<br> The Management </td></tr> </table> </div> |
|
From: Chris W. <la...@us...> - 2001-10-24 03:02:00
|
Update of /cvsroot/openinteract/OpenInteract/OpenInteract/Error
In directory usw-pr-cvs1:/tmp/cvs-serv30546
Modified Files:
System.pm
Log Message:
changed error template names from being in the 'base_error' package to
being in the main template directory
Index: System.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/OpenInteract/Error/System.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** System.pm 2001/10/17 04:47:07 1.3
--- System.pm 2001/10/24 03:01:58 1.4
***************
*** 224,229 ****
my $R = OpenInteract::Request->instance;
$R->{page}{title} = 'Sorry: File not found';
! my $html = $R->template->handler( {}, { err => $err }, { db => 'err_not_found',
! package => 'base_error' } );
die "$html\n";
}
--- 224,228 ----
my $R = OpenInteract::Request->instance;
$R->{page}{title} = 'Sorry: File not found';
! my $html = $R->template->handler( {}, { err => $err }, { name => 'error_not_found' } );
die "$html\n";
}
***************
*** 245,250 ****
admin_email => $R->CONFIG->{mail}{admin_email} ||
$R->CONFIG->{admin_email} },
! { db => 'err_task_forbidden',
! package => 'base_error' } );
die "$html\n";
}
--- 244,248 ----
admin_email => $R->CONFIG->{mail}{admin_email} ||
$R->CONFIG->{admin_email} },
! { name => 'error_task_forbidden' } );
die "$html\n";
}
***************
*** 273,278 ****
{ err => $err,
author_email => $err->{tmp_email} },
! { db => 'err_task_no_default',
! package => 'base_error' } );
die "$html\n";
}
--- 271,275 ----
{ err => $err,
author_email => $err->{tmp_email} },
! { name => 'error_task_no_default' } );
die "$html\n";
}
***************
*** 287,292 ****
admin_email => $R->CONFIG->{mail}{admin_email} ||
$R->CONFIG->{admin_email} },
! { db => 'err_task_forbidden',
! package => 'base_error' } );
die "$html\n";
}
--- 284,288 ----
admin_email => $R->CONFIG->{mail}{admin_email} ||
$R->CONFIG->{admin_email} },
! { name => 'error_task_forbidden' } );
die "$html\n";
}
|
|
From: Chris W. <la...@us...> - 2001-10-24 02:51:27
|
Update of /cvsroot/openinteract/SPOPS/SPOPS/DBI
In directory usw-pr-cvs1:/tmp/cvs-serv26493
Modified Files:
MySQL.pm
Log Message:
got rid of -w error ('Use of uninitialized value in string eq...')
Index: MySQL.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/DBI/MySQL.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** MySQL.pm 2001/10/22 06:26:26 1.12
--- MySQL.pm 2001/10/24 02:51:24 1.13
***************
*** 41,45 ****
my ( $class ) = @_;
my $CONFIG = $class->CONFIG;
! return ( OK, undef ) unless ( $CONFIG->{find_defaults} eq 'yes' );
my $dbh = $class->global_datasource_handle( $CONFIG->{datasource} );
unless ( $dbh ) {
--- 41,45 ----
my ( $class ) = @_;
my $CONFIG = $class->CONFIG;
! return ( OK, undef ) unless ( $CONFIG->{find_defaults} and $CONFIG->{find_defaults} eq 'yes' );
my $dbh = $class->global_datasource_handle( $CONFIG->{datasource} );
unless ( $dbh ) {
|
|
From: Chris W. <la...@us...> - 2001-10-24 02:49:21
|
Update of /cvsroot/openinteract/OpenInteract/pkg/base_error/OpenInteract/Handler
In directory usw-pr-cvs1:/tmp/cvs-serv25655/OpenInteract/Handler
Modified Files:
Error.pm
Log Message:
fixed dumb naming error (date_read vs read_date) in handler
Index: Error.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_error/OpenInteract/Handler/Error.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Error.pm 2001/08/27 05:28:26 1.9
--- Error.pm 2001/10/24 02:49:19 1.10
***************
*** 13,17 ****
$OpenInteract::Handler::Error::default_method = 'listing';
@OpenInteract::Handler::Error::forbidden_methods = ();
! %OpenInteract::Handler::Error::security = (
listing => SEC_LEVEL_READ,
show => SEC_LEVEL_READ,
--- 13,17 ----
$OpenInteract::Handler::Error::default_method = 'listing';
@OpenInteract::Handler::Error::forbidden_methods = ();
! %OpenInteract::Handler::Error::security = (
listing => SEC_LEVEL_READ,
show => SEC_LEVEL_READ,
***************
*** 58,68 ****
if ( my $filter_from_year = $apr->param( 'filter_date_from_year' ) ) {
! my $from_date = $class->read_date( 'filter_date_from' );
( $filter{from_year}, $filter{from_month}, $filter{from_day} ) = split /\-/, $from_date;
$where .= ' AND error_time > ?';
push @value, $from_date;
! }
if ( my $filter_to_year = $apr->param( 'filter_date_to_year' ) ) {
! my $to_date = $class->read_date( 'filter_date_to' );
( $filter{to_year}, $filter{to_month}, $filter{to_day} ) = split /\-/, $to_date;
$where .= ' AND error_time < ?';
--- 58,68 ----
if ( my $filter_from_year = $apr->param( 'filter_date_from_year' ) ) {
! my $from_date = $class->date_read( 'filter_date_from' );
( $filter{from_year}, $filter{from_month}, $filter{from_day} ) = split /\-/, $from_date;
$where .= ' AND error_time > ?';
push @value, $from_date;
! }
if ( my $filter_to_year = $apr->param( 'filter_date_to_year' ) ) {
! my $to_date = $class->date_read( 'filter_date_to' );
( $filter{to_year}, $filter{to_month}, $filter{to_day} ) = split /\-/, $to_date;
$where .= ' AND error_time < ?';
***************
*** 71,82 ****
$where =~ s/^ AND //;
! my $params = { main_script => MAIN_SCRIPT,
! sort => $order,
! filterby => \%filter,
error_msg => $p->{error_msg} };
! # Now actually retrieve the errors
! $params->{error_iterator} = eval { $R->error_object->fetch_iterator({
order => $db_order,
where => $where,
--- 71,82 ----
$where =~ s/^ AND //;
! my $params = { main_script => MAIN_SCRIPT,
! sort => $order,
! filterby => \%filter,
error_msg => $p->{error_msg} };
! # Now actually retrieve the errors
! $params->{error_iterator} = eval { $R->error_object->fetch_iterator({
order => $db_order,
where => $where,
***************
*** 92,96 ****
$R->{page}->{title} = 'Listing of Errors';
! return $R->template->handler( {}, $params,
{ db => 'error_list',
package => 'base_error' } );
--- 92,96 ----
$R->{page}->{title} = 'Listing of Errors';
! return $R->template->handler( {}, $params,
{ db => 'error_list',
package => 'base_error' } );
***************
*** 106,110 ****
if ( $@ ) {
my $ei = SPOPS::Error->get;
! if ( $ei->{type} ne 'security' ) {
$R->throw( { code => 404 } );
$params->{error_msg} = "Could not retrieve Error object. Error logged.";
--- 106,110 ----
if ( $@ ) {
my $ei = SPOPS::Error->get;
! if ( $ei->{type} ne 'security' ) {
$R->throw( { code => 404 } );
$params->{error_msg} = "Could not retrieve Error object. Error logged.";
***************
*** 127,132 ****
$R->{page}->{title} = 'Detail of Error';
$params->{err} = $error;
! return $R->template->handler( {}, $params,
! { db => 'error_detail',
package => 'base_error' } );
}
--- 127,132 ----
$R->{page}->{title} = 'Detail of Error';
$params->{err} = $error;
! return $R->template->handler( {}, $params,
! { db => 'error_detail',
package => 'base_error' } );
}
***************
*** 147,153 ****
next;
}
! eval { $error->remove; };
push @error_items, SPOPS::Error->get if ( $@ );
! }
$p->{error_msg} = join "\n\n", map { $_->{system_msg} } @error_items if ( scalar @error_items );
return $class->listing( $p );
--- 147,153 ----
next;
}
! eval { $error->remove; };
push @error_items, SPOPS::Error->get if ( $@ );
! }
$p->{error_msg} = join "\n\n", map { $_->{system_msg} } @error_items if ( scalar @error_items );
return $class->listing( $p );
***************
*** 169,175 ****
push @error_list, $error if ( $error );
}
! if ( $R->error_object->notify({ email => $email,
! subject => 'Error object notification',
! object => \@error_list,
type => 'error' } ) ) {
return '<h2 align="center">Success!</h2>' .
--- 169,175 ----
push @error_list, $error if ( $error );
}
! if ( $R->error_object->notify({ email => $email,
! subject => 'Error object notification',
! object => \@error_list,
type => 'error' } ) ) {
return '<h2 align="center">Success!</h2>' .
***************
*** 221,225 ****
B<Page?>
! Should we page results?
B<Change initial page?>
--- 221,225 ----
B<Page?>
! Should we page results?
B<Change initial page?>
|
|
From: Chris W. <la...@us...> - 2001-10-24 02:49:21
|
Update of /cvsroot/openinteract/OpenInteract/pkg/base_error In directory usw-pr-cvs1:/tmp/cvs-serv25655 Modified Files: Changes package.conf Log Message: fixed dumb naming error (date_read vs read_date) in handler Index: Changes =================================================================== RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_error/Changes,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** Changes 2001/10/07 20:18:13 1.19 --- Changes 2001/10/24 02:49:19 1.20 *************** *** 1,4 **** --- 1,9 ---- Revision history for OpenInteract package base_error. + 1.33 Tue Oct 23 23:04:22 EDT 2001 + + Fixed handler 'read_date' calls to 'date_read' (Thanks to Mike + Eggleston <mi...@mi...> for the error report.) + 1.32 Sun Oct 7 16:32:05 EDT 2001 Index: package.conf =================================================================== RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_error/package.conf,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** package.conf 2001/10/07 20:18:13 1.19 --- package.conf 2001/10/24 02:49:19 1.20 *************** *** 1,4 **** name base_error ! version 1.32 author Chris Winters (ch...@cw...) url http://www.openinteract.org/ --- 1,4 ---- name base_error ! version 1.33 author Chris Winters (ch...@cw...) url http://www.openinteract.org/ |
|
From: Chris W. <la...@us...> - 2001-10-23 14:28:48
|
Update of /cvsroot/openinteract/OpenInteract/pkg/base_user In directory usw-pr-cvs1:/tmp/cvs-serv30005 Modified Files: Changes package.conf Log Message: updated OpenInteract::User::LDAP to work with multiple datasources Index: Changes =================================================================== RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_user/Changes,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** Changes 2001/10/17 04:47:08 1.24 --- Changes 2001/10/23 14:28:45 1.25 *************** *** 1,4 **** --- 1,9 ---- Revision history for OpenInteract package base_user. + 1.39 Tue Oct 23 09:13:32 EDT 2001 + + Updated OpenInteact/User/LDAP.pm to look at the sticky + datasource and check the password against that. + 1.38 Tue Oct 16 23:52:13 EDT 2001 Index: package.conf =================================================================== RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_user/package.conf,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** package.conf 2001/10/17 04:47:08 1.24 --- package.conf 2001/10/23 14:28:45 1.25 *************** *** 1,4 **** name base_user ! version 1.38 author Chris Winters (ch...@cw...) url http://www.openinteract.org/ --- 1,4 ---- name base_user ! version 1.39 author Chris Winters (ch...@cw...) url http://www.openinteract.org/ |
|
From: Chris W. <la...@us...> - 2001-10-23 14:28:48
|
Update of /cvsroot/openinteract/OpenInteract/pkg/base_user/OpenInteract/User
In directory usw-pr-cvs1:/tmp/cvs-serv30005/OpenInteract/User
Modified Files:
LDAP.pm
Log Message:
updated OpenInteract::User::LDAP to work with multiple datasources
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract/pkg/base_user/OpenInteract/User/LDAP.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** LDAP.pm 2001/08/27 17:05:43 1.3
--- LDAP.pm 2001/10/23 14:28:45 1.4
***************
*** 19,23 ****
sub check_password {
my ( $self, $check_passwd ) = @_;
! my $connect_info = $self->connection_info;
my $ldap = eval { OpenInteract::LDAP->connect( $connect_info ) };
if ( $@ ) {
--- 19,33 ----
sub check_password {
my ( $self, $check_passwd ) = @_;
! my $R = OpenInteract::Request->instance;
!
! # If we're using multiple datasources
! # (SPOPS::LDAP::MultiDatasource) then the name of the datasource
! # should be stored in the object. Otherwise we just use the
! # default for this class.
!
! my $datasource = $self->{_datasource} || $self->get_connect_key;
! $R->DEBUG && $R->scrib( 1, "Trying to check password for user", $self->dn,
! "against datasource ($datasource)" );
! my $connect_info = $self->connection_info( $datasource );
my $ldap = eval { OpenInteract::LDAP->connect( $connect_info ) };
if ( $@ ) {
***************
*** 26,29 ****
--- 36,40 ----
system_msg => $@,
type => 'db' });
+ $R->scrib( 0, "Failed to connect to LDAP directory: $@" );
die $OpenInteract::Error::user_msg;
}
***************
*** 31,34 ****
--- 42,46 ----
bind_password => $check_passwd };
eval { OpenInteract::LDAP->bind( $ldap, $bind_info ) };
+ $R->DEBUG && $R->scrib( 1, "Result of password check (empty means ok): ($@)" );
return ( ! $@ );
}
|
|
From: Chris W. <la...@us...> - 2001-10-23 14:25:34
|
Update of /cvsroot/openinteract/SPOPS/eg/My
In directory usw-pr-cvs1:/tmp/cvs-serv28521/eg/My
Added Files:
LDAPConnect.pm
Log Message:
added example of SPOPS::LDAP::MultiDatasource, including a simple object and connection manager
--- NEW FILE: LDAPConnect.pm ---
package My::LDAPConnect;
# $Id: LDAPConnect.pm,v 1.1 2001/10/23 14:25:31 lachoy Exp $
# Simple LDAP connection manager -- change %DATASOURCE as needed for testing
use strict;
use Carp qw( cluck );
my %HANDLES = ();
my %DATASOURCE = (
main => { host => 'localhost',
base_dn => 'dc=mycompany,dc=com' },
remote => { host => 'localhost',
port => 3890,
base_dn => 'dc=mycompany,dc=com' },
);
sub connection_info {
my ( $class, $connect_key ) = @_;
return \%{ $DATASOURCE{ $connect_key } };
}
sub global_datasource_handle {
my ( $class, $connect_key ) = @_;
unless ( $connect_key ) {
cluck "Cannot retrieve handle without connect key!\n";
}
unless ( $HANDLES{ $connect_key } ) {
my $ldap_info = $class->connection_info( $connect_key );
$ldap_info->{port} ||= 389;
my $ldap = Net::LDAP->new( $ldap_info->{host},
port => $ldap_info->{port} );
die "Cannot create LDAP connection!\n" unless ( $ldap );
my ( %bind_params );
if ( $ldap_info->{bind_dn} ) {
$bind_params{dn} = $ldap_info->{bind_dn};
$bind_params{password} = $ldap_info->{bind_password};
}
my $bind_msg = $ldap->bind( %bind_params );
die "Cannot bind! Error: ", $bind_msg->error, "\n" if ( $bind_msg->code );
$HANDLES{ $connect_key } = $ldap;
}
return $HANDLES{ $connect_key };
}
1;
|
|
From: Chris W. <la...@us...> - 2001-10-23 14:25:34
|
Update of /cvsroot/openinteract/SPOPS/eg
In directory usw-pr-cvs1:/tmp/cvs-serv28521/eg
Added Files:
ldap_multidatasource.pl
Log Message:
added example of SPOPS::LDAP::MultiDatasource, including a simple object and connection manager
--- NEW FILE: ldap_multidatasource.pl ---
#!/usr/bin/perl
# $Id: ldap_multidatasource.pl,v 1.1 2001/10/23 14:25:31 lachoy Exp $
# ldap_multidatasource.pl
# This is an example of how you can setup multiple datasources. You
# will need to change the connection configuration information
# located in eg/My/LDAPConnect.pm
use strict;
use SPOPS::Initialize;
{
my $config = {
user => {
datasource => [ 'main', 'remote' ],
class => 'My::LDAPUser',
isa => [ 'My::LDAPConnect', 'SPOPS::LDAP::MultiDatasource' ],
field => [ qw/ cn sn givenname displayname mail
telephonenumber objectclass uid ou / ],
ldap_base_dn => 'ou=People',
multivalue => [ 'objectclass' ],
id_field => 'uid',
},
};
SPOPS::Initialize->process({ config => $config });
my $user_list = My::LDAPUser->fetch_group_all({ filter => 'givenname=User' });
foreach my $user ( @{ $user_list } ) {
print "I am ", $user->dn, " and I came from $user->{_datasource}\n";
}
}
|
|
From: Chris W. <la...@us...> - 2001-10-23 14:25:02
|
Update of /cvsroot/openinteract/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv28177
Modified Files:
Changes
Log Message:
latest changes
Index: Changes
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/Changes,v
retrieving revision 1.67
retrieving revision 1.68
diff -C2 -d -r1.67 -r1.68
*** Changes 2001/10/22 15:22:45 1.67
--- Changes 2001/10/23 14:25:00 1.68
***************
*** 3,6 ****
--- 3,17 ----
0.52
+ Overall:
+
+ - You can now specify defaults for objects so when you instantiate
+ one via new() the values get automatically filled in. There are
+ different ways to set these defaults -- see
+ SPOPS::Manual::Configuration and SPOPS::Manual::CodeGeneration for
+ examples and ideas.
+
+ - Bugfixes, including one in SPOPS::ClassFactory::DefaultBehavior
+ that broke old apps using rules
+
Individual:
***************
*** 10,13 ****
--- 21,29 ----
My::DBI::FindDefaults works.
+ * eg/ldap_multidatasource.pl:
+
+ - Added script to demonstrate (along with eg/My/LDAPConnect.pm)
+ how multiple datasources work with SPOPS::LDAP::MultiDatasource
+
* eg/My/DBI/FindDefaults.pm:
***************
*** 15,18 ****
--- 31,39 ----
information for a particular record to use as defaults.
+ * eg/My/LDAPConnect.pm:
+
+ - Example of an LDAP connection manager that works with multiple
+ datasources.
+
* SPOPS.pm
***************
*** 41,44 ****
--- 62,72 ----
versions. Fixed. (Thanks to Peter Beardsley
<pbe...@ap...> for the report.)
+
+ * SPOPS/LDAP/MultiDatasource.pm:
+
+ - Make datasources sticky -- each object should be able to find
+ out where it came from. Also override save() and remove() so that
+ we first grab the right handle and pass it along to the method
+ that does the real work.
|
|
From: Chris W. <la...@us...> - 2001-10-23 14:23:30
|
Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv27565/SPOPS
Modified Files:
LDAP.pm
Log Message:
use the DEBUG from SPOPS.pm and modify accordingly all debugging statements
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/LDAP.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** LDAP.pm 2001/10/22 11:50:01 1.31
--- LDAP.pm 2001/10/23 14:23:27 1.32
***************
*** 8,17 ****
use Net::LDAP::Entry qw();
use Net::LDAP::Util qw();
! use SPOPS qw( _w _wm );
use SPOPS::Error qw();
use SPOPS::Secure qw( :level );
- use constant DEBUG => 0;
-
@SPOPS::LDAP::ISA = qw( SPOPS );
$SPOPS::LDAP::VERSION = '1.90';
--- 8,15 ----
use Net::LDAP::Entry qw();
use Net::LDAP::Util qw();
! use SPOPS qw( DEBUG _w );
use SPOPS::Error qw();
use SPOPS::Secure qw( :level );
@SPOPS::LDAP::ISA = qw( SPOPS );
$SPOPS::LDAP::VERSION = '1.90';
***************
*** 67,71 ****
my ( $class ) = @_;
require SPOPS::ClassFactory::LDAP;
! DEBUG() && _wm( 2, DEBUG, "Installing SPOPS::LDAP behaviors for ($class)" );
return { read_code => \&SPOPS::ClassFactory::LDAP::conf_read_code,
has_a => \&SPOPS::ClassFactory::LDAP::conf_relate_has_a,
--- 65,69 ----
my ( $class ) = @_;
require SPOPS::ClassFactory::LDAP;
! DEBUG && _w( 2, "Installing SPOPS::LDAP behaviors for ($class)" );
return { read_code => \&SPOPS::ClassFactory::LDAP::conf_read_code,
has_a => \&SPOPS::ClassFactory::LDAP::conf_relate_has_a,
***************
*** 129,135 ****
my ( $class, $id, $p ) = @_;
$p ||= {};
! DEBUG() && _wm( 2, DEBUG, "Trying to fetch an item of $class with ID $id and params ",
! join " // ",
! map { $_ . ' -> ' . ( defined( $p->{$_} ) ? $p->{$_} : '' ) }
keys %{ $p } );
return undef unless ( $id or $p->{filter} );
--- 127,133 ----
my ( $class, $id, $p ) = @_;
$p ||= {};
! DEBUG && _w( 2, "Trying to fetch an item of $class with ID $id and params ",
! join " // ",
! map { $_ . ' -> ' . ( defined( $p->{$_} ) ? $p->{$_} : '' ) }
keys %{ $p } );
return undef unless ( $id or $p->{filter} );
***************
*** 147,151 ****
filter => $filter });
unless ( $entry ) {
! DEBUG() && _wm( 1, DEBUG, "No entry found matching object ID ($id)" );
return undef;
}
--- 145,149 ----
filter => $filter });
unless ( $entry ) {
! DEBUG && _w( 1, "No entry found matching object ID ($id)" );
return undef;
}
***************
*** 177,181 ****
return undef unless ( $class->pre_fetch_action({ %{ $p }, id => $p->{id} }) );
! DEBUG() && _wm( 1, DEBUG, "Pre fetch actions executed ok" );
return $info;
}
--- 175,179 ----
return undef unless ( $class->pre_fetch_action({ %{ $p }, id => $p->{id} }) );
! DEBUG && _w( 1, "Pre fetch actions executed ok" );
return $info;
}
***************
*** 184,189 ****
sub _perform_postfetch {
my ( $class, $p, $info, $entry ) = @_;
! DEBUG() && _wm( 1, "Single entry found ok; setting values into object",
! "(Delay security: $info->{delay_security_check})" );
my $obj = $class->new({ skip_default_values => 1 });
$obj->_fetch_assign_row( undef, $entry );
--- 182,187 ----
sub _perform_postfetch {
my ( $class, $p, $info, $entry ) = @_;
! DEBUG && _w( 1, "Single entry found ok; setting values into object",
! "(Delay security: $info->{delay_security_check})" );
my $obj = $class->new({ skip_default_values => 1 });
$obj->_fetch_assign_row( undef, $entry );
***************
*** 200,205 ****
my ( $class, $p ) = @_;
my $ldap = $p->{ldap} || $class->global_datasource_handle( $p->{connect_key} );
! DEBUG() && _wm( 1, DEBUG, "Base DN (", $class->base_dn( $p->{connect_key} ), ")",
! "and filter <<$p->{filter}>> being used to fetch single object" );
my %args = ( base => $p->{base} || $class->base_dn( $p->{connect_key} ),
scope => $p->{scope} || 'sub' );
--- 198,203 ----
my ( $class, $p ) = @_;
my $ldap = $p->{ldap} || $class->global_datasource_handle( $p->{connect_key} );
! DEBUG && _w( 1, "Base DN (", $class->base_dn( $p->{connect_key} ), ")",
! "and filter <<$p->{filter}>> being used to fetch single object" );
my %args = ( base => $p->{base} || $class->base_dn( $p->{connect_key} ),
scope => $p->{scope} || 'sub' );
***************
*** 220,224 ****
}
if ( $count == 0 ) {
! DEBUG() && _wm( 1, DEBUG, "No entry found matching filter ($p->{filter})" );
return undef;
}
--- 218,222 ----
}
if ( $count == 0 ) {
! DEBUG && _w( 1, "No entry found matching filter ($p->{filter})" );
return undef;
}
***************
*** 243,247 ****
my ( $class, $p ) = @_;
require SPOPS::Iterator::LDAP;
! DEBUG() && _wm( 1, DEBUG, "Trying to create an Iterator with: ", Dumper( $p ) );
$p->{class} = $class;
( $p->{offset}, $p->{max} ) = $class->fetch_determine_limit( $p->{limit} );
--- 241,245 ----
my ( $class, $p ) = @_;
require SPOPS::Iterator::LDAP;
! DEBUG && _w( 1, "Trying to create an Iterator with: ", Dumper( $p ) );
$p->{class} = $class;
( $p->{offset}, $p->{max} ) = $class->fetch_determine_limit( $p->{limit} );
***************
*** 272,277 ****
: eval { $obj->check_action_security({ required => SEC_LEVEL_READ }) };
if ( $@ ) {
! DEBUG() && _wm( 1, DEBUG, "Security check for object (", $obj->dn, ")",
! "in fetch_group() failed, skipping." );
next ENTRY;
}
--- 270,275 ----
: eval { $obj->check_action_security({ required => SEC_LEVEL_READ }) };
if ( $@ ) {
! DEBUG && _w( 1, "Security check for object (", $obj->dn, ")",
! "in fetch_group() failed, skipping." );
next ENTRY;
}
***************
*** 305,314 ****
if ( ( my $fetch_oc = $class->ldap_fetch_object_class ) and $filter !~ /objectclass/ ) {
my $oc_filter = "(objectclass=$fetch_oc)";
! DEBUG() && _wm( 2, DEBUG, "Adding filter for object class ($fetch_oc)" );
$filter = ( $filter ) ? "(&$oc_filter$filter)" : $oc_filter;
}
my $ldap = $p->{ldap} || $class->global_datasource_handle( $p->{connect_key} );
! DEBUG() && _wm( 1, DEBUG, "Base DN (", $class->base_dn( $p->{connect_key} ), ")\nFilter <<$filter>>\n",
! "being used to fetch one or more objects" );
return $ldap->search( base => $class->base_dn( $p->{connect_key} ),
scope => 'sub',
--- 303,312 ----
if ( ( my $fetch_oc = $class->ldap_fetch_object_class ) and $filter !~ /objectclass/ ) {
my $oc_filter = "(objectclass=$fetch_oc)";
! DEBUG && _w( 2, "Adding filter for object class ($fetch_oc)" );
$filter = ( $filter ) ? "(&$oc_filter$filter)" : $oc_filter;
}
my $ldap = $p->{ldap} || $class->global_datasource_handle( $p->{connect_key} );
! DEBUG && _w( 1, "Base DN (", $class->base_dn( $p->{connect_key} ), ")\nFilter <<$filter>>\n",
! "being used to fetch one or more objects" );
return $ldap->search( base => $class->base_dn( $p->{connect_key} ),
scope => 'sub',
***************
*** 319,323 ****
sub _fetch_assign_row {
my ( $self, $field_list, $entry ) = @_;
! DEBUG() && _wm( 1, DEBUG, "Setting data from row into", ref $self, "using DN of entry ", $entry->dn );
$self->clear_all_loaded();
my $CONF = $self->CONFIG;
--- 317,321 ----
sub _fetch_assign_row {
my ( $self, $field_list, $entry ) = @_;
! DEBUG && _w( 1, "Setting data from row into", ref $self, "using DN of entry ", $entry->dn );
$self->clear_all_loaded();
my $CONF = $self->CONFIG;
***************
*** 327,335 ****
if ( $CONF->{multivalue}{ $field } ) {
$self->{ $field } = \@values;
! DEBUG() && _wm( 1, DEBUG, sprintf( " ( multi) %-20s --> %s", $field, join( '||', @values ) ) );
}
else {
$self->{ $field } = $values[0];
! DEBUG() && _wm( 1, DEBUG, sprintf( " (single) %-20s --> %s", $field, $values[0] ) );
}
$self->set_loaded( $field );
--- 325,333 ----
if ( $CONF->{multivalue}{ $field } ) {
$self->{ $field } = \@values;
! DEBUG && _w( 1, sprintf( " ( multi) %-20s --> %s", $field, join( '||', @values ) ) );
}
else {
$self->{ $field } = $values[0];
! DEBUG && _w( 1, sprintf( " (single) %-20s --> %s", $field, $values[0] ) );
}
$self->set_loaded( $field );
***************
*** 364,370 ****
$self->{tmp_security_level} = $security_level;
! DEBUG() && _wm( 1, DEBUG, ref $self, "(", $self->id, ") : cache set (if available),",
! "post_fetch_action() done, change flag cleared and save ",
! "flag set. Security: $security_level" );
return $self;
}
--- 362,368 ----
$self->{tmp_security_level} = $security_level;
! DEBUG && _w( 1, ref $self, "(", $self->id, ") : cache set (if available),",
! "post_fetch_action() done, change flag cleared and save ",
! "flag set. Security: $security_level" );
return $self;
}
***************
*** 378,382 ****
my ( $self, $p ) = @_;
my $id = $self->id;
! DEBUG && _wm( 1, DEBUG, "Trying to save a (", ref $self, ") with ID ($id)" );
# We can force save() to be an INSERT by passing in a true value
--- 376,380 ----
my ( $self, $p ) = @_;
my $id = $self->id;
! DEBUG && _w( 1, "Trying to save a (", ref $self, ") with ID ($id)" );
# We can force save() to be an INSERT by passing in a true value
***************
*** 390,394 ****
unless ( $is_add or $self->changed ) {
! DEBUG && _wm( 1, DEBUG, "This object exists and has not changed. Exiting." );
return $self;
}
--- 388,392 ----
unless ( $is_add or $self->changed ) {
! DEBUG && _w( 1, "This object exists and has not changed. Exiting." );
return $self;
}
***************
*** 401,405 ****
is_add => $is_add });
}
! DEBUG && _wm( 1, DEBUG, "Security check passed ok. Continuing." );
# Callback for objects to do something before they're saved
--- 399,403 ----
is_add => $is_add });
}
! DEBUG && _w( 1, "Security check passed ok. Continuing." );
# Callback for objects to do something before they're saved
***************
*** 418,422 ****
return undef unless ( $self->post_save_action({ %{ $p },
is_add => $is_add }) );
! DEBUG() && _wm( 1, DEBUG, "Post save action executed ok." );
# Save the newly-created/updated object to the cache
--- 416,420 ----
return undef unless ( $self->post_save_action({ %{ $p },
is_add => $is_add }) );
! DEBUG && _w( 1, "Post save action executed ok." );
# Save the newly-created/updated object to the cache
***************
*** 442,446 ****
my ( $self, $p ) = @_;
$p ||= {};
! DEBUG && _wm( 1, DEBUG, 'Treating save as INSERT' );
my $ldap = $p->{ldap} || $self->global_datasource_handle( $p->{connect_key} );
$self->dn( $self->build_dn );
--- 440,444 ----
my ( $self, $p ) = @_;
$p ||= {};
! DEBUG && _w( 1, 'Treating save as INSERT' );
my $ldap = $p->{ldap} || $self->global_datasource_handle( $p->{connect_key} );
$self->dn( $self->build_dn );
***************
*** 449,456 ****
if ( $num_objectclass == 0 ) {
$self->{objectclass} = $self->ldap_object_class;
! DEBUG() && _wm( 1, DEBUG, "Using object class from config in new object (",
! join( ', ', @{ $self->{objectclass} } ), ")" );
}
! DEBUG && _wm( 1, DEBUG, "Trying to create record with DN: (", $self->dn, ")" );
my %insert_data = ();
my $no_insert = $self->no_insert;
--- 447,454 ----
if ( $num_objectclass == 0 ) {
$self->{objectclass} = $self->ldap_object_class;
! DEBUG && _w( 1, "Using object class from config in new object (",
! join( ', ', @{ $self->{objectclass} } ), ")" );
}
! DEBUG && _w( 1, "Trying to create record with DN: (", $self->dn, ")" );
my %insert_data = ();
my $no_insert = $self->no_insert;
***************
*** 467,475 ****
}
}
! DEBUG() && _wm( 1, DEBUG, "Trying to create a record with:\n", Dumper( \%insert_data ) );
my $ldap_msg = $ldap->add( dn => $self->dn,
attr => [ %insert_data ]);
$self->_check_error( $ldap_msg, 'Cannot create new LDAP record' );
! DEBUG() && _wm( 1, DEBUG, "Record created ok." );
}
--- 465,473 ----
}
}
! DEBUG && _w( 1, "Trying to create a record with:\n", Dumper( \%insert_data ) );
my $ldap_msg = $ldap->add( dn => $self->dn,
attr => [ %insert_data ]);
$self->_check_error( $ldap_msg, 'Cannot create new LDAP record' );
! DEBUG && _w( 1, "Record created ok." );
}
***************
*** 478,486 ****
my ( $self, $p ) = @_;
$p ||= {};
! DEBUG() && _wm( 1, DEBUG, "Treating save as UPDATE with DN: (", $self->dn, ")" );
my $ldap = $p->{ldap} || $self->global_datasource_handle( $p->{connect_key} );
my $entry = $self->_fetch_single_entry({ filter => $self->create_id_filter,
ldap => $ldap });
! DEBUG() && _wm( 1, DEBUG, "Loaded entry for update:\n", Dumper( $entry ) );
my $no_update = $self->no_update;
my $only_changed = $self->ldap_update_only_changed;
--- 476,484 ----
my ( $self, $p ) = @_;
$p ||= {};
! DEBUG && _w( 1, "Treating save as UPDATE with DN: (", $self->dn, ")" );
my $ldap = $p->{ldap} || $self->global_datasource_handle( $p->{connect_key} );
my $entry = $self->_fetch_single_entry({ filter => $self->create_id_filter,
ldap => $ldap });
! DEBUG && _w( 1, "Loaded entry for update:\n", Dumper( $entry ) );
my $no_update = $self->no_update;
my $only_changed = $self->ldap_update_only_changed;
***************
*** 491,499 ****
if ( $only_changed ) {
my @existing_values = $entry->get_value( $attr );
! DEBUG() && _wm( 1, DEBUG, "Toggle for updating only changed values set.",
! "Checking if ($attr) different: ", Dumper( $object_value ),
! "vs.", Dumper( \@existing_values ) );
next ATTRIB if ( $self->_values_are_same( $object_value, \@existing_values ) );
! DEBUG() && _wm( 1, DEBUG, "Values for ($attr) are different. Updating..." );
}
--- 489,497 ----
if ( $only_changed ) {
my @existing_values = $entry->get_value( $attr );
! DEBUG && _w( 1, "Toggle for updating only changed values set.",
! "Checking if ($attr) different: ", Dumper( $object_value ),
! "vs.", Dumper( \@existing_values ) );
next ATTRIB if ( $self->_values_are_same( $object_value, \@existing_values ) );
! DEBUG && _w( 1, "Values for ($attr) are different. Updating..." );
}
***************
*** 506,513 ****
$entry->replace( $attr, $object_value );
}
! DEBUG() && _wm( 1, DEBUG, "Entry before Update:\n", Dumper( $entry ) );
my $ldap_msg = $entry->update( $ldap );
$self->_check_error( $ldap_msg, 'Cannot update existing record' );
! DEBUG() && _wm( 1, DEBUG, "Record updated ok." );
}
--- 504,511 ----
$entry->replace( $attr, $object_value );
}
! DEBUG && _w( 1, "Entry before Update:\n", Dumper( $entry ) );
my $ldap_msg = $entry->update( $ldap );
$self->_check_error( $ldap_msg, 'Cannot update existing record' );
! DEBUG && _w( 1, "Record updated ok." );
}
***************
*** 547,551 ****
}
! DEBUG && _wm( 1, DEBUG, "Security check passed ok. Continuing." );
# Allow members to perform an action before getting removed
--- 545,549 ----
}
! DEBUG && _w( 1, "Security check passed ok. Continuing." );
# Allow members to perform an action before getting removed
|
|
From: Chris W. <la...@us...> - 2001-10-23 14:21:45
|
Update of /cvsroot/openinteract/SPOPS/SPOPS/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv26641
Modified Files:
MultiDatasource.pm
Log Message:
every object retrieved is tagged with its datasource in {_datasource},
and calls to save() and remove() first retrieve the datasource before
performing the action
Index: MultiDatasource.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/LDAP/MultiDatasource.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** MultiDatasource.pm 2001/10/12 21:00:26 1.7
--- MultiDatasource.pm 2001/10/23 14:21:42 1.8
***************
*** 4,7 ****
--- 4,8 ----
use strict;
+ use SPOPS qw( DEBUG _w );
use SPOPS::LDAP;
***************
*** 58,61 ****
--- 59,64 ----
unless ( ref $ds_list eq 'ARRAY' and scalar @{ $ds_list } ) {
+ DEBUG && _w( 1, "No datasources in configuration for ($class).",
+ "Using SPOPS::LDAP->fetch()" );
return $class->SUPER::fetch( $id, $p );
}
***************
*** 72,76 ****
my $object = eval { $class->SUPER::fetch( $id, $p ) };
! return $object if ( $object );
}
return undef;
--- 75,82 ----
my $object = eval { $class->SUPER::fetch( $id, $p ) };
! if ( $object ) {
! $object->{_datasource} = $ds;
! return $object;
! }
}
return undef;
***************
*** 86,89 ****
--- 92,97 ----
my $ds_list = $class->CONFIG->{datasource};
unless ( ref $ds_list eq 'ARRAY' and scalar @{ $ds_list } ) {
+ DEBUG && _w( 1, "No datasources in configuration for ($class).",
+ "Using SPOPS::LDAP->fetch_group()" );
return $class->SUPER::fetch_group( $p );
}
***************
*** 91,100 ****
foreach my $ds ( @{ $ds_list } ) {
$p->{connect_key} = $ds;
my $object_list = $class->SUPER::fetch_group( $p );
! push @all_objects, @{ $object_list } if ( $object_list and ref $object_list eq 'ARRAY' );
}
return \@all_objects;
}
1;
--- 99,132 ----
foreach my $ds ( @{ $ds_list } ) {
$p->{connect_key} = $ds;
+ DEBUG && _w( 1, "Trying to fetch from datasource ($ds)" );
my $object_list = $class->SUPER::fetch_group( $p );
! if ( $object_list and ref $object_list eq 'ARRAY' ) {
! foreach my $object ( @{ $object_list } ) {
! $object->{_datasource} = $ds;
! push @all_objects, $object;
! }
! }
}
return \@all_objects;
}
+
+ # Just be sure we grab the right LDAP handle before saving or removing
+ # -- if people pass in a handle, we'll defer to their judgement that
+ # they know what they're doing
+
+ sub save {
+ my ( $self, $p ) = @_;
+ $p->{ldap} ||= $self->global_datasource_handle( $self->{_datasource} );
+ return $self->SUPER::save( $p );
+ }
+
+
+ sub remove {
+ my ( $self, $p ) = @_;
+ $p->{ldap} ||= $self->global_datasource_handle( $self->{_datasource} );
+ return $self->SUPER::remove( $p );
+ }
+
1;
***************
*** 111,118 ****
# In your configuration
my $config = {
datasource => [ 'main', 'secondary', 'tertiary' ],
! isa => [ ... 'SPOPS::LDAP::MultiDatasource' ],
};
=head1 DESCRIPTION
--- 143,156 ----
# In your configuration
my $config = {
+ class => 'My::LDAPThings',
datasource => [ 'main', 'secondary', 'tertiary' ],
! isa => [ ... 'SPOPS::LDAP::MultiDatasource' ],
};
+ # Fetch an object and see where it came from
+
+ my $object = My::LDAPThings->fetch( 'superuser' );
+ print "My DN is ", $object->dn, " and I came from $object->{_datasource}";
+
=head1 DESCRIPTION
***************
*** 124,127 ****
--- 162,170 ----
see below) link the two LDAP servers.
+ Every object is tagged with the datasource it came from (in the
+ C<_datasource> property, if you ever need it), and any calls to
+ C<save()> or C<remove()> will use this datasource to retrieve the
+ proper connection for the object.
+
=head2 Caveats
***************
*** 284,287 ****
--- 327,340 ----
Returns: Arrayref of SPOPS objects.
+ B<save( \%params )>
+
+ Just pass along the right handle to the actual C<save()> method in
+ L<SPOPS::LDAP|SPOPS::LDAP>.
+
+ B<remove( \%params )>
+
+ Just pass along the right handle to the actual C<remove()> method in
+ L<SPOPS::LDAP|SPOPS::LDAP>.
+
B<base_dn( $connect_key )>
***************
*** 309,312 ****
--- 362,367 ----
L<SPOPS::LDAP|SPOPS::LDAP>
+
+ Example in SPOPS distribution: eg/ldap_multidatasource.pl
=head1 COPYRIGHT
|
|
From: Chris W. <la...@us...> - 2001-10-23 12:19:32
|
Update of /cvsroot/openinteract/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv7026
Modified Files:
SPOPS.pm
Log Message:
updated clone() to rely on the initialization provided by new()
Index: SPOPS.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -C2 -d -r1.52 -r1.53
*** SPOPS.pm 2001/10/22 15:21:44 1.52
--- SPOPS.pm 2001/10/23 12:19:29 1.53
***************
*** 15,19 ****
@SPOPS::ISA = qw( Exporter Storable );
@SPOPS::EXPORT_OK = qw( _w _wm DEBUG );
! $SPOPS::VERSION = '0.51';
$SPOPS::Revision = substr(q$Revision$, 10);
--- 15,19 ----
@SPOPS::ISA = qw( Exporter Storable );
@SPOPS::EXPORT_OK = qw( _w _wm DEBUG );
! $SPOPS::VERSION = '0.51a';
$SPOPS::Revision = substr(q$Revision$, 10);
***************
*** 174,188 ****
DEBUG() && _w( 1, "Cloning new object of class ($class) from old ",
"object of class (", ref $self, ")" );
! my $clone = $class->new;
my $id_field = $class->id_field;
! if ( $id_field ) {
! my $new_id = $p->{ $id_field } || $p->{id};
! $clone->{ $id_field } = $new_id if ( $new_id );
! }
while ( my ( $k, $v ) = each %{ $self } ) {
next if ( $id_field and $k eq $id_field );
! $clone->{ $k } = $p->{ $k } || $v;
}
! return $clone;
}
--- 174,187 ----
DEBUG() && _w( 1, "Cloning new object of class ($class) from old ",
"object of class (", ref $self, ")" );
! my %initial_data = ();
my $id_field = $class->id_field;
! $initial_data{ $id_field } = $p->{ $id_field } || $p->{id};
!
while ( my ( $k, $v ) = each %{ $self } ) {
next if ( $id_field and $k eq $id_field );
! $initial_data{ $k } = $p->{ $k } || $v;
}
!
! return $class->new({ %initial_data, skip_default_values => 1 });
}
|
|
From: Chris W. <la...@us...> - 2001-10-23 12:16:04
|
Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv5608
Modified Files:
GDBM.pm
Log Message:
changes to new(), initialize() failed some tests; working now
Index: GDBM.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/GDBM.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** GDBM.pm 2001/10/22 11:50:00 1.14
--- GDBM.pm 2001/10/23 12:16:01 1.15
***************
*** 36,40 ****
# Dummy for subclasses to override
! sub _class_initialize { return 1; }
# Override the default SPOPS initialize call so we can use mixed-case
--- 36,40 ----
# Dummy for subclasses to override
! sub _class_initialize { return 1 }
# Override the default SPOPS initialize call so we can use mixed-case
***************
*** 60,69 ****
}
! # Use all lowercase to allow people to give us fieldnames in mixed
! # case (we are very nice)
! my %data = map { lc $_ => $p->{ $_ } } keys %{ $p };
! foreach my $key ( keys %data ) {
! $self->{ $key } = $data{ $key };
}
return $self;
--- 60,69 ----
}
! # Go through the field list and set any that are passed in
! foreach my $field ( @{ $self->field_list } ) {
! next unless ( $p->{ $field } );
! $self->{ $field } = $p->{ $field };
! DEBUG && _w( 2, "Initialized ($field) to ($self->{ $field })" );
}
return $self;
***************
*** 72,76 ****
# Override this to get the db handle from somewhere else, if necessary
! sub global_gdbm_tie {
my ( $item, $p ) = @_;
return $p->{db} if ( ref $p->{db} );
--- 72,78 ----
# Override this to get the db handle from somewhere else, if necessary
! sub global_gdbm_tie { my $item = shift; return $item->global_datasource_handle( @_ ) }
!
! sub global_datasource_handle {
my ( $item, $p ) = @_;
return $p->{db} if ( ref $p->{db} );
***************
*** 88,92 ****
$gdbm_filename ||= $item->global_config->{gdbm_info}{filename};
}
! DEBUG() && _w( 1, "Trying file $gdbm_filename to connect" );
unless ( $gdbm_filename ) {
die "Insufficient/incorrect information to tie to GDBM file! ($gdbm_filename)\n";
--- 90,94 ----
$gdbm_filename ||= $item->global_config->{gdbm_info}{filename};
}
! DEBUG() && _w( 1, "Trying file ($gdbm_filename) to connect" );
unless ( $gdbm_filename ) {
die "Insufficient/incorrect information to tie to GDBM file! ($gdbm_filename)\n";
***************
*** 121,124 ****
--- 123,127 ----
}
+
sub object_key {
my ( $self, $id ) = @_;
***************
*** 126,137 ****
die "Cannot create object key without object or id!\n" unless ( $id );
my $class = ref $self || $self;
! return join '--', $class, $id;
}
# Given a key, return the data structure from the db file
sub _return_structure_for_key {
my ( $class, $key, $p ) = @_;
! my $db = $class->global_gdbm_tie( $p );
my $item_info = $db->{ $key };
return undef unless ( $item_info );
--- 129,141 ----
die "Cannot create object key without object or id!\n" unless ( $id );
my $class = ref $self || $self;
! return join( '--', $class, $id );
}
+
# Given a key, return the data structure from the db file
sub _return_structure_for_key {
my ( $class, $key, $p ) = @_;
! my $db = $class->global_datasource_handle( $p );
my $item_info = $db->{ $key };
return undef unless ( $item_info );
***************
*** 145,159 ****
}
# Retreive an object
sub fetch {
my ( $class, $id, $p ) = @_;
my $data = $p->{data} || {};
! unless ( $data ) {
return undef unless ( $id and $id !~ /^tmp/ );
return undef unless ( $class->pre_fetch_action( { id => $id } ) );
$data = $class->_return_structure_for_key( $class->object_key( $id ),
! { filename => $p->{filename},
directory => $p->{directory} } );
}
my $obj = $class->new({ %{ $data }, skip_default_values => 1 });
--- 149,166 ----
}
+
# Retreive an object
sub fetch {
my ( $class, $id, $p ) = @_;
+ DEBUG && _w( 2, "Trying to fetch ID ($id)" );
my $data = $p->{data} || {};
! unless ( scalar keys %{ $data } ) {
return undef unless ( $id and $id !~ /^tmp/ );
return undef unless ( $class->pre_fetch_action( { id => $id } ) );
$data = $class->_return_structure_for_key( $class->object_key( $id ),
! { filename => $p->{filename},
directory => $p->{directory} } );
+ DEBUG && _w( 2, "Returned data from GDBM: ", Dumper( $data ) );
}
my $obj = $class->new({ %{ $data }, skip_default_values => 1 });
***************
*** 167,171 ****
sub fetch_group {
my ( $item, $p ) = @_;
! my $db = $item->global_gdbm_tie( $p );
my $class = ref $item || $item;
DEBUG() && _w( 1, "Trying to find keys beginning with ($class)" );
--- 174,178 ----
sub fetch_group {
my ( $item, $p ) = @_;
! my $db = $item->global_datasource_handle( $p );
my $class = ref $item || $item;
DEBUG() && _w( 1, "Trying to find keys beginning with ($class)" );
***************
*** 204,208 ****
my $obj_index = $self->object_key;
! my $db = $self->global_gdbm_tie( $p );
$db->{ $obj_index } = $obj_string;
--- 211,215 ----
my $obj_index = $self->object_key;
! my $db = $self->global_datasource_handle( $p );
$db->{ $obj_index } = $obj_string;
***************
*** 217,221 ****
my ( $self, $p ) = @_;
my $obj_index = $self->object_key;
! my $db = $self->global_gdbm_tie({ perm => 'write', %{ $p } });
$self->clear_change;
$self->clear_save;
--- 224,228 ----
my ( $self, $p ) = @_;
my $obj_index = $self->object_key;
! my $db = $self->global_datasource_handle({ perm => 'write', %{ $p } });
$self->clear_change;
$self->clear_save;
***************
*** 243,261 ****
Implements SPOPS persistence in a GDBM database. Currently the
! interface is not as robust or powerful as the C<SPOPS::DBI>
implementation, but if you want more robust data storage, retrieval
! and searching needs you should probably be using a SQL database anyway.
! This is also a little different than the C<SPOPS::DBI> module in that
! you have a little more flexibility as to how you refer to the actual
! GDBM file required. Instead of defining one database throughout the
! operation, you can change in midstream. (To be fair, you can also do
! this with the C<SPOPS::DBI> module, it is just a little more
! difficult.) For example:
# Read objects from one database, save to another
! my @objects = Object::Class->fetch_group( { filename => '/tmp/object_old.gdbm' } );
foreach my $obj ( @objects ) {
! $obj->save( { is_add => 1, gdbm_filename => '/tmp/object_new.gdbm' } );
}
--- 250,269 ----
Implements SPOPS persistence in a GDBM database. Currently the
! interface is not as robust or powerful as the L<SPOPS::DBI|SPOPS::DBI>
implementation, but if you want more robust data storage, retrieval
! and searching needs you should probably be using a SQL database
! anyway.
! This is also a little different than the L<SPOPS::DBI|SPOPS::DBI>
! module in that you have a little more flexibility as to how you refer
! to the actual GDBM file required. Instead of defining one database
! throughout the operation, you can change in midstream. (To be fair,
! you can also do this with the L<SPOPS::DBI|SPOPS::DBI> module, it is
! just a little more difficult.) For example:
# Read objects from one database, save to another
! my @objects = Object::Class->fetch_group({ filename => '/tmp/object_old.gdbm' });
foreach my $obj ( @objects ) {
! $obj->save({ is_add => 1, gdbm_filename => '/tmp/object_new.gdbm' });
}
***************
*** 280,287 ****
my $obj = Object::Class->new( { GDBM_FILENAME = '/tmp/mydata.gdbm' } );
! B<global_gdbm_tie( \%params )>
Returns a tied hashref if successful.
There are many different ways of creating a filename used for
GDBM. You can define a default filename in your package configuration;
--- 288,298 ----
my $obj = Object::Class->new( { GDBM_FILENAME = '/tmp/mydata.gdbm' } );
! B<global_datasource_handle( \%params )>
Returns a tied hashref if successful.
+ Note: This is renamed from C<global_gdbm_tie()>. The old method will
+ still work for a while.
+
There are many different ways of creating a filename used for
GDBM. You can define a default filename in your package configuration;
***************
*** 304,311 ****
'read', 'write', or 'create' instead of these constants.
! If you pass nothing, C<SPOPS::GDBM> will assume 'read'. Also note that
! on some GDBM implementations, specifying 'write' permission to a file
! that has not yet been created still creates it, so 'create' might be
! redundant on your system.
B<filename> ($) (optional)
--- 315,322 ----
'read', 'write', or 'create' instead of these constants.
! If you pass nothing, L<SPOPS::GDBM|SPOPS::GDBM> will assume
! 'read'. Also note that on some GDBM implementations, specifying
! 'write' permission to a file that has not yet been created still
! creates it, so 'create' might be redundant on your system.
B<filename> ($) (optional)
|
|
From: Chris W. <la...@us...> - 2001-10-23 12:15:36
|
Update of /cvsroot/openinteract/SPOPS/t
In directory usw-pr-cvs1:/tmp/cvs-serv5480
Modified Files:
20_gdbm.t
Log Message:
changes to new(), initialize() failed some tests; working now
Index: 20_gdbm.t
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/t/20_gdbm.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** 20_gdbm.t 2001/09/12 14:00:10 1.2
--- 20_gdbm.t 2001/10/23 12:15:33 1.3
***************
*** 4,8 ****
use strict;
-
use constant GDBM_FILE => 't/test.gdbm';
use constant NUM_TESTS => 15;
--- 4,7 ----
***************
*** 10,15 ****
sub cleanup { unlink GDBM_FILE }
sub new_object {
! eval { GDBMTest->new({ name => 'MyProject',
! version => 1.14,
author => 'La Choy (la...@cw...)' }) };
}
--- 9,15 ----
sub cleanup { unlink GDBM_FILE }
sub new_object {
! eval { GDBMTest->new({ name => 'MyProject',
! version => 1.14,
! url => 'http://www.cwinters.com/',
author => 'La Choy (la...@cw...)' }) };
}
***************
*** 111,119 ****
my $obj = eval { GDBMTest->fetch( 'MyProject-1.14' ) };
ok( ! $@, 'Fetch object' );
! ok( $obj->{name} eq 'MyProject', 'Fetch object (content check)' );
my $new_obj = eval { $obj->clone({ name => 'YourProject', version => 1.02 }) };
ok( ! $@, 'Clone object' );
! ok( $new_obj->{name} ne $obj->{name}, 'Clone object (override content)' );
eval { $new_obj->save };
--- 111,119 ----
my $obj = eval { GDBMTest->fetch( 'MyProject-1.14' ) };
ok( ! $@, 'Fetch object' );
! is( $obj->{name}, 'MyProject', 'Fetch object (content check)' );
my $new_obj = eval { $obj->clone({ name => 'YourProject', version => 1.02 }) };
ok( ! $@, 'Clone object' );
! isnt( $new_obj->{name}, $obj->{name}, 'Clone object (override content)' );
eval { $new_obj->save };
|
|
From: Chris W. <la...@us...> - 2001-10-23 02:38:41
|
Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv31422
Modified Files:
DBI.pm
Log Message:
ensure we access the type info with lowercased fields
Index: DBI.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/DBI.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -C2 -d -r1.52 -r1.53
*** DBI.pm 2001/10/22 11:50:00 1.52
--- DBI.pm 2001/10/23 02:38:38 1.53
***************
*** 169,173 ****
? $id_field
: join( '.', $item->table_name, $id_field );
! return join(' = ', $use_id_field, $db->quote( $id, $type_info->{ $id_field } ) );
}
--- 169,173 ----
? $id_field
: join( '.', $item->table_name, $id_field );
! return join(' = ', $use_id_field, $db->quote( $id, $type_info->{ lc $id_field } ) );
}
***************
*** 303,307 ****
ROW:
while ( my $row = $sth->fetchrow_arrayref ) {
! my $obj = $class->new;
$obj->_fetch_assign_row( $p->{raw_fields}, $row, $p );
next ROW unless ( $obj );
--- 303,307 ----
ROW:
while ( my $row = $sth->fetchrow_arrayref ) {
! my $obj = $class->new({ skip_default_values => 1 });
$obj->_fetch_assign_row( $p->{raw_fields}, $row, $p );
next ROW unless ( $obj );
***************
*** 352,358 ****
my @select = ();
for ( my $i = 0; $i < scalar @{ $raw_fields }; $i++ ) {
! push @select, ( $raw_fields->[ $i ] eq $select_fields->[ $i ] )
! ? join( '.', $table_name, $raw_fields->[ $i ] )
! : $select_fields->[ $i ];
}
return ( $raw_fields, \@select );
--- 352,364 ----
my @select = ();
for ( my $i = 0; $i < scalar @{ $raw_fields }; $i++ ) {
! if ( $raw_fields->[ $i ] ne $select_fields->[ $i ] ) {
! push @select, $select_fields->[ $i ];
! }
! elsif ( $raw_fields->[ $i ] =~ /^$table_name/ ) {
! push @select, $select_fields->[ $i ];
! }
! else {
! push @select, join( '.', $table_name, $raw_fields->[ $i ] );
! }
}
return ( $raw_fields, \@select );
|
|
From: Chris W. <la...@us...> - 2001-10-23 02:34:07
|
Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv30265
Modified Files:
SQLInterface.pm
Log Message:
ensure we keep the type information in all lower-case
Index: SQLInterface.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/SQLInterface.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** SQLInterface.pm 2001/10/12 21:00:26 1.25
--- SQLInterface.pm 2001/10/23 02:34:03 1.26
***************
*** 275,285 ****
foreach my $field ( @{ $p->{field} } ) {
next unless ( $field );
! $DEBUG && _wm( 1, $DEBUG, "Trying to add value <<$p->{value}->[$count]>> with ",
! "field <<$field>> and type info <<$type_info->{ $field }>>" );
# Quote the value unless the user asked us not to
my $value = ( $p->{no_quote}{ $field } )
? $p->{value}->[ $count ]
! : $class->sql_quote( $p->{value}->[ $count ], $type_info->{ $field }, $db );
push @value_list, $value;
$count++;
--- 275,286 ----
foreach my $field ( @{ $p->{field} } ) {
next unless ( $field );
! $DEBUG && _wm( 1, $DEBUG, "Trying to add value ($p->{value}->[$count]) with ",
! "field <<$field>> and type info ($type_info->{ lc $field })" );
# Quote the value unless the user asked us not to
my $value = ( $p->{no_quote}{ $field } )
? $p->{value}->[ $count ]
! : $class->sql_quote( $p->{value}->[ $count ],
! $type_info->{ lc $field }, $db );
push @value_list, $value;
$count++;
***************
*** 370,375 ****
$p->{no_quote} ||= {};
foreach my $field ( @{ $p->{field} } ) {
! $DEBUG && _wm( 1, $DEBUG, "Trying to add value <<$p->{value}->[$count]>> with ",
! "field <<$field>> and type info <<$type_info->{ $field }>>" );
# Quote the value unless the user asked us not to
--- 371,376 ----
$p->{no_quote} ||= {};
foreach my $field ( @{ $p->{field} } ) {
! $DEBUG && _wm( 1, $DEBUG, "Trying to add value ($p->{value}->[$count]) with ",
! "field ($field) and type info ($type_info->{ lc $field })" );
# Quote the value unless the user asked us not to
***************
*** 377,381 ****
my $value = ( $p->{no_quote}{ $field } )
? $p->{value}->[ $count ]
! : $class->sql_quote( $p->{value}->[ $count ], $type_info->{ $field }, $db );
push @update, "$field = $value";
$count++;
--- 378,382 ----
my $value = ( $p->{no_quote}{ $field } )
? $p->{value}->[ $count ]
! : $class->sql_quote( $p->{value}->[ $count ], $type_info->{ lc $field }, $db );
push @update, "$field = $value";
$count++;
***************
*** 469,473 ****
my $db = $p->{db} || $class->global_datasource_handle;
my $type_idx = join( '-', lc $db->{Name}, lc $table );
! $DEBUG && _wm( 2, $DEBUG, "Type index used to discover data types: $type_idx" );
# If we've already discovered the types, get the cached copy
--- 470,474 ----
my $db = $p->{db} || $class->global_datasource_handle;
my $type_idx = join( '-', lc $db->{Name}, lc $table );
! $DEBUG && _wm( 2, $DEBUG, "Type index used to discover data types: ($type_idx)" );
# If we've already discovered the types, get the cached copy
***************
*** 491,495 ****
foreach my $field ( keys %{ $dbi_info } ) {
DEBUG() && _w( 1, "Set $field: $dbi_info->{ $field }" );
! $TYPE_INFO{ $type_idx }{ $field } = $dbi_info->{ $field };
}
return $TYPE_INFO{ $type_idx };
--- 492,496 ----
foreach my $field ( keys %{ $dbi_info } ) {
DEBUG() && _w( 1, "Set $field: $dbi_info->{ $field }" );
! $TYPE_INFO{ $type_idx }{ lc $field } = $dbi_info->{ $field };
}
return $TYPE_INFO{ $type_idx };
***************
*** 523,527 ****
DEBUG() && _w( 1, "List of fields: ", join( ", ", @{ $fields } ) );
for ( my $i = 0; $i < scalar @{ $fields }; $i++ ) {
! $TYPE_INFO{ $type_idx }{ $fields->[ $i ] } = $types->[ $i ];
}
return $TYPE_INFO{ $type_idx };
--- 524,528 ----
DEBUG() && _w( 1, "List of fields: ", join( ", ", @{ $fields } ) );
for ( my $i = 0; $i < scalar @{ $fields }; $i++ ) {
! $TYPE_INFO{ $type_idx }{ lc $fields->[ $i ] } = $types->[ $i ];
}
return $TYPE_INFO{ $type_idx };
|
|
From: Chris W. <la...@us...> - 2001-10-22 15:22:47
|
Update of /cvsroot/openinteract/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv5985
Modified Files:
Changes
Log Message:
latest changes
Index: Changes
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/Changes,v
retrieving revision 1.66
retrieving revision 1.67
diff -C2 -d -r1.66 -r1.67
*** Changes 2001/10/22 06:27:50 1.66
--- Changes 2001/10/22 15:22:45 1.67
***************
*** 15,18 ****
--- 15,31 ----
information for a particular record to use as defaults.
+ * SPOPS.pm
+
+ - Enable default values to be set via the object configuration
+ (or dynamically, via ClassFactory) that are used to fill up an
+ object created with new(). You can also use the key 'NOW' to
+ specify the current date/time or a class and method to deal with
+ more complicated tasks.
+
+ (Accompanying this, modified all implementations -- DBI, LDAP and
+ GDBM -- plus the iterators -- DBI and GDBM -- to pass a
+ 'skip_default_values => 1' when creating a new object to be
+ filled with a fetch() or fetch_group().)
+
* SPOPS/DBI/MySQL.pm:
|
|
From: Chris W. <la...@us...> - 2001-10-22 15:21:46
|
Update of /cvsroot/openinteract/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv5315
Modified Files:
SPOPS.pm
Log Message:
updated default_values to accept the key 'NOW' and to deal with a
class/method being defined in a hashref that will return the default
(me today speak english good)
Index: SPOPS.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -C2 -d -r1.51 -r1.52
*** SPOPS.pm 2001/10/22 05:42:37 1.51
--- SPOPS.pm 2001/10/22 15:21:44 1.52
***************
*** 4,13 ****
use strict;
! use Data::Dumper qw( Dumper );
require Exporter;
use SPOPS::Error;
! use SPOPS::Tie qw( IDX_CHANGE IDX_SAVE IDX_CHECK_FIELDS IDX_LAZY_LOADED );
! use SPOPS::Secure qw( SEC_LEVEL_WRITE );
! use Storable qw( store retrieve nstore );
$SPOPS::AUTOLOAD = '';
--- 4,14 ----
use strict;
! use Data::Dumper qw( Dumper );
require Exporter;
use SPOPS::Error;
! use SPOPS::Tie qw( IDX_CHANGE IDX_SAVE IDX_CHECK_FIELDS IDX_LAZY_LOADED );
! use SPOPS::Secure qw( SEC_LEVEL_WRITE );
! use SPOPS::Utility qw();
! use Storable qw( store retrieve nstore );
$SPOPS::AUTOLOAD = '';
***************
*** 116,124 ****
}
- my ( %data );
-
DEBUG() && _w( 1, "Creating new object of class ($class) with tie class ",
"($tie_class); lazy loading ($params->{is_lazy_load});",
"field mapping ($params->{is_field_map})" );
my $int = tie %data, $tie_class, $class, $params;
DEBUG() && _w( 4, "Internal tie structure of new object: ", Dumper( $int ) );
--- 117,125 ----
}
DEBUG() && _w( 1, "Creating new object of class ($class) with tie class ",
"($tie_class); lazy loading ($params->{is_lazy_load});",
"field mapping ($params->{is_field_map})" );
+
+ my ( %data );
my $int = tie %data, $tie_class, $class, $params;
DEBUG() && _w( 4, "Internal tie structure of new object: ", Dumper( $int ) );
***************
*** 129,133 ****
my $defaults = $p->{default_values} || $CONFIG->{default_values};
if ( ref $defaults eq 'HASH' and ! $p->{skip_default_values} ) {
! map { $data{ $_ } = $defaults->{ $_ } } keys %{ $defaults };
}
--- 130,155 ----
my $defaults = $p->{default_values} || $CONFIG->{default_values};
if ( ref $defaults eq 'HASH' and ! $p->{skip_default_values} ) {
! foreach my $field ( keys %{ $defaults } ) {
! if ( ref $defaults->{ $field } eq 'HASH' ) {
! my $default_class = $defaults->{ $field }{class};
! my $default_method = $defaults->{ $field }{method};
! unless ( $default_class and $default_method ) {
! _w( 0, "Cannot set default for ($field) without a class ",
! "AND method being defined." );
! next;
! }
! $self->{ $field } = eval { $default_class->$default_method( $field ) };
! if ( $@ ) {
! _w( 0, "Cannot set default for ($field) in ($class) using",
! "($default_class) ($default_method): $@" );
! }
! }
! elsif ( $defaults->{ $field } eq 'NOW' ) {
! $self->{ $field } = SPOPS::Utility->now;
! }
! else {
! $self->{ $field } = $defaults->{ $field };
! }
! }
}
***************
*** 849,852 ****
--- 871,885 ----
object is initialized with C<new()>.
+ Normally the values of the hashref are the defaults to which you want
+ to set the fields. However, there are two special cases of values:
+
+ B<'NOW'> This string will insert the current timestamp in the format
+ C<yyyy-mm-dd hh:mm:ss>.
+
+ B<\%> A hashref with the keys 'class' and 'method' will get executed
+ as a class method and be passed the name of the field for which we
+ want a default. The method should return the default value for this
+ field.
+
One problem with setting default values in your object configuration
B<and> in your database is that the two may become unsynchronized,
***************
*** 1578,1579 ****
--- 1611,1613 ----
=cut
+ <
|
|
From: Chris W. <la...@us...> - 2001-10-22 15:19:08
|
Update of /cvsroot/openinteract/SPOPS/doc/Manual In directory usw-pr-cvs1:/tmp/cvs-serv3785 Modified Files: Configuration.pod Log Message: updated default_values info Index: Configuration.pod =================================================================== RCS file: /cvsroot/openinteract/SPOPS/doc/Manual/Configuration.pod,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Configuration.pod 2001/10/22 05:40:57 1.7 --- Configuration.pod 2001/10/22 15:19:05 1.8 *************** *** 95,98 **** --- 95,109 ---- object is initialized with C<new()>. + Normally the values of the hashref are the defaults to which you want + to set the fields. However, there are two special cases of values: + + B<'NOW'> This string will insert the current timestamp in the format + C<yyyy-mm-dd hh:mm:ss>. + + B<\%> A hashref with the keys 'class' and 'method' will get executed + as a class method and be passed the name of the field for which we + want a default. The method should return the default value for this + field. + One problem with setting default values in your object configuration B<and> in your database is that the two may become unsynchronized, |
|
From: Chris W. <la...@us...> - 2001-10-22 15:13:06
|
Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv2013
Modified Files:
Utility.pm
Log Message:
added version of now() with Class::Date
Index: Utility.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/Utility.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Utility.pm 2001/10/12 21:00:26 1.12
--- Utility.pm 2001/10/22 15:13:03 1.13
***************
*** 4,7 ****
--- 4,8 ----
use strict;
+ use Class::Date qw();
use Date::Format qw( time2str );
use Date::Calc ();
***************
*** 44,48 ****
#
# Signature: $time_string = $class->now( [ { format => $strftime_format,
! # time => $time_in_seconds } ] );
sub now {
--- 45,49 ----
#
# Signature: $time_string = $class->now( [ { format => $strftime_format,
! # time => $time_in_seconds } ] );
sub now {
***************
*** 52,55 ****
--- 53,65 ----
return time2str( $p->{format}, $p->{time} );
}
+
+
+ # Class::Date version...
+ #sub now {
+ # my ( $class, $p ) = @_;
+ # $p->{format} ||= '%Y-%m-%d %T';
+ # $p->{time} ||= time;
+ # return Class::Date::new( $p->{time} )->strftime( $p->{format} );
+ #}
|
|
From: Chris W. <la...@us...> - 2001-10-22 11:51:33
|
Update of /cvsroot/openinteract/SPOPS/SPOPS/Iterator
In directory usw-pr-cvs1:/tmp/cvs-serv698
Modified Files:
DBI.pm LDAP.pm
Log Message:
all calls to 'new()' when fetching objects should be accompanied by
'skip_default_values'
Index: DBI.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/Iterator/DBI.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** DBI.pm 2001/10/12 21:00:26 1.8
--- DBI.pm 2001/10/22 11:51:30 1.9
***************
*** 73,77 ****
# It's ok to create the object now
! $obj = $object_class->new;
$obj->_fetch_assign_row( $self->{_FIELDS}, $row );
--- 73,77 ----
# It's ok to create the object now
! $obj = $object_class->new({ skip_default_values => 1 });
$obj->_fetch_assign_row( $self->{_FIELDS}, $row );
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/Iterator/LDAP.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** LDAP.pm 2001/10/12 21:00:26 1.7
--- LDAP.pm 2001/10/22 11:51:30 1.8
***************
*** 73,77 ****
# It's ok to create the object now
! $obj = $object_class->new;
$obj->_fetch_assign_row( undef, $entry );
--- 73,77 ----
# It's ok to create the object now
! $obj = $object_class->new({ skip_default_values => 1 });
$obj->_fetch_assign_row( undef, $entry );
|
4 messages has been excluded from this view by a project administrator.
