From: Aaron Trevena <aaron.trevena@gmail.com>
Date: Mon, 16 Oct 2006 16:23:52 +0000 (+0000)
Subject: new warn function, other small trivial changes and fixes
X-Git-Tag: 2.12~40
X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=commitdiff_plain;h=32ecafee815b0fd8043c0acc2c785f5748fc20ff

new warn function, other small trivial changes and fixes

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@534 48953598-375a-da11-a14b-00016c27c3ee
---

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index e604998..1695bf5 100644
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -101,6 +101,17 @@ sub get_request {
     $self->ar($ar);
 }
 
+sub warn {
+  my ($self,@args) = @_;
+  my ($package, $line) = (caller)[0,2];
+  if ( $args[0] and ref $self ) {
+    $self->{ar}->warn("[$package line $line] ", @args) ;
+  } else {
+    print "warn called by ", caller, " with ", @_, "\n";
+  }
+  return;
+}
+
 =item parse_location
 
 =cut
diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index b8a0a48..d223c76 100644
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -105,6 +105,13 @@ sub parse_location
     $r->parse_args;
 }
 
+sub warn {
+    my ($self,@args) = @_;
+    my ($package, $line) = (caller)[0,2];
+    warn "[$package line $line] ", @args ;
+    return;
+}
+
 =item parse_args
 
 =cut
diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index c970d01..b9a6085 100644
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -808,9 +808,9 @@ sub is_model_applicable {
 
     if (not $ok) 
     {
-        warn "We don't have that table ($table).\n"
+        $self->warn ("We don't have that table ($table).\n"
             . "Available tables are: "
-            . join( ",", keys %$ok_tables )
+            . join( ",", keys %$ok_tables ))
                 if $self->debug and not $ok_tables->{$table};
                 
         return DECLINED;
@@ -820,7 +820,7 @@ sub is_model_applicable {
     my $action = $self->action;
     return OK if $self->model_class->is_public($action);
     
-    warn "The action '$action' is not applicable to the table '$table'"
+    $self->warn("The action '$action' is not applicable to the table '$table'")
          if $self->debug;
     
     return DECLINED;
diff --git a/lib/Maypole/CLI.pm b/lib/Maypole/CLI.pm
index de8fab6..8f8a50e 100644
--- a/lib/Maypole/CLI.pm
+++ b/lib/Maypole/CLI.pm
@@ -26,6 +26,13 @@ sub import {
 
 sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." }
 
+sub warn {
+    my ($self,@args) = @_;
+    my ($package, $line) = (caller)[0,2];
+    warn "[$package line $line] ", @args ;
+    return;
+}
+
 sub parse_location {
     my $self = shift;
     my $url  = URI->new( shift @ARGV );