Yesterday I got bitten really badly by something I think I can best illustrate with a test case.

  use warnings;
  use strict;
  use Template::Test;
  use Template::Stash;
  use Template::Stash::XS;

  package Rhino;
  sub new { bless { delta => "safe to get" }, shift }

  sub gamma {
    my $self = shift;
    # set some internal value
    $self->{gamma} = "internal value";
    # now make something up.
    # This will fail, and should throw an error, right?
    return Zebra->gamma();
  }


  package main;

  for my $stashclass (qw( Template::Stash Template::Stash::XS )) {

    my $template = Template->new({
      BLOCKS => {
        callgamma => "[% rhino.gamma %]",
        calldelta => "[% rhino.delta %]",
      },
      STASH => $stashclass->new,
    });

    my $output;

    $output = "";
    ok( ! $template->process('callgamma',
      { rhino => Rhino->new }, \$output ) );
    ok( !$output );
    ok( $template->error );

    $output = "";
    ok( $template->process('calldelta',
      { rhino => Rhino->new }, \$output ) );
    ok( $output eq 'safe to get' );

  }

In summary - rhino.gamma is converted into a call to $rhino->gamma(). If the error thrown by this matches 'Can't locate object method', TT assumes that there wasn't a method with this name, and treats $rhino as a hash. But this currently catches _any_ missing object method errors thrown by any code in your call. Mostly this means that TT seems to be eating serious errors and not telling you why.

The fix is easy - check for 'Can't locate object method "foo" via package "bar"'. A patch is attached that should fix both the perl and XS stashes, as well as this test in a slightly nicer form. I think I've messed up your tabs in the patch, though, sorry.

Thanks to Stig Brautaset for help with the XS/C level stuff, as I'm very rusty, and do stupid things.

Tom Insam
[EMAIL PROTECTED]
diff -ur Template-Toolkit-2.14/lib/Template/Stash.pm 
Template-Toolkit-2.14-tom/lib/Template/Stash.pm
--- Template-Toolkit-2.14/lib/Template/Stash.pm 2004-10-04 11:27:39.000000000 
+0100
+++ Template-Toolkit-2.14-tom/lib/Template/Stash.pm     2006-02-10 
09:31:54.022480504 +0000
@@ -655,7 +655,8 @@
             # object then we assume it's a real error that needs
             # real throwing
             
-            die $@ if ref($@) || ($@ !~ /Can't locate object method/);
+            my $class = ref($root) || $root;
+            die $@ if ref($@) || ($@ !~ /Can't locate object method "$item" 
via package "$class"/);
 
             # failed to call object method, so try some fallbacks
 # patch from Stephen Howard
diff -ur Template-Toolkit-2.14/xs/Stash.xs Template-Toolkit-2.14-tom/xs/Stash.xs
--- Template-Toolkit-2.14/xs/Stash.xs   2003-03-17 23:05:27.000000000 +0000
+++ Template-Toolkit-2.14-tom/xs/Stash.xs       2006-02-10 09:45:38.352725344 
+0000
@@ -510,6 +510,8 @@
                SPAGAIN;
                
                if (SvTRUE(ERRSV)) {
+                   char errormatch[100];
+
                    (void) POPs;                /* remove undef from stack */
                    PUTBACK;
                    result = NULL;
@@ -519,8 +521,10 @@
                       object then we assume it's a real error that needs
                       real throwing */
                    
-                   if (SvROK(ERRSV) || !strstr(SvPV(ERRSV, PL_na), 
-                                               "Can't locate object method")) {
+                   snprintf(errormatch, sizeof(errormatch),
+                     "Can't locate object method \"%s\" via package \"%s\"",
+                     item, sv_reftype( root , 0 ) ); 
+                   if (SvROK(ERRSV) || !strstr(SvPV(ERRSV, PL_na), errormatch) 
) { 
                        die_object(aTHX_ ERRSV);
                    }
                } else {
#============================================================= -*-perl-*-
#
# t/error.t
#
# ...
#
# Written by Tom Insam <[EMAIL PROTECTED]>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: $
#
#========================================================================

use strict;
use Template::Test;
use Template::Stash;
use Template::Stash::XS;
$|++;
$^W = 1;

package Rhino;
sub new { bless { delta => "safe to get" }, shift }

sub gamma {
  my $self = shift;
  # set some internal value
  $self->{gamma} = "internal value";
  # now make something up. This will fail, and should throw an error, right?
  return Zebra->gamma();
}


package main;

for my $stashclass (qw( Template::Stash Template::Stash::XS )) {

  my $template = Template->new({
    BLOCKS => {
      callgamma => "[% rhino.gamma %]",
      calldelta => "[% rhino.delta %]",
    },
    STASH => $stashclass->new,
  });

  my $output;

  $output = "";
  ok( ! $template->process('callgamma', { rhino => Rhino->new }, \$output ) );
  ok( !$output );
  ok( $template->error );

  $output = "";
  ok( $template->process('calldelta', { rhino => Rhino->new }, \$output ) );
  ok( $output eq 'safe to get' );

}
  

Reply via email to