Almost completed the new profiling tool. Just a bit more tweaking :-)

lib/moodlelib.php

@@ -6559,10 +6559,9 @@ function get_performance_info() {
         $info['txt'] .= 'logwrites: '.$info['logwrites'].' ';
     }
     
-    if (!empty($PERF->profiling)) {
+    if (!empty($PERF->profiling) && $PERF->profiling) {
         require_once($CFG->dirroot .'/lib/profilerlib.php');
-        $profiler = new Profiler();
+        $info['html'] .= '<span class="profilinginfo">'.Profiler::get_profiling(array('-R')).'</span>';
-        $info['html'] .= '<span class="profilinginfo">'.$profiler->get_profiling().'</span>';
     }
 
     if (function_exists('posix_times')) {

lib/profilerlib.php

@@ -1,4 +1,266 @@
 <?php
+ini_set('display_errors', "On");
+
+require_once 'PEAR.php';
+
+if(!function_exists('scandir'))
+{
+    function scandir($dir, $sortorder = 0)
+    {
+        if(is_dir($dir))
+        {
+            $dirlist = opendir($dir);
+
+            while( ($file = readdir($dirlist)) !== false)
+            {
+                if(!is_dir($file))
+                {
+                    $files[] = $file;
+                }
+            }
+
+            ($sortorder == 0) ? asort($files) : arsort($files);
+
+            return $files;
+        }
+        else
+        {
+            return FALSE;
+            break;
+        }
+    }
+}
+
+
+/**
+ * Command-line options parsing class.
+ *
+ * @author Andrei Zmievski <andrei@php.net>
+ *
+ */
+class Console_Getopt {
+    /**
+     * Parses the command-line options.
+     *
+     * The first parameter to this function should be the list of command-line
+     * arguments without the leading reference to the running program.
+     *
+     * The second parameter is a string of allowed short options. Each of the
+     * option letters can be followed by a colon ':' to specify that the option
+     * requires an argument, or a double colon '::' to specify that the option
+     * takes an optional argument.
+     *
+     * The third argument is an optional array of allowed long options. The
+     * leading '--' should not be included in the option name. Options that
+     * require an argument should be followed by '=', and options that take an
+     * option argument should be followed by '=='.
+     *
+     * The return value is an array of two elements: the list of parsed
+     * options and the list of non-option command-line arguments. Each entry in
+     * the list of parsed options is a pair of elements - the first one
+     * specifies the option, and the second one specifies the option argument,
+     * if there was one.
+     *
+     * Long and short options can be mixed.
+     *
+     * Most of the semantics of this function are based on GNU getopt_long().
+     *
+     * @param array  $args           an array of command-line arguments
+     * @param string $short_options  specifies the list of allowed short options
+     * @param array  $long_options   specifies the list of allowed long options
+     *
+     * @return array two-element array containing the list of parsed options and
+     * the non-option arguments
+     *
+     * @access public
+     *
+     */
+    function getopt2($args, $short_options, $long_options = null)
+    {
+        return Console_Getopt::doGetopt(2, $args, $short_options, $long_options);
+    }
+
+    /**
+     * This function expects $args to start with the script name (POSIX-style).
+     * Preserved for backwards compatibility.
+     * @see getopt2()
+     */
+    function getopt($args, $short_options, $long_options = null)
+    {
+        return Console_Getopt::doGetopt(1, $args, $short_options, $long_options);
+    }
+
+    /**
+     * The actual implementation of the argument parsing code.
+     */
+    function doGetopt($version, $args, $short_options, $long_options = null)
+    {
+        // in case you pass directly readPHPArgv() as the first arg
+        if (PEAR::isError($args)) {
+            return $args;
+        }
+        if (empty($args)) {
+            return array(array(), array());
+        }
+        $opts     = array();
+        $non_opts = array();
+
+        settype($args, 'array');
+
+        if ($long_options) {
+            sort($long_options);
+        }
+
+        /*
+         * Preserve backwards compatibility with callers that relied on
+         * erroneous POSIX fix.
+         */
+        if ($version < 2) {
+            if (isset($args[0]{0}) && $args[0]{0} != '-') {
+                array_shift($args);
+            }
+        }
+
+        reset($args);
+        while (list($i, $arg) = each($args)) {
+
+            /* The special element '--' means explicit end of
+               options. Treat the rest of the arguments as non-options
+               and end the loop. */
+            if ($arg == '--') {
+                $non_opts = array_merge($non_opts, array_slice($args, $i + 1));
+                break;
+            }
+
+            if ($arg{0} != '-' || (strlen($arg) > 1 && $arg{1} == '-' && !$long_options)) {
+                $non_opts = array_merge($non_opts, array_slice($args, $i));
+                break;
+            } elseif (strlen($arg) > 1 && $arg{1} == '-') {
+                $error = Console_Getopt::_parseLongOption(substr($arg, 2), $long_options, $opts, $args);
+                if (PEAR::isError($error))
+                    return $error;
+            } else {
+                $error = Console_Getopt::_parseShortOption(substr($arg, 1), $short_options, $opts, $args);
+                if (PEAR::isError($error))
+                    return $error;
+            }
+        }
+
+        return array($opts, $non_opts);
+    }
+
+    /**
+     * @access private
+     *
+     */
+    function _parseShortOption($arg, $short_options, &$opts, &$args)
+    {
+        for ($i = 0; $i < strlen($arg); $i++) {
+            $opt = $arg{$i};
+            $opt_arg = null;
+
+            /* Try to find the short option in the specifier string. */
+            if (($spec = strstr($short_options, $opt)) === false || $arg{$i} == ':')
+            {
+                return PEAR::raiseError("Console_Getopt: unrecognized option -- $opt");
+            }
+
+            if (strlen($spec) > 1 && $spec{1} == ':') {
+                if (strlen($spec) > 2 && $spec{2} == ':') {
+                    if ($i + 1 < strlen($arg)) {
+                        /* Option takes an optional argument. Use the remainder of
+                           the arg string if there is anything left. */
+                        $opts[] = array($opt, substr($arg, $i + 1));
+                        break;
+                    }
+                } else {
+                    /* Option requires an argument. Use the remainder of the arg
+                       string if there is anything left. */
+                    if ($i + 1 < strlen($arg)) {
+                        $opts[] = array($opt,  substr($arg, $i + 1));
+                        break;
+                    } else if (list(, $opt_arg) = each($args))
+                        /* Else use the next argument. */;
+                    else
+                        return PEAR::raiseError("Console_Getopt: option requires an argument -- $opt");
+                }
+            }
+
+            $opts[] = array($opt, $opt_arg);
+        }
+    }
+
+    /**
+     * @access private
+     *
+     */
+    function _parseLongOption($arg, $long_options, &$opts, &$args)
+    {
+        @list($opt, $opt_arg) = explode('=', $arg);
+        $opt_len = strlen($opt);
+
+        for ($i = 0; $i < count($long_options); $i++) {
+            $long_opt  = $long_options[$i];
+            $opt_start = substr($long_opt, 0, $opt_len);
+
+            /* Option doesn't match. Go on to the next one. */
+            if ($opt_start != $opt)
+                continue;
+
+            $opt_rest  = substr($long_opt, $opt_len);
+
+            /* Check that the options uniquely matches one of the allowed
+               options. */
+            if ($opt_rest != '' && $opt{0} != '=' &&
+                $i + 1 < count($long_options) &&
+                $opt == substr($long_options[$i+1], 0, $opt_len)) {
+                return PEAR::raiseError("Console_Getopt: option --$opt is ambiguous");
+            }
+
+            if (substr($long_opt, -1) == '=') {
+                if (substr($long_opt, -2) != '==') {
+                    /* Long option requires an argument.
+                       Take the next argument if one wasn't specified. */;
+                    if (!strlen($opt_arg) && !(list(, $opt_arg) = each($args))) {
+                        return PEAR::raiseError("Console_Getopt: option --$opt requires an argument");
+                    }
+                }
+            } else if ($opt_arg) {
+                return PEAR::raiseError("Console_Getopt: option --$opt doesn't allow an argument");
+            }
+
+            $opts[] = array('--' . $opt, $opt_arg);
+            return;
+        }
+
+        return PEAR::raiseError("Console_Getopt: unrecognized option --$opt");
+    }
+
+    /**
+    * Safely read the $argv PHP array across different PHP configurations.
+    * Will take care on register_globals and register_argc_argv ini directives
+    *
+    * @access public
+    * @return mixed the $argv PHP array or PEAR error if not registered
+    */
+    function readPHPArgv()
+    {
+        global $argv;
+        if (!is_array($argv)) {
+            if (!@is_array($_SERVER['argv'])) {
+                if (!@is_array($GLOBALS['HTTP_SERVER_VARS']['argv'])) {
+                    return PEAR::raiseError("Console_Getopt: Could not read cmd args (register_argc_argv=Off?)");
+                }
+                return $GLOBALS['HTTP_SERVER_VARS']['argv'];
+            }
+            return $_SERVER['argv'];
+        }
+        return $argv;
+    }
+
+}
+
+
 /**
 * Profiler adapted from Pear::APD's pprofp script. Not quite there yet, I need
 * to get this to accept a similar list of arguments as the script does,
@@ -15,20 +277,91 @@ class Profiler
     var $c_utimes;
     var $mem;
    
-    function get_profiling($opt = array())
+    /**
+     * Concatenates all the pprof files generated by apd_set_pprof_trace()
+     * and returns the resulting string, which can then be processed by 
+     * get_profiling();
+     * It also deletes these files once finished, in order to limit
+     * cluttering of the filesystem. This can be switched off by
+     * providing "false" as the only argument to this function.
+     * 
+     * WARNING: If you switch cleanup off, profiling data will
+     * accumulate from one pageload to the next.
+     *
+     * @param boolean $cleanup Whether to delete pprof files or not.
+     * @return String Profiling raw data
+     */
+    function _get_pprofp($cleanup = true)
     {
-        global $CFG;
+        global $CFG, $USER;
-echo "BLAH";
+        // List all files under our temporary directory
-        $retstring = '';
+        $tempdir = $CFG->dataroot . '/temp/profile/' . $USER->id; 
-        $dataFile = ini_get('apd.dumpdir') . '/pprof.' . getmypid() . '.*';
+        if ($files = scandir($tempdir)) {
-        
+            // Concatenate the files
-        if (!$dataFile) {
+            print_r($files); 
-            return $this->usage();
+        } else {
+            print "Error: Profiler could not read the directory $tempdir.";
+            return false;
         }
         
+
+        // Return a handle to the resulting file
+        
+        
         if(($DATA = fopen($dataFile, "r")) == FALSE) {
-            die("Failed to open $dataFile for reading\n");
+            return "Failed to open $dataFile for reading\n";
         }
+        return $handle;
+    }
+
+
+    /**
+     * Returns profiling information gathered using APD functions.
+     * Accepts a numerical array of command-line arguments.
+     * 
+     * @usage Profiler::get_profiling($args)
+     *  Sort options
+     *  -a          Sort by alphabetic names of subroutines.
+     *  -l          Sort by number of calls to subroutines
+     *  -m          Sort by memory used in a function call.
+     *  -r          Sort by real time spent in subroutines.
+     *  -R          Sort by real time spent in subroutines (inclusive of child calls).
+     *  -s          Sort by system time spent in subroutines.
+     *  -S          Sort by system time spent in subroutines (inclusive of child calls).
+     *  -u          Sort by user time spent in subroutines.
+     *  -U          Sort by user time spent in subroutines (inclusive of child calls).
+     *  -v          Sort by average amount of time spent in subroutines.
+     *  -z          Sort by user+system time spent in subroutines. (default)
+     *
+     *  Display options
+     *  -c          Display Real time elapsed alongside call tree.
+     *  -i          Suppress reporting for php builtin functions
+     *  -O <cnt>    Specifies maximum number of subroutines to display. (default 15)
+     *  -t          Display compressed call tree.
+     *  -T          Display uncompressed call tree.
+     *
+     *  Example array: array('-a', '-l');
+     *   
+     * @param Array $args
+     * @return String Profiling info
+     */
+    function get_profiling($args)
+    { 
+        $con = new Console_Getopt;
+        array_shift($args);
+        
+        $shortoptions = 'acg:hiIlmMrRsStTuUO:vzZ';
+        $retval = $con->getopt( $args, $shortoptions);
+        if(is_object($retval)) {
+            usage();
+        }
+        
+        $opt['O'] = 20;
+        foreach ($retval[0] as $kv_array) {
+            $opt[$kv_array[0]] = $kv_array[1];
+        }
+        
+        $DATA = Profiler::_get_pprofp();
 
         $cfg = array();
         $this->parse_info('HEADER', $DATA, $cfg);
@@ -281,11 +614,12 @@ echo "BLAH";
                 return $retstring;
             }
         }
+        return $retstring;
     }
 
     function usage() {
     return <<<EOD
-    pprofp <flags> <trace file>
+    Profiler::get_profiling(\$args)
         Sort options
         -a          Sort by alphabetic names of subroutines.
         -l          Sort by number of calls to subroutines

lib/setuplib.php

@@ -15,7 +15,7 @@
  */
 function init_performance_info() {
 
-    global $PERF;
+    global $PERF, $CFG, $USER;
   
     $PERF = new Object;
     $PERF->dbqueries = 0;   
@@ -31,8 +31,12 @@ function init_performance_info() {
     }
     if (function_exists('apd_set_pprof_trace')) {
         // APD profiling
-        apd_set_pprof_trace();
+        if ($USER->id > 0 && $CFG->perfdebug >= 15) {
-        $PERF->process = 44444;
+            $tempdir = $CFG->dataroot . '/temp/profile/' . $USER->id; 
+            mkdir($tempdir);
+            apd_set_pprof_trace($tempdir);
+            $PERF->profiling = true;
+        }
     }
 }