[interchange-cvs] interchange - heins modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Tue Jun 12 11:55:49 EDT 2007
User: heins
Date: 2007-06-12 15:55:49 GMT
Modified: lib/Vend Util.pm Config.pm
Log:
* Add a couple of new features in debug. (I had originally been waiting to
do this in my "big debug/logging update", but that never happened.)
* DebugTemplate, a global directive, gives the ability to change the format
of debug messages. You have the ability to add the following:
- Any %H %M %S tags are interpreted as POSIX::strftime() markers. %% for
a percent sign, of course.
- {CALLER0}..{CALLER9} gives the member of the caller() list.
- {CATALOG} gives the current catalog name.
- {HOST} gives the host (or IP address).
- {MESSAGE} is the marker to show the actual debug message.
- {PAGE} gives the current $Global::Varialble->{MV_PAGE}
- {REMOTE_ADDR} gives the IP address.
- {TAG} gives the current tag name in Vend::Parse
* DebugHost, a catalog directive, allows you to turn on debug only for
selected hosts. It accepts a list of IP address ranges, i.e.:
DebugHost 10.1.1.0/24 12.176.97.0/25
* The SpecialSub debug_qualify, if present, is run to determine whether
debug should be turned on. For instance the following:
Sub check_for_debug_cgi sub { return $CGI->{debug} }
SpecialSub debug_qualify check_for_debug_cgi
Would only turn on debug when debug=1 is in the URL/form. Obviously
there are chicken before egg issues when you are early in the dispatch
cycle, so be careful!
* To support DebugHost, added a parse_ip_address_regexp routine that
relies on Net::IP::Match::Regexp module. We might want to investigate
whether this one is fast enough so that we can replace $Global::RobotIP
regexes and such....I didn't worry about speed since this is just debug,
but the module is reputed to be pretty fast. Certainly it should be for
small lists.
Revision Changes Path
2.103 +43 -4 interchange/lib/Vend/Util.pm
rev 2.103, prev_rev 2.102
Index: Util.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Util.pm,v
retrieving revision 2.102
retrieving revision 2.103
diff -u -r2.102 -r2.103
--- Util.pm 30 Mar 2007 11:39:46 -0000 2.102
+++ Util.pm 12 Jun 2007 15:55:49 -0000 2.103
@@ -1,6 +1,6 @@
# Vend::Util - Interchange utility functions
#
-# $Id: Util.pm,v 2.102 2007/03/30 11:39:46 pajamian Exp $
+# $Id: Util.pm,v 2.103 2007/06/12 15:55:49 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -88,7 +88,7 @@
use Vend::File;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = substr(q$Revision: 2.102 $, 10);
+$VERSION = substr(q$Revision: 2.103 $, 10);
my $Eval_routine;
my $Eval_routine_file;
@@ -1631,8 +1631,47 @@
# Log the error MSG to the error file.
sub logDebug {
- return unless $Global::DebugFile;
- print caller() . ':debug: ', errmsg(@_), "\n";
+ return unless $Global::DebugFile;
+ if(my $re = $Vend::Cfg->{DebugHost}) {
+ return unless
+ Net::IP::Match::Regexp::match_ip($CGI::remote_addr, $re);
+ }
+
+ if(my $sub = $Vend::Cfg->{SpecialSub}{debug_qualify}) {
+ return unless $sub->();
+ }
+
+ if(my $tpl = $Global::DebugTemplate) {
+ my %debug;
+ $tpl = POSIX::strftime($tpl, localtime());
+ $tpl =~ s/\s*$/\n/;
+ if($tpl =~ /\{page\}/i) {
+ $debug{page} = $Global::Variable->{MV_PAGE};
+ }
+ if($tpl =~ /\{tag\}/i) {
+ $debug{tag} = $Vend::CurrentTag;
+ }
+ if($tpl =~ /\{host\}/i) {
+ $debug{host} = $CGI::host || $CGI::remote_addr;
+ }
+ if($tpl =~ /\{catalog\}/i) {
+ $debug{catalog} = $Vend::Catalog;
+ }
+ if($tpl =~ /\{remote_addr\}/i) {
+ $debug{host} = $CGI::host || $CGI::remote_addr;
+ }
+ if($tpl =~ /\{caller\d+\}/i) {
+ my @caller = caller();
+ for(my $i = 0; $i < @caller; $i++) {
+ $debug{"caller$i"} = $caller[$i];
+ }
+ }
+ $debug{message} = errmsg(@_);
+ print Vend::Interpolate::tag_attr_list($tpl, \%debug, 1);
+ }
+ else {
+ print caller() . ":debug: ", errmsg(@_), "\n";
+ }
}
sub errmsg {
2.217 +19 -2 interchange/lib/Vend/Config.pm
rev 2.217, prev_rev 2.216
Index: Config.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.216
retrieving revision 2.217
diff -u -r2.216 -r2.217
--- Config.pm 10 Jun 2007 02:15:34 -0000 2.216
+++ Config.pm 12 Jun 2007 15:55:49 -0000 2.217
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.216 2007/06/10 02:15:34 jon Exp $
+# $Id: Config.pm,v 2.217 2007/06/12 15:55:49 mheins Exp $
#
# Copyright (C) 2002-2007 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -54,7 +54,7 @@
use Vend::Data;
use Vend::Cron;
-$VERSION = substr(q$Revision: 2.216 $, 10);
+$VERSION = substr(q$Revision: 2.217 $, 10);
my %CDname;
my %CPname;
@@ -467,6 +467,7 @@
['IpQuad', 'integer', '1'],
['TagDir', 'root_dir_array', 'code'],
['TemplateDir', 'root_dir_array', ''],
+ ['DebugTemplate', undef, ''],
['DomainTail', 'yesno', 'Yes'],
['TrustProxy', 'list_wildcard_full', ''],
['AcrossLocks', 'yesno', 'No'],
@@ -697,6 +698,7 @@
['CartTrigger', 'routine_array', ''],
['CartTriggerQuantity', 'yesno', 'no'],
['UserTrack', 'yesno', 'yes'],
+ ['DebugHost', 'ip_address_regexp', ''],
];
@@ -3725,6 +3727,21 @@
config_error("Bad regular expression in $var.");
}
return $value;
+}
+
+sub parse_ip_address_regexp {
+
+ my ($var, $value) = @_;
+ return '' unless $value;
+
+ eval {
+ require Net::IP::Match::Regexp;
+ };
+ $@ and config_error("$var directive requires module: $@");
+
+ my $re = Net::IP::Match::Regexp::create_iprange_regexp($value)
+ or config_error("Improper IP address range for $var");
+ return $re;
}
# Prepend the Global::VendRoot pathname to the relative directory specified,
More information about the interchange-cvs
mailing list