Subject: | Class::Tangram::Transient(1.57) is missing "reschema" function |
Date: | Tue, 24 Oct 2006 00:40:10 +0200 (CEST) |
To: | bug-Class-Tangram [...] rt.cpan.org |
From: | Mark Lawrence <nomad [...] null.net> |
Version: 1.57-1
Severity: normal
When attempting to define a transient field "trans" in a class,
the schema failed to be created giving the following error:
Can't use string ("trans") as a HASH ref while "strict refs" in use at
/usr/local/share/perl/5.8.8/Tangram/Schema.pm line 127.
Compilation failed in require at (eval 2) line 3.
It appears that the Transient type is not 'reschema'd like other
Tangram types. With the patch below (derived from Scalar.pm) it appears
to work for me.
-- System Information:
Debian Release: testing/unstable
APT prefers stable
APT policy: (700, 'stable'), (650, 'testing'), (500, 'sid')
Architecture: amd64 (x86_64)
Shell: /bin/sh linked to /bin/bash
Kernel: Linux 2.6.16-1-amd64-k8
Locale: LANG=C, LC_CTYPE=C (charmap=ANSI_X3.4-1968)
Versions of packages libclass-tangram-perl depends on:
ii perl 5.8.8-6.1 Larry Wall's Practical Extraction
ii perl-modules 5.8.8-6.1 Core Perl modules
--- lib/Class/Tangram.pm 2006-01-30 22:18:39.000000000 +0100
+++ /usr/share/perl5/Class/Tangram.pm 2006-10-23 22:19:34.000000000 +0200
@@ -138,6 +138,20 @@
$VERSION = "1.57";
use Set::Object qw(blessed reftype refaddr ish_int is_int is_double is_key);
+use overload '""' => \&_stringify, 'fallback' => 1;
+
+sub _stringify {
+ my $self = shift;
+ my $overload = ${ref($self) . '::stringify'};
+ return $self unless ($overload);
+
+ if (ref($overload) eq 'CODE') {
+ $overload;
+ }
+ else {
+ $self->$overload;
+ }
+}
#---------------------------------------------------------------------
# run-time globals
@@ -2826,6 +2840,44 @@
sub coldefs { }
+sub reschema {
+ my ($self, $members, $class, $schema) = @_;
+
+ if (ref($members) eq 'ARRAY')
+ {
+ # short form
+ # transform into hash: { fieldname => { col => fieldname }, ... }
+ $members = $_[1] = map { $_ => { col => $schema->{normalize}->($_, 'colname') } } @$members;
+ }
+
+ for my $field (keys %$members)
+ {
+ my $def = $members->{$field};
+
+ unless (ref($def))
+ {
+ # not a reference: field => field
+ $def = $members->{$field} = { col => $schema->{normalize}->(($def || $field), 'fieldname') };
+ }
+
+ $self->field_reschema($field, $def, $schema);
+ }
+
+ return keys %$members;
+}
+
+sub field_reschema {
+ my ($self, $field, $def, $schema) = @_;
+ $def->{col} ||= $schema->{normalize}->($field, 'colname');
+}
+
+#sub query_expr
+#{
+# my ($self, $obj, $memdefs, $tid, $storage) = @_;
+# return map { $storage->expr($self, "t$tid.$memdefs->{$_}{col}", $obj) } keys %$memdefs;
+#}
+
+
sub get_exporter { }
sub get_importer { }