[Treebase-guts] SF.net SVN: treebase:[315] trunk/treebase-core/src/main/perl/lib/CIPRES/ TreeBase/VeryBadORM.pm

[<rv...@us...>]

Revision: 315
          http://treebase.svn.sourceforge.net/treebase/?rev=315&view=rev
Author:   rvos
Date:     2009-11-24 12:20:10 +0000 (Tue, 24 Nov 2009)

Log Message:
-----------
Removed dependency on Devel::StackTrace, lowercased hash lookup in subobject_class()

Modified Paths:
--------------
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm

Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm	2009-11-24 12:19:15 UTC (rev 314)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm	2009-11-24 12:20:10 UTC (rev 315)
@@ -338,8 +338,8 @@
     } elsif ($self->has_r_attr($attr)) {
 		return $self->get_r_subobject_no_check($attr, @_);
     }
-    my $trace = Devel::StackTrace->new;
-	print $trace->as_string; # like carp
+#    my $trace = Devel::StackTrace->new;
+#	print $trace->as_string; # like carp
     croak($self->class . " has no attribute named '$attr'");
 }
 
@@ -572,7 +572,7 @@
 sub subobject_class { 
     my ($self, $subobj) = @_;
     my $subobj_class = \%{$self->class . "::subobject"};
-    return $subobj_class->{$subobj} if exists $subobj_class->{$subobj};
+    return $subobj_class->{lc $subobj} if exists $subobj_class->{lc $subobj};
     return $self->alias($subobj) || ucfirst(lc($subobj));
 }
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.