1 package RRDp;
3 =head1 NAME
5 RRDp - Attach RRDtool from within a perl script via a set of pipes;
7 =head1 SYNOPSIS
9 use B<RRDp>
11 B<RRDp::start> I<path to RRDtool executable>
13 B<RRDp::cmd> I<rrdtool commandline>
15 $answer = B<RRD::read>
17 $status = B<RRD::end>
19 B<$RRDp::user>, B<$RRDp::sys>, B<$RRDp::real>
21 =head1 DESCRIPTION
23 With this module you can safely communicate with the RRDtool.
25 After every B<RRDp::cmd> you have to issue an B<RRDp::read> command to get
26 B<RRDtool>s answer to your command. The answer is returned as a pointer,
27 in order to speed things up. If the last command did not return any
28 data, B<RRDp::read> will return an undefined variable.
30 If you import the PERFORMANCE variables into your namespace,
31 you can access RRDtool's internal performance measurements.
33 =over 8
35 =item use B<RRDp>
37 Load the RRDp::pipe module.
39 =item B<RRDp::start> I<path to RRDtool executable>
41 start RRDtool. The argument must be the path to the RRDtool executable
43 =item B<RRDp::cmd> I<rrdtool commandline>
45 pass commands on to RRDtool. check the RRDtool documentation for
46 more info on the RRDtool commands.
48 =item $answer = B<RRDp::read>
50 read RRDtool's response to your command. Note that the $answer variable will
51 only contain a pointer to the returned data. The reason for this is, that
52 RRDtool can potentially return quite excessive amounts of data
53 and we don't want to copy this around in memory. So when you want to
54 access the contents of $answer you have to use $$answer which dereferences
55 the variable.
57 =item $status = B<RRDp::end>
59 terminates RRDtool and returns RRDtool's status ...
61 =item B<$RRDp::user>, B<$RRDp::sys>, B<$RRDp::real>
63 these variables will contain totals of the user time, system time and
64 real time as seen by RRDtool. User time is the time RRDtool is
65 running, System time is the time spend in system calls and real time
66 is the total time RRDtool has been running.
68 The difference between user + system and real is the time spent
69 waiting for things like the hard disk and new input from the perl
70 script.
72 =back
75 =head1 EXAMPLE
77 use RRDp;
78 RRDp::start "/usr/local/bin/rrdtool";
79 RRDp::cmd qw(create demo.rrd --step 100
80 DS:in:GAUGE:100:U:U
81 RRA:AVERAGE:0.5:1:10);
82 $answer = RRDp::read;
83 print $$answer;
84 ($usertime,$systemtime,$realtime) = ($RRDp::user,$RRDp::sys,$RRDp::real);
86 =head1 SEE ALSO
88 For more information on how to use RRDtool, check the manpages.
90 =head1 AUTHOR
92 Tobias Oetiker <oetiker@ee.ethz.ch>
94 =cut
95 #' this is to make cperl.el happy
97 use strict;
98 use Fcntl;
99 use Carp;
100 use IO::Handle;
101 use IPC::Open2;
102 use vars qw($Sequence $RRDpid $VERSION);
103 my $Sequence;
104 my $RRDpid;
106 # Prototypes
108 sub start ($);
109 sub cmd (@);
110 sub end ();
111 sub read ();
113 $VERSION=1.2007;
115 sub start ($){
116 croak "rrdtool is already running"
117 if defined $Sequence;
118 $Sequence = 'S';
119 my $rrdtool = shift @_;
120 $RRDpid = open2 \*RRDreadHand,\*RRDwriteHand, $rrdtool,"-"
121 or croak "Can't Start rrdtool: $!";
122 RRDwriteHand->autoflush(); #flush after every write
123 fcntl RRDreadHand, F_SETFL,O_NONBLOCK|O_NDELAY; #make readhandle NON BLOCKING
124 return $RRDpid;
125 }
128 sub read () {
129 croak "RRDp::read can only be called after RRDp::cmd"
130 unless $Sequence eq 'C';
131 $Sequence = 'R';
132 my $inmask = 0;
133 my $srbuf;
134 my $minibuf;
135 my $buffer;
136 my $nfound;
137 my $timeleft;
138 my $ERR = 0;
139 vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
140 while (1) {
141 my $rout;
142 $nfound = select($rout=$inmask,undef,undef,2);
143 if ($nfound == 0 ) {
144 # here, we could do something sensible ...
145 next;
146 }
147 sysread(RRDreadHand,$srbuf,4096);
148 $minibuf .= $srbuf;
149 while ($minibuf =~ s|^(.+?)\n||s) {
150 my $line = $1;
151 # print $line,"\n";
152 if ($line =~ m|^ERROR|) {
153 croak $line;
154 $ERR = 1;
155 }
156 elsif ($line =~ m|^OK u:([\d\.]+) s:([\d\.]+) r:([\d\.]+)|){
157 ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
158 return $ERR == 1 ? undef : \$buffer;
159 } else {
160 $buffer .= $line. "\n";
161 }
162 }
163 }
164 }
166 sub cmd (@){
167 croak "RRDp::cmd can only be called after RRDp::read or RRDp::start"
168 unless $Sequence eq 'R' or $Sequence eq 'S';
169 $Sequence = 'C';
170 my $cmd = join " ", @_;
171 if ($Sequence ne 'S') {
172 }
173 $cmd =~ s/\n/ /gs;
174 $cmd =~ s/\s/ /gs;
175 print RRDwriteHand "$cmd\n";
176 }
178 sub end (){
179 croak "RRDp::end can only be called after RRDp::start"
180 unless $Sequence;
181 close RRDwriteHand;
182 close RRDreadHand;
183 $Sequence = undef;
184 waitpid $RRDpid,0;
185 return $?
186 }
188 1;