summaryrefslogtreecommitdiff
path: root/src/perl/LogImport
diff options
context:
space:
mode:
Diffstat (limited to 'src/perl/LogImport')
-rw-r--r--src/perl/LogImport/Changes13
-rw-r--r--src/perl/LogImport/GNUmakefile71
-rw-r--r--src/perl/LogImport/LogImport.pm190
-rw-r--r--src/perl/LogImport/LogImport.xs129
-rw-r--r--src/perl/LogImport/MANIFEST7
-rw-r--r--src/perl/LogImport/Makefile.PL49
-rw-r--r--src/perl/LogImport/typemap24
7 files changed, 483 insertions, 0 deletions
diff --git a/src/perl/LogImport/Changes b/src/perl/LogImport/Changes
new file mode 100644
index 0000000..db6f621
--- /dev/null
+++ b/src/perl/LogImport/Changes
@@ -0,0 +1,13 @@
+Revision history for Perl extension PCP::LogImport
+
+1.02 Thu May 23 15:30:53 EST 2013
+ - add pmiBatch{PutValue,Write,End} extensions
+ - additional API error codes (badname,badtime)
+
+1.01 Sun Sep 23 12:34:53 EST 2012
+ - add in definitions of the API error codes
+ - add in helper routines (pmiID + pmiInDom)
+
+1.00 Tue Jul 13 16:41:17 EST 2010
+ - initial version
+
diff --git a/src/perl/LogImport/GNUmakefile b/src/perl/LogImport/GNUmakefile
new file mode 100644
index 0000000..d7b4dec
--- /dev/null
+++ b/src/perl/LogImport/GNUmakefile
@@ -0,0 +1,71 @@
+#!gmake
+#
+# Copyright (c) 2008 Aconex. All Rights Reserved.
+# Copyright (c) 2004 Silicon Graphics, Inc. All Rights Reserved.
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2 of the License, or (at your
+# option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+#
+
+TOPDIR = ../../..
+include $(TOPDIR)/src/include/builddefs
+
+PERLMOD = LogImport.pm
+INTERFACE = LogImport.xs typemap
+TESTCODE =
+PERLDOCS = Changes MANIFEST
+LSRCFILES = Makefile.PL $(PERLDOCS) $(PERLMOD) $(INTERFACE) $(TESTCODE)
+
+LPKGDIRT = PCP-LogImport-* tmp MYMETA.yml MYMETA.json
+LDIRT = Makefile COPYING LogImport.bs LogImport.c LogImport.o cvalue pm_to_blib blib \
+ Makefile.old $(LPKGDIRT)
+
+default: dist
+
+MAKEMAKER_OPTIONS = INSTALLDIRS=$(PERL_INSTALLDIRS) INSTALLVENDORMAN3DIR=$(PCP_MAN_DIR)/man3
+INSTALLER_OPTIONS = DESTDIR=$$DIST_ROOT
+
+ifeq ($(TARGET_OS),mingw)
+PERLMAKE = dmake.exe
+else
+PERLMAKE = $(MAKE)
+endif
+
+LogImport.o: Makefile LogImport.xs typemap
+ $(PERLMAKE) -f Makefile
+
+Makefile: COPYING Makefile.PL
+ $(call PERL_MAKE_MAKEFILE)
+
+COPYING:
+ $(LN_S) $(TOPDIR)/COPYING COPYING
+
+test dist: LogImport.o
+ rm -rf $(LPKGDIRT)
+ $(PERLMAKE) -f Makefile $@
+
+include $(BUILDRULES)
+
+install: default
+ifneq "$(PACKAGE_DISTRIBUTION)" "debian"
+ $(call PERL_GET_FILELIST,$(TOPDIR)/perl-pcp-logimport.list,LogImport)
+endif
+
+install_perl:
+ $(PERLMAKE) -f Makefile pure_install $(INSTALLER_OPTIONS)
+
+default_pcp: default
+
+install_pcp: install
+
diff --git a/src/perl/LogImport/LogImport.pm b/src/perl/LogImport/LogImport.pm
new file mode 100644
index 0000000..92eaba3
--- /dev/null
+++ b/src/perl/LogImport/LogImport.pm
@@ -0,0 +1,190 @@
+package PCP::LogImport;
+
+use strict;
+use warnings;
+
+require Exporter;
+require DynaLoader;
+
+our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+@ISA = qw( Exporter DynaLoader );
+@EXPORT = qw(
+ pmiStart pmiUseContext pmiEnd pmiSetHostname pmiSetTimezone
+ pmiAddMetric pmiAddInstance pmiPutValue pmiGetHandle pmiPutValueHandle
+ pmiWrite
+ pmiDump pmiErrStr pmiUnits pmiID pmiInDom
+ pmid_build pmInDom_build
+ pmiBatchPutValue pmiBatchPutValueHandle pmiBatchWrite pmiBatchEnd
+ PM_ID_NULL PM_INDOM_NULL PM_IN_NULL
+ PM_SPACE_BYTE PM_SPACE_KBYTE PM_SPACE_MBYTE PM_SPACE_GBYTE PM_SPACE_TBYTE
+ PM_TIME_NSEC PM_TIME_USEC PM_TIME_MSEC PM_TIME_SEC PM_TIME_MIN PM_TIME_HOUR
+ PM_COUNT_ONE
+ PM_TYPE_NOSUPPORT PM_TYPE_32 PM_TYPE_U32 PM_TYPE_64 PM_TYPE_U64
+ PM_TYPE_FLOAT PM_TYPE_DOUBLE PM_TYPE_STRING
+ PM_SEM_COUNTER PM_SEM_INSTANT PM_SEM_DISCRETE
+ PMI_DOMAIN
+);
+%EXPORT_TAGS = qw();
+@EXPORT_OK = qw();
+
+# set the version for version checking
+$VERSION = '1.02';
+
+# metric identification
+sub PM_ID_NULL { 0xffffffff; }
+sub PM_INDOM_NULL { 0xffffffff; }
+sub PM_IN_NULL { 0xffffffff; }
+
+# units - space scale
+sub PM_SPACE_BYTE { 0; } # bytes
+sub PM_SPACE_KBYTE { 1; } # kilobytes
+sub PM_SPACE_MBYTE { 2; } # megabytes
+sub PM_SPACE_GBYTE { 3; } # gigabytes
+sub PM_SPACE_TBYTE { 4; } # terabytes
+
+# units - time scale
+sub PM_TIME_NSEC { 0; } # nanoseconds
+sub PM_TIME_USEC { 1; } # microseconds
+sub PM_TIME_MSEC { 2; } # milliseconds
+sub PM_TIME_SEC { 3; } # seconds
+sub PM_TIME_MIN { 4; } # minutes
+sub PM_TIME_HOUR { 5; } # hours
+
+# units - count scale (for metrics such as count events, syscalls,
+# interrupts, etc - these are simply powers of ten and not enumerated here
+# (e.g. 6 for 10^6, or -3 for 10^-3).
+sub PM_COUNT_ONE { 0; } # 1
+
+# data type of metric values
+sub PM_TYPE_NOSUPPORT { 0xffffffff; } # not implemented in this version
+sub PM_TYPE_32 { 0; } # 32-bit signed integer
+sub PM_TYPE_U32 { 1; } # 32-bit unsigned integer
+sub PM_TYPE_64 { 2; } # 64-bit signed integer
+sub PM_TYPE_U64 { 3; } # 64-bit unsigned integer
+sub PM_TYPE_FLOAT { 4; } # 32-bit floating point
+sub PM_TYPE_DOUBLE { 5; } # 64-bit floating point
+sub PM_TYPE_STRING { 6; } # array of characters
+
+# semantics/interpretation of metric values
+sub PM_SEM_COUNTER { 1; } # cumulative counter (monotonic increasing)
+sub PM_SEM_INSTANT { 3; } # instantaneous value, continuous domain
+sub PM_SEM_DISCRETE { 4; } # instantaneous value, discrete domain
+
+# reserved domain (see $PCP_VAR_DIR/pmns/stdpmid)
+sub PMI_DOMAIN { 245; }
+
+# error codes
+sub PMI_ERR_DUPMETRICNAME { -20001; }
+sub PMI_ERR_DUPMETRICID { -20002; } # Metric pmID already defined
+sub PMI_ERR_DUPINSTNAME { -20003; } # External instance name already defined
+sub PMI_ERR_DUPINSTID { -20004; } # Internal instance identifer already defined
+sub PMI_ERR_INSTNOTNULL { -20005; } # Non-null instance expected for a singular metric
+sub PMI_ERR_INSTNULL { -20006; } # Null instance not allowed for a non-singular metric
+sub PMI_ERR_BADHANDLE { -20007; } # Illegal handle
+sub PMI_ERR_DUPVALUE { -20008; } # Value already assigned for singular metric
+sub PMI_ERR_BADTYPE { -20009; } # Illegal metric type
+sub PMI_ERR_BADSEM { -20010; } # Illegal metric semantics
+sub PMI_ERR_NODATA { -20011; } # No data to output
+sub PMI_ERR_BADMETRICNAME { -20012; } # Illegal metric name
+sub PMI_ERR_BADTIMESTAMP { -20013; } # Illegal result timestamp
+
+# Batch operations
+our %pmi_batch = ();
+
+sub pmiBatchPutValue($$$) {
+ my ($name, $instance, $value) = @_;
+ push @{$pmi_batch{'b'}}, [ $name, $instance, $value ];
+ return 0;
+}
+
+sub pmiBatchPutValueHandle($$) {
+ my ($handle, $value) = @_;
+ push @{$pmi_batch{'b'}}, [ $handle, $value ];
+ return 0;
+}
+
+sub pmiBatchWrite($$) {
+ my ($sec, $usec) = @_;
+ push @{$pmi_batch{"$sec.$usec"}}, @{delete $pmi_batch{'b'}};
+ return 0;
+}
+
+sub pmiBatchEnd() {
+ my ($arr, $r);
+ my $ts = -1;
+ # Iterate over the sorted hash and call pmiPutValue/pmiWrite accordingly
+ delete $pmi_batch{'b'};
+ for my $k (map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] }
+ map { [$_, /(\d+)\.(\d+)/] }
+ keys %pmi_batch) {
+ $arr = $pmi_batch{$k};
+ $ts = $k if $ts eq -1;
+ if ($k > $ts) {
+ $r = pmiWrite(split(/\./, $ts));
+ return $r if ($r != 0);
+ $ts = $k;
+ }
+ for my $v (@$arr) {
+ if (defined($v->[2])) {
+ $r = pmiPutValue($v->[0], $v->[1], $v->[2]);
+ } else {
+ $r = pmiPutValueHandle($v->[0], $v->[1]);
+ }
+ return $r if ($r != 0);
+ }
+ }
+ $r = pmiWrite(split(/\./, $ts));
+ return $r if ($r != 0);
+ %pmi_batch = ();
+ return 0;
+}
+
+bootstrap PCP::LogImport $VERSION;
+
+1; # don't forget to return a true value from the file
+
+__END__
+
+=head1 NAME
+
+PCP::LogImport - Perl module for importing performance data to create a Performance Co-Pilot archive
+
+=head1 SYNOPSIS
+
+ use PCP::LogImport;
+
+=head1 DESCRIPTION
+
+The PCP::LogImport module contains the language bindings for building
+Perl applications that import performance data from a file or real-time
+source and create a Performance Co-Pilot (PCP) archive suitable for use
+with the PCP tools.
+
+The routines in this module provide wrappers around the libpcp_import
+library.
+
+=head1 SEE ALSO
+
+pmiAddInstance(3), pmiAddMetric(3), pmiEnd(3), pmiErrStr(3),
+pmiGetHandle(3), pmiPutResult(3), pmiPutValue(3), pmiPutValueHandle(3),
+pmiStart(3), pmiSetHostname(3), pmiSetTimezone(3), pmiUnits(3),
+pmiUseContext(3) and pmiWrite(3).
+
+The PCP mailing list pcp@mail.performancecopilot.org can be used for
+questions about this module.
+
+Further details can be found at http://www.performancecopilot.org
+
+=head1 AUTHOR
+
+Ken McDonell, E<lt>kenj@internode.on.netE<gt>
+
+Copyright (C) 2010 by Ken McDonell.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License, version 2 (see
+the "COPYING" file in the PCP source tree for further details).
+
+=cut
diff --git a/src/perl/LogImport/LogImport.xs b/src/perl/LogImport/LogImport.xs
new file mode 100644
index 0000000..3ee9d2d
--- /dev/null
+++ b/src/perl/LogImport/LogImport.xs
@@ -0,0 +1,129 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <pmapi.h>
+#include <impl.h>
+#include <import.h>
+
+MODULE = PCP::LogImport PACKAGE = PCP::LogImport
+
+# helper methods
+#
+
+# name here is a little odd ... follows impl.h definition rather
+# than pmi* naming so calls from C and Perl are the same
+pmID
+pmid_build(domain, cluster, item)
+ unsigned int domain;
+ unsigned int cluster;
+ unsigned int item;
+ CODE:
+ pmID id;
+ __pmid_int(&id)->flag = 0;
+ __pmid_int(&id)->domain = domain;
+ __pmid_int(&id)->cluster = cluster;
+ __pmid_int(&id)->item = item;
+ RETVAL = id;
+ OUTPUT:
+ RETVAL
+
+# name here is a little odd ... follows impl.h definition rather
+# than pmi* naming so calls from C and Perl are the same
+pmInDom
+pmInDom_build(domain, serial)
+ unsigned int domain;
+ unsigned int serial;
+ CODE:
+ pmInDom indom;
+ __pmindom_int(&indom)->flag = 0;
+ __pmindom_int(&indom)->domain = domain;
+ __pmindom_int(&indom)->serial = serial;
+ RETVAL = indom;
+ OUTPUT:
+ RETVAL
+
+# libpcp_import wrappers
+#
+
+void
+pmiDump()
+
+pmUnits
+pmiUnits(dimSpace, dimTime, dimCount, scaleSpace, scaleTime, scaleCount)
+ int dimSpace;
+ int dimTime;
+ int dimCount;
+ int scaleSpace;
+ int scaleTime;
+ int scaleCount;
+
+pmID
+pmiID(domain, cluster, item)
+ int domain;
+ int cluster;
+ int item;
+
+pmInDom
+pmiInDom(domain, serial)
+ int domain;
+ int serial;
+
+const char *
+pmiErrStr(sts)
+ int sts;
+
+int
+pmiStart(archive, inherit)
+ char *archive;
+ int inherit;
+
+int
+pmiUseContext(context)
+ int context;
+
+int
+pmiEnd()
+
+int
+pmiSetHostname(value)
+ char *value;
+
+int
+pmiSetTimezone(value)
+ char *value;
+
+int
+pmiAddMetric(name, pmid, type, indom, sem, units)
+ const char *name;
+ pmID pmid;
+ int type;
+ pmInDom indom;
+ int sem;
+ pmUnits units;
+
+int
+pmiAddInstance(indom, instance, inst)
+ pmInDom indom;
+ const char *instance;
+ int inst;
+
+int
+pmiPutValue(name, instance, value)
+ const char *name;
+ const char *instance;
+ const char *value;
+
+int
+pmiGetHandle(name, instance)
+ const char *name;
+ const char *instance;
+
+int
+pmiPutValueHandle(handle, value)
+ int handle;
+ const char *value;
+
+int
+pmiWrite(sec, usec)
+ int sec;
+ int usec;
diff --git a/src/perl/LogImport/MANIFEST b/src/perl/LogImport/MANIFEST
new file mode 100644
index 0000000..61c6108
--- /dev/null
+++ b/src/perl/LogImport/MANIFEST
@@ -0,0 +1,7 @@
+Changes
+COPYING
+Makefile.PL
+MANIFEST
+LogImport.pm
+LogImport.xs
+typemap
diff --git a/src/perl/LogImport/Makefile.PL b/src/perl/LogImport/Makefile.PL
new file mode 100644
index 0000000..20b716d
--- /dev/null
+++ b/src/perl/LogImport/Makefile.PL
@@ -0,0 +1,49 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+my $ldfrom;
+my $inc;
+my $libs;
+my $lddlflags;
+my $cccdlflags;
+
+if ($ENV{TARGET_OS} eq "mingw") {
+ $ldfrom = "-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_import/src -L$ENV{PCP_DIR}\\local\\bin -lpcp_import -lpcp LogImport.o",
+ $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp -I$ENV{PCP_DIR}\\include\\pcp -I$ENV{PCP_DIR}\\c\\include";
+ $libs = ["-L$ENV{PCP_DIR}\\local\\bin", '-lpcp_import', '-lpcp'];
+}
+else {
+ $ldfrom = "LogImport.o",
+ $inc = "-I$ENV{PCP_TOPDIR}/src/include/pcp -I/usr/include/pcp";
+ $libs = ["-L$ENV{PCP_TOPDIR}/src/libpcp/src -L$ENV{PCP_TOPDIR}/src/libpcp_import/src -lpcp_import -lpcp"];
+}
+if ($ENV{TARGET_OS} eq "darwin") {
+ # standard ones, minus -arch ppc
+ $lddlflags = "-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup";
+}
+else {
+ $lddlflags = "-shared \$(OPTIMIZE) \$(LDFLAGS)";
+}
+if ($ENV{TARGET_OS} eq "solaris") {
+ # for OpenSolaris Makefile ends up with -KPIC instead of -fPIC otherwise
+ $cccdlflags = "-fPIC"
+}
+
+WriteMakefile(
+ NAME => 'PCP::LogImport',
+ AUTHOR => 'Ken McDonell <kenj@internode.on.net>',
+ VERSION_FROM => 'LogImport.pm', # finds $VERSION
+ ABSTRACT_FROM => 'LogImport.pm', # retrieve abstract from module
+ C => ['LogImport.c'],
+ OPTIMIZE => '-g',
+ XSPROTOARG => '-noprototypes',
+ OBJECT => 'LogImport.o',
+ DEFINE => '-DPERLIO_NOT_STDIO=0 -DPCP_VERSION -DPCP_DEBUG',
+ LDFROM => $ldfrom,
+ LDDLFLAGS => $lddlflags,
+ CCCDLFLAGS => $cccdlflags,
+ INC => $inc,
+ LIBS => $libs,
+ CC => $ENV{"CC"},
+ LD => $ENV{"CC"},
+);
diff --git a/src/perl/LogImport/typemap b/src/perl/LogImport/typemap
new file mode 100644
index 0000000..162308b
--- /dev/null
+++ b/src/perl/LogImport/typemap
@@ -0,0 +1,24 @@
+######################################################################
+# INPUT/OUTPUT maps
+# O_OBJECT -> links an opaque C object to a blessed Perl object.
+#
+TYPEMAP
+pmUnits T_INT_EQUIV
+pmID T_INT_EQUIV
+pmInDom T_INT_EQUIV
+
+######################################################################
+INPUT
+# struct or typedef that is really the same size as a 32-bit integer
+T_INT_EQUIV
+ {
+ __int32_t tmp = SvIV($arg);
+ memcpy((void *)&$var, (void *)&tmp, sizeof(__int32_t));
+ }
+
+######################################################################
+OUTPUT
+# struct or typedef that is really the same size as a 32-bit integer
+T_INT_EQUIV
+ sv_setiv($arg, *((int *)&$var));
+######################################################################
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-27 10:47:27 +0000