Menu
▾
▴
[Openinteract-commits] CVS: SPOPS/SPOPS/ClassFactory DefaultBehavior.pm,2.0,2.1 DBI.pm,2.1,2.2
|
From: Chris W. <la...@us...> - 2002-04-29 12:51:07
|
Update of /cvsroot/openinteract/SPOPS/SPOPS/ClassFactory
In directory usw-pr-cvs1:/tmp/cvs-serv31137/SPOPS/ClassFactory
Modified Files:
DefaultBehavior.pm DBI.pm
Log Message:
modify error messages to be more clear
Index: DefaultBehavior.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/ClassFactory/DefaultBehavior.pm,v
retrieving revision 2.0
retrieving revision 2.1
diff -C2 -d -r2.0 -r2.1
*** DefaultBehavior.pm 19 Mar 2002 04:00:01 -0000 2.0
--- DefaultBehavior.pm 29 Apr 2002 12:51:04 -0000 2.1
***************
*** 53,59 ****
my ( $self, $new_id ) = @_;
my $id_field = $self->id_field ||
! SPOPS::Exception->throw(
! "Cannot find ID for object since no ID field " .
! "specified for class [". ref( $self ) . ']' );
return $self->{ $id_field } unless ( $new_id );
return $self->{ $id_field } = $new_id;
--- 53,60 ----
my ( $self, $new_id ) = @_;
my $id_field = $self->id_field ||
! SPOPS::Exception->throw(
! "Cannot find ID for object since no ID ",
! "field specified for class [",
! "ref( $self ) . ']' " );
return $self->{ $id_field } unless ( $new_id );
return $self->{ $id_field } = $new_id;
***************
*** 68,74 ****
my $id_method = $ID_TEMPLATE;
$id_method =~ s/%%CLASS%%/$class/g;
! eval $id_method;
! if ( $@ ) {
! return ( ERROR, "Cannot create method 'id': $@" );
}
return ( DONE, undef );
--- 69,80 ----
my $id_method = $ID_TEMPLATE;
$id_method =~ s/%%CLASS%%/$class/g;
! DEBUG() && _w( 5, "ID method being created\n$id_method" );
! {
! local $SIG{__WARN__} = sub { return undef };
! eval $id_method;
! if ( $@ ) {
! return ( ERROR, "Cannot generate method 'id' in class " .
! "[$class]. Error: $@" );
! }
}
return ( DONE, undef );
***************
*** 93,97 ****
$code_class = [ $code_class ] unless ( ref $code_class eq 'ARRAY' );
foreach my $read_code_class ( @{ $code_class } ) {
! DEBUG() && _w( 2, "Trying to read code from ($read_code_class) to ($class)" );
my $filename = $read_code_class;
$filename =~ s|::|/|g;
--- 99,104 ----
$code_class = [ $code_class ] unless ( ref $code_class eq 'ARRAY' );
foreach my $read_code_class ( @{ $code_class } ) {
! DEBUG() && _w( 2, "Trying to read code from [$read_code_class]",
! "into [$class]" );
my $filename = $read_code_class;
$filename =~ s|::|/|g;
***************
*** 101,105 ****
foreach my $prefix ( @INC ) {
my $full_filename = "$prefix/$filename.pm";
! DEBUG() && _w( 3, "Try file: ($full_filename)" );
if ( -f $full_filename ) {
$final_filename = $full_filename;
--- 108,112 ----
foreach my $prefix ( @INC ) {
my $full_filename = "$prefix/$filename.pm";
! DEBUG() && _w( 3, "Try file: [$full_filename]" );
if ( -f $full_filename ) {
$final_filename = $full_filename;
***************
*** 108,152 ****
}
! DEBUG() && _w( 2, "File ($final_filename) will be used for $read_code_class" );
! if ( -f $final_filename ) {
! eval { open( PKG, $final_filename ) || die $! };
! if ( $@ ) {
! return ( ERROR, "Error opening code file to be read in: $@" );
! }
! my $code_pkg = undef;
! push @files_used, $final_filename;
CODEPKG:
! while ( <PKG> ) {
! if ( s/^\s*package $read_code_class\s*;\s*$/package $class;/ ) {
! $code_pkg .= $_;
! DEBUG() && _w( 1, " Package $read_code_class will be ",
! "read in as $class" );
! last CODEPKG;
! }
$code_pkg .= $_;
}
! # Use a block here because we want the $/ setting to
! # NOT be localized in the while loop -- that would be bad, since
! # the 'package' substitution would never work after the first one...
! {
! local $/ = undef;
! $code_pkg .= <PKG>;
! }
! close( PKG );
! DEBUG() && _w( 5, "Going to eval code:\n\n$code_pkg" );
! {
! local $SIG{__WARN__} = sub { return undef };
! eval $code_pkg;
! if ( $@ ) {
! return ( ERROR, "Error reading ($code_class) into ($class): $@" );
! }
! }
}
! else {
! warn " **Filename not found for code to be read in for specified",
! "class ($read_code_class)\n";
}
}
--- 115,167 ----
}
! unless ( $final_filename and -f $final_filename ) {
! return ( ERROR, "Class [$read_code_class] specified in " .
! "'code_class' configuration defintion " .
! "for class [$class] was not found in \@INC" );
! }
!
! DEBUG() && _w( 2, "File [$final_filename] will be used for ",
! "[$read_code_class]" );
!
! eval { open( PKG, $final_filename ) || die $! };
! if ( $@ ) {
! return ( ERROR, "Cannot read [$final_filename] specified in " .
! "'code_class' configuration definition for " .
! "class [$class]. Error: $@" );
! }
! my $code_pkg = undef;
! push @files_used, $final_filename;
CODEPKG:
! while ( <PKG> ) {
! if ( s/^\s*package $read_code_class\s*;\s*$/package $class;/ ) {
$code_pkg .= $_;
+ DEBUG() && _w( 1, "Package [$read_code_class] will be ",
+ "read in as [$class]" );
+ last CODEPKG;
}
+ $code_pkg .= $_;
+ }
! # Use a block here because we want the $/ setting to NOT be
! # localized in the while loop -- that would be bad, since the
! # 'package' substitution would never work after the first
! # one...
! {
! local $/ = undef;
! $code_pkg .= <PKG>;
}
! close( PKG );
! DEBUG() && _w( 5, "Going to eval code:\n\n$code_pkg" );
! {
! local $SIG{__WARN__} = sub { return undef };
! eval $code_pkg;
! if ( $@ ) {
! return ( ERROR, "Error running 'eval' on code read from " .
! "[$final_filename] as specified in " .
! "'code_class' configuration defintion for " .
! "class [$class]. Error: $@" );
! }
}
}
***************
*** 179,183 ****
$CONFIG->{has_a} ||= {};
foreach my $hasa_class ( keys %{ $CONFIG->{has_a} } ) {
! DEBUG() && _w( 1, "Try to alias $class hasa $hasa_class" );
my $hasa_config = $hasa_class->CONFIG;
my $hasa_id_field = $hasa_config->{id_field};
--- 194,198 ----
$CONFIG->{has_a} ||= {};
foreach my $hasa_class ( keys %{ $CONFIG->{has_a} } ) {
! DEBUG() && _w( 1, "Try to alias [$class] hasa [$hasa_class]" );
my $hasa_config = $hasa_class->CONFIG;
my $hasa_id_field = $hasa_config->{id_field};
***************
*** 202,208 ****
# has_a => { 'MySPOPS::User' => 'created_by', ... }
! my $id_fields = ( ref $CONFIG->{has_a}->{ $hasa_class } eq 'ARRAY' )
! ? $CONFIG->{has_a}->{ $hasa_class }
! : [ $CONFIG->{has_a}->{ $hasa_class } ];
my $num_id_fields = scalar @{ $id_fields };
foreach my $usea_id_info ( @{ $id_fields } ) {
--- 217,223 ----
# has_a => { 'MySPOPS::User' => 'created_by', ... }
! my $id_fields = ( ref $CONFIG->{has_a}{ $hasa_class } eq 'ARRAY' )
! ? $CONFIG->{has_a}{ $hasa_class }
! : [ $CONFIG->{has_a}{ $hasa_class } ];
my $num_id_fields = scalar @{ $id_fields };
foreach my $usea_id_info ( @{ $id_fields } ) {
***************
*** 234,246 ****
$this_hasa_sub =~ s/%%HASA_ALIAS%%/$hasa_alias/g;
$this_hasa_sub =~ s/%%HASA_ID_FIELD%%/$usea_id_field/g;
! DEBUG() && _w( 2, "Aliasing ($hasa_class) with field ($usea_id_field) ",
! "using alias ($hasa_alias) within ($class)" );
DEBUG() && _w( 5, "Now going to eval the routine:\n$this_hasa_sub" );
{
local $SIG{__WARN__} = sub { return undef };
eval $this_hasa_sub;
! }
! if ( $@ ) {
! return ( ERROR, "Error reading 'has_a' code into ($class): $@\n" );
}
}
--- 249,263 ----
$this_hasa_sub =~ s/%%HASA_ALIAS%%/$hasa_alias/g;
$this_hasa_sub =~ s/%%HASA_ID_FIELD%%/$usea_id_field/g;
! DEBUG() && _w( 2, "Aliasing [$hasa_class] with field [$usea_id_field] ",
! "using alias [$hasa_alias] within [$class]" );
DEBUG() && _w( 5, "Now going to eval the routine:\n$this_hasa_sub" );
{
local $SIG{__WARN__} = sub { return undef };
eval $this_hasa_sub;
! if ( $@ ) {
! return ( ERROR, "Error reading 'has_a' code for alias " .
! "[$hasa_alias] mapped to class " .
! "[$hasa_class] into [$class]. Error: $@\n" );
! }
}
}
***************
*** 285,291 ****
local $SIG{__WARN__} = sub { return undef };
eval $fetch_by_sub;
! }
! if ( $@ ) {
! return ( ERROR, "Cannot read 'fetch_by' code for field ($fetch_by_field) into ($class): $@" );
}
}
--- 302,309 ----
local $SIG{__WARN__} = sub { return undef };
eval $fetch_by_sub;
! if ( $@ ) {
! return ( ERROR, "Cannot eval 'fetch_by' code for field " .
! "[$fetch_by_field] into [$class]. Error: $@" );
! }
}
}
***************
*** 316,320 ****
eval $ruleset_info;
if ( $@ ) {
! return ( ERROR, "Could not eval ruleset info into $class: $@" );
}
--- 334,338 ----
eval $ruleset_info;
if ( $@ ) {
! return ( ERROR, "Could not eval ruleset info into [$class]. Error: $@" );
}
***************
*** 325,330 ****
my $subs = SPOPS::ClassFactory->find_parent_methods( $class, $rule_classes, RULESET_METHOD, 'ruleset_add' );
foreach my $sub_info ( @{ $subs } ) {
$sub_info->[1]->( $class, $class->RULESET );
- DEBUG() && _w( 2, "Calling ruleset generation for ($class) from ($sub_info->[0])" );
}
return ( OK, undef );
--- 343,349 ----
my $subs = SPOPS::ClassFactory->find_parent_methods( $class, $rule_classes, RULESET_METHOD, 'ruleset_add' );
foreach my $sub_info ( @{ $subs } ) {
+ DEBUG() && _w( 2, "Calling ruleset generation for [$class] ",
+ "from [$sub_info->[0]]" );
$sub_info->[1]->( $class, $class->RULESET );
}
return ( OK, undef );
Index: DBI.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/ClassFactory/DBI.pm,v
retrieving revision 2.1
retrieving revision 2.2
diff -C2 -d -r2.1 -r2.2
*** DBI.pm 9 Apr 2002 21:01:41 -0000 2.1
--- DBI.pm 29 Apr 2002 12:51:04 -0000 2.2
***************
*** 49,59 ****
$id_sub =~ s/%%CLASS%%/$class/g;
$id_sub =~ s/%%ID_FIELD_OBJECT_LIST%%/$id_object_reference/g;
{
local $SIG{__WARN__} = sub { return undef };
eval $id_sub;
! }
! if ( $@ ) {
! warn "Code: $id_sub\n";
! return ( ERROR, "Cannot create 'id()' method for ($class): $@" );
}
return ( DONE, undef );
--- 49,61 ----
$id_sub =~ s/%%CLASS%%/$class/g;
$id_sub =~ s/%%ID_FIELD_OBJECT_LIST%%/$id_object_reference/g;
+ DEBUG() && _w( 5, "Evaluation method 'id' for class [$class]\n$id_sub" );
{
local $SIG{__WARN__} = sub { return undef };
eval $id_sub;
! if ( $@ ) {
! warn "Code: $id_sub\n";
! return ( ERROR, "Cannot create multifield 'id()' method for " .
! "class [$class]: $@" );
! }
}
return ( DONE, undef );
***************
*** 162,179 ****
my $id_boolean_reference = join( ' and ', map { "\$val{$_}" } @{ $id_field } );
my $id_field_reference = 'qw( ' . join( ' ', @{ $id_field } ) . ' )';
! my $id_sub = $generic_multifield_etc;
! $id_sub =~ s/%%CLASS%%/$class/g;
! $id_sub =~ s/%%ID_FIELD_OBJECT_LIST%%/$id_object_reference/g;
! $id_sub =~ s/%%ID_FIELD_VARIABLE_LIST%%/$id_variable_reference/g;
! $id_sub =~ s/%%ID_FIELD_BOOLEAN_LIST%%/$id_boolean_reference/g;
! $id_sub =~ s/%%ID_FIELD_NAME_LIST%%/$id_field_reference/g;
{
local $SIG{__WARN__} = sub { return undef };
! eval $id_sub;
! }
! if ( $@ ) {
! warn "Code: $id_sub\n";
! return ( ERROR, "Cannot create 'id_clause() and id_fields()'" .
! "methods for ($class): $@" );
}
return ( OK, undef );
--- 164,183 ----
my $id_boolean_reference = join( ' and ', map { "\$val{$_}" } @{ $id_field } );
my $id_field_reference = 'qw( ' . join( ' ', @{ $id_field } ) . ' )';
! my $other_sub = $generic_multifield_etc;
! $other_sub =~ s/%%CLASS%%/$class/g;
! $other_sub =~ s/%%ID_FIELD_OBJECT_LIST%%/$id_object_reference/g;
! $other_sub =~ s/%%ID_FIELD_VARIABLE_LIST%%/$id_variable_reference/g;
! $other_sub =~ s/%%ID_FIELD_BOOLEAN_LIST%%/$id_boolean_reference/g;
! $other_sub =~ s/%%ID_FIELD_NAME_LIST%%/$id_field_reference/g;
! DEBUG() && _w( 5, "Evaluating other multifield key methods:\n$other_sub" );
{
local $SIG{__WARN__} = sub { return undef };
! eval $other_sub;
! if ( $@ ) {
! return ( ERROR, "Cannot create multifield key 'clone()', " .
! "'id_field(), 'id_clause()', and " .
! "'id_field_select()' methods for [$class]. " .
! "Error: $@" );
! }
}
return ( OK, undef );
***************
*** 290,302 ****
$linksto_sub =~ s/%%LINKSTO_ID_FIELD%%/$linksto_id_field/g;
$linksto_sub =~ s/%%LINKSTO_TABLE%%/$table/g;
! DEBUG() && _w( 2, "Trying to create links_to routines with ($class) links_to",
! "($linksto_class) using table ($table)" );
DEBUG() && _w( 5, "Now going to eval the routine:\n$linksto_sub" );
{
local $SIG{__WARN__} = sub { return undef };
eval $linksto_sub;
! }
! if ( $@ ) {
! return ( ERROR, "Cannot create 'links_to' methods for ($class): $@" );
}
}
--- 294,310 ----
$linksto_sub =~ s/%%LINKSTO_ID_FIELD%%/$linksto_id_field/g;
$linksto_sub =~ s/%%LINKSTO_TABLE%%/$table/g;
! DEBUG() && _w( 2, "Trying to create links_to routines with ",
! "[$class] links_to [$linksto_class] using ",
! "table [$table]" );
DEBUG() && _w( 5, "Now going to eval the routine:\n$linksto_sub" );
{
local $SIG{__WARN__} = sub { return undef };
eval $linksto_sub;
! if ( $@ ) {
! return ( ERROR, "Cannot create 'links_to' methods for " .
! "class [$class] linking to class ",
! "[$linksto_class] via table [$table]. " .
! "Error: $@" );
! }
}
}
|