[freeside-commits] freeside/FS/FS Mason.pm,1.5,1.6

Mon Feb 16 18:28:50 PST 2009

Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv23011/FS/FS

Modified Files:
	Mason.pm 
Log Message:
per-user preference for turning on profiling display when DBIx::Profile is loaded, RT#4830

Index: Mason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Mason.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6

--- Mason.pm	9 Jan 2009 04:06:26 -0000	1.5
+++ Mason.pm	17 Feb 2009 02:28:47 -0000	1.6
@@ -233,20 +233,35 @@
     use vars qw($m);
 
     # false laziness w/below
-    if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
+    if ( defined(@DBIx::Profile::ISA) ) {
 
-      my $page =
-        qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
-        '<BR><BR><PRE>'.
-          ( UNIVERSAL::can(dbh, 'sprintProfile')
-              ? encode_entities(dbh->sprintProfile())
-              : 'DBIx::Profile missing sprintProfile method;'.
-                'unpatched or too old?'                        ).
-        #"\n\n". &sprintAutoProfile().  '</PRE>'.
-        "\n\n".                         '</PRE>'.
-        '</BODY></HTML>';
-      dbh->{'private_profile'} = {};
-      return $page;
+      if ( $FS::CurrentUser::CurrentUser->option('show_db_profile') ) {
+
+        #profiling redirect
+
+        my $page =
+          qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
+          '<BR><BR><PRE>'.
+            ( UNIVERSAL::can(dbh, 'sprintProfile')
+                ? encode_entities(dbh->sprintProfile())
+                : 'DBIx::Profile missing sprintProfile method;'.
+                  'unpatched or too old?'                        ).
+          #"\n\n". &sprintAutoProfile().  '</PRE>'.
+          "\n\n".                         '</PRE>'.
+          '</BODY></HTML>';
+
+
+        dbh->{'private_profile'} = {};
+        return $page;
+
+      } else {
+
+        #clear db profile, but normal redirect
+        dbh->{'private_profile'} = {};
+        $m->redirect($location);
+        '';
+
+      }
 
     } else { #normal redirect
 
@@ -272,20 +287,33 @@
     use vars qw($m);
     $m->clear_buffer;
     #false laziness w/above
-    if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
+    if ( defined(@DBIx::Profile::ISA) ) {
 
-      $m->print(
-        qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
-        '<BR><BR><PRE>'.
-          ( UNIVERSAL::can(dbh, 'sprintProfile')
-              ? encode_entities(dbh->sprintProfile())
-              : 'DBIx::Profile missing sprintProfile method;'.
-                'unpatched or too old?'                        ).
-        #"\n\n". &sprintAutoProfile().  '</PRE>'.
-        "\n\n".                         '</PRE>'.
-        '</BODY></HTML>'
-      );
-      dbh->{'private_profile'} = {};
+      if ( $FS::CurrentUser::CurrentUser->option('show_db_profile') ) {
+
+        #profiling redirect
+
+        $m->print(
+          qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
+          '<BR><BR><PRE>'.
+            ( UNIVERSAL::can(dbh, 'sprintProfile')
+                ? encode_entities(dbh->sprintProfile())
+                : 'DBIx::Profile missing sprintProfile method;'.
+                  'unpatched or too old?'                        ).
+          #"\n\n". &sprintAutoProfile().  '</PRE>'.
+          "\n\n".                         '</PRE>'.
+          '</BODY></HTML>'
+        );
+
+        dbh->{'private_profile'} = {};
+
+      } else {
+
+        #clear db profile, but normal redirect
+        dbh->{'private_profile'} = {};
+        $m->redirect($location);
+
+      }
 
     } else { #normal redirect
 

