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 e604998617e7ae7cf493faa40900881e54090380..1695bf5f525d0332a5810b565f4acdc8f02c5886 100644 (file)
--- 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 b8a0a48d3d40d6351f00d4533c0ca16e2953ab59..d223c768c335b20e85d10af609fd0c271498c339 100644 (file)
--- 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 c970d01c0de485f7bc4fa1f506f75d75a5682c2f..b9a608518ff8d6d12ed46b0704f003293fe662a3 100644 (file)
--- 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 de8fab65118cfe04c3f51b2cb7e9831a2f2af362..8f8a50eb4cd0243a71ff514a644a04e652c0a9a6 100644 (file)
--- 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 );