From 32aeab29cd5db14b760cb77d37cd86d6878f0553 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <code@sartak.org>
Date: Sun, 19 Aug 2012 17:12:27 +0200
Subject: [PATCH] "loading-file" and "loaded-file" DTrace probes

---
 mydtrace.h         | 24 ++++++++++++++++++++++++
 perldtrace.d       |  3 +++
 pod/perldtrace.pod | 27 ++++++++++++++++++++++++++-
 pp_ctl.c           |  4 ++++
 t/run/dtrace.pl    |  1 +
 t/run/dtrace.t     | 21 ++++++++++++++++++++-
 6 files changed, 78 insertions(+), 2 deletions(-)
 create mode 100644 t/run/dtrace.pl

diff --git a/mydtrace.h b/mydtrace.h
index 8ee130f..951d177 100644
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -38,6 +38,18 @@
 	PERL_OP_ENTRY(tmp_name, file, line, stash);	\
     }
 
+#    define LOADING_FILE_PROBE(name) 	                        \
+    if (PERL_LOADING_FILE_ENABLED()) {    		        \
+	const char *tmp_name = name;			\
+	PERL_LOADING_FILE(tmp_name);	                        \
+    }
+
+#    define LOADED_FILE_PROBE(name) 	                        \
+    if (PERL_LOADED_FILE_ENABLED()) {    		        \
+	const char *tmp_name = name;			\
+	PERL_LOADED_FILE(tmp_name);	                        \
+    }
+
 #  else
 
 #    define ENTRY_PROBE(func, file, line, stash) 	\
@@ -55,6 +67,16 @@
 	PERL_OP_ENTRY(name); 	                        \
     }
 
+#    define LOADING_FILE_PROBE(name)	                        \
+    if (PERL_LOADING_FILE_ENABLED()) {    		        \
+	PERL_LOADING_FILE(name); 	                                \
+    }
+
+#    define LOADED_FILE_PROBE(name)	                        \
+    if (PERL_LOADED_FILE_ENABLED()) {    		        \
+	PERL_LOADED_FILE(name); 	                                \
+    }
+
 #  endif
 
 #  define PHASE_CHANGE_PROBE(new_phase, old_phase)      \
@@ -69,6 +91,8 @@
 #  define RETURN_PROBE(func, file, line, stash)
 #  define PHASE_CHANGE_PROBE(new_phase, old_phase)
 #  define OP_ENTRY_PROBE(name)
+#  define LOADING_FILE_PROBE(name)
+#  define LOADED_FILE_PROBE(name)
 
 #endif
 
diff --git a/perldtrace.d b/perldtrace.d
index f352b31..0fdb7ea 100644
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -10,6 +10,9 @@ provider perl {
     probe phase__change(const char *, const char *);
 
     probe op__entry(const char *);
+
+    probe loading__file(const char *);
+    probe loaded__file(const char *);
 };
 
 /*
diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
index 60a9370..c5af761 100644
--- a/pod/perldtrace.pod
+++ b/pod/perldtrace.pod
@@ -57,7 +57,7 @@ The C<phase-change> probe was added.
 
 =item 5.18.0
 
-The C<op-entry> probe was added.
+The C<op-entry>, C<loading-file>, and C<loaded-file> probes weree added.
 
 =back
 
@@ -112,6 +112,29 @@ still before the opcode itself is executed).
         printf("About to execute opcode %s\n", copyinstr(arg0));
     }
 
+=item loading-file(FILENAME)
+
+Fires when Perl is about to load an individual file, whether from
+C<use>, C<require>, or C<do>. This probe fires before the file is
+read from disk. The filename argument is converted to local filesystem
+paths instead of providing C<Module::Name>-style names.
+
+    :*perl*:loading-file {
+        printf("About to load %s\n", copyinstr(arg0));
+    }
+
+=item loaded-file(FILENAME)
+
+Fires when Perl has successfully loaded an individual file, whether
+from C<use>, C<require>, or C<do>. This probe fires after the file
+is read from disk and its contentss evaluated. The filename argument
+is converted to local filesystem paths instead of providing
+C<Module::Name>-style names.
+
+    :*perl*:loaded-file {
+        printf("Successfully loaded %s\n", copyinstr(arg0));
+    }
+
 =back
 
 =head1 EXAMPLES
@@ -179,6 +202,8 @@ still before the opcode itself is executed).
     Exporter::Heavy::_rebuild_cache                                5039
     Exporter::import                                              14578
 
+=item 
+
 =back
 
 =head1 REFERENCES
diff --git a/pp_ctl.c b/pp_ctl.c
index b85728b..1477373 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3696,6 +3696,8 @@ PP(pp_require)
 	}
     }
 
+    LOADING_FILE_PROBE(unixname);
+
     /* prepare to compile file */
 
     if (path_is_absolute(name)) {
@@ -3998,6 +4000,8 @@ PP(pp_require)
     /* Restore encoding. */
     PL_encoding = encoding;
 
+    LOADED_FILE_PROBE(unixname);
+
     return op;
 }
 
diff --git a/t/run/dtrace.pl b/t/run/dtrace.pl
new file mode 100644
index 0000000..d81cc07
--- /dev/null
+++ b/t/run/dtrace.pl
@@ -0,0 +1 @@
+42
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 183868d..2fa27a3 100644
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
 use warnings;
 use IPC::Open2;
 
-plan(tests => 7);
+plan(tests => 9);
 
 dtrace_like(
     '1',
@@ -132,6 +132,25 @@ D_SCRIPT
     'basic op probe',
 );
 
+dtrace_like(<< 'PERL_SCRIPT',
+    use strict;
+    require HTTP::Tiny;
+    do "run/dtrace.pl";
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    loading-file { printf("loading-file <%s>\n", copyinstr(arg0)) }
+    loaded-file  { printf("loaded-file <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        # the original test made sure that each file generated a loading-file then a loaded-file,
+        # but that had a race condition when the kernel would push the perl process onto a different
+        # CPU, so the DTrace output would appear out of order
+        qr{loading-file <strict\.pm>.*loading-file <HTTP/Tiny\.pm>.*loading-file <run/dtrace\.pl>}s,
+        qr{loaded-file <strict\.pm>.*loaded-file <HTTP/Tiny\.pm>.*loaded-file <run/dtrace\.pl>}s,
+    ],
+    'loading-file, loaded-file probes',
+);
+
 sub dtrace_like {
     my $perl     = shift;
     my $probes   = shift;
-- 
2.7.4