Revision: 966
Author: [email protected]
Date: Fri Dec 18 09:03:53 2009
Log: Create a package Devel::NYTProf::FileHandle which can open and close
NYYProf's file handles.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=966
Added:
/trunk/lib/Devel/NYTProf/FileHandle.pm
Modified:
/trunk/FileHandle.xs
/trunk/MANIFEST
=======================================
--- /dev/null
+++ /trunk/lib/Devel/NYTProf/FileHandle.pm Fri Dec 18 09:03:53 2009
@@ -0,0 +1,19 @@
+#!perl
+use strict;
+use warnings;
+
+package Devel::NYTProf::FileHandle;
+
+# We have to jump through some hoops to load a second XS file from the same
+# shared object.
+
+require DynaLoader;
+require Devel::NYTProf::Core;
+
+my $c_name = 'boot_Devel__NYTProf__FileHandle';
+my $c = DynaLoader::dl_find_symbol_anywhere($c_name);
+
+die "Can't locate '$c_name' in Devel::NYTProf shared object" unless $c;
+my $xs = DynaLoader::dl_install_xsub(__PACKAGE__ . '::bootstrap', $c,
__FILE__);
+&$xs(__PACKAGE__, $Devel::NYTProf::Core::VERSION);
+
=======================================
--- /trunk/FileHandle.xs Fri Dec 18 07:09:33 2009
+++ /trunk/FileHandle.xs Fri Dec 18 09:03:53 2009
@@ -569,3 +569,42 @@
}
return fclose(raw_file) == 0 ? 0 : errno;
}
+
+MODULE = Devel::NYTProf::FileHandle PACKAGE =
Devel::NYTProf::FileHandle
+
+PROTOTYPES: DISABLE
+
+void
+open(pathname, mode)
+char *pathname
+char *mode
+ PREINIT:
+ NYTP_file fh = NYTP_open(pathname, mode);
+ SV *object;
+ PPCODE:
+ if(!fh)
+ XSRETURN(0);
+ object = newSV(0);
+ sv_usepvn(object, (char *) fh, sizeof(struct NYTP_file_t));
+ ST(0) = sv_bless(sv_2mortal(newRV_noinc(object)),
gv_stashpvs("Devel::NYTProf::FileHandle", GV_ADD));
+ XSRETURN(1);
+
+int
+DESTROY(handle)
+SV *handle
+ ALIAS:
+ close = 1
+ PREINIT:
+ SV *guts;
+ CODE:
+ if (ix == ix) {
+ /* Unused argument. */
+ }
+ if(!sv_isa(handle, "Devel::NYTProf::FileHandle"))
+ croak("handle is not a Devel::NYTProf::FileHandle");
+ guts = SvRV(handle);
+ RETVAL = NYTP_close((NYTP_file)SvPVX(guts), 0);
+ SvPV_set(guts, NULL);
+ SvLEN_set(guts, 0);
+ OUTPUT:
+ RETVAL
=======================================
--- /trunk/MANIFEST Fri Dec 18 07:09:33 2009
+++ /trunk/MANIFEST Fri Dec 18 09:03:53 2009
@@ -23,6 +23,7 @@
lib/Devel/NYTProf/Constants.pm
lib/Devel/NYTProf/Core.pm
lib/Devel/NYTProf/Data.pm
+lib/Devel/NYTProf/FileHandle.pm
lib/Devel/NYTProf/FileInfo.pm
lib/Devel/NYTProf/PgPLPerl.pm
lib/Devel/NYTProf/ReadStream.pm
--
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]