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>, B<$RRDp::error_mode>, B<$RRDp::error>
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 B<Note>: Due to design limitations, B<RRDp::cmd> does not support the
49 C<graph -> command - use C<graphv -> instead.
51 =item $answer = B<RRDp::read>
53 read RRDtool's response to your command. Note that the $answer variable will
54 only contain a pointer to the returned data. The reason for this is, that
55 RRDtool can potentially return quite excessive amounts of data
56 and we don't want to copy this around in memory. So when you want to
57 access the contents of $answer you have to use $$answer which dereferences
58 the variable.
60 =item $status = B<RRDp::end>
62 terminates RRDtool and returns RRDtool's status ...
64 =item B<$RRDp::user>, B<$RRDp::sys>, B<$RRDp::real>
66 these variables will contain totals of the user time, system time and
67 real time as seen by RRDtool. User time is the time RRDtool is
68 running, System time is the time spend in system calls and real time
69 is the total time RRDtool has been running.
71 The difference between user + system and real is the time spent
72 waiting for things like the hard disk and new input from the Perl
73 script.
75 =item B<$RRDp::error_mode> and B<$RRDp::error>
77 If you set the variable $RRDp::error_mode to the value 'catch' before you run RRDp::read a potential
78 ERROR message will not cause the program to abort but will be returned in this variable. If no error
79 occurs the variable will be empty.
81 $RRDp::error_mode = 'catch';
82 RRDp::cmd qw(info file.rrd);
83 print $RRDp::error if $RRDp::error;
85 =back
88 =head1 EXAMPLE
90 use RRDp;
91 RRDp::start "/usr/local/bin/rrdtool";
92 RRDp::cmd qw(create demo.rrd --step 100
93 DS:in:GAUGE:100:U:U
94 RRA:AVERAGE:0.5:1:10);
95 $answer = RRDp::read;
96 print $$answer;
97 ($usertime,$systemtime,$realtime) = ($RRDp::user,$RRDp::sys,$RRDp::real);
99 =head1 SEE ALSO
101 For more information on how to use RRDtool, check the manpages.
103 =head1 AUTHOR
105 Tobias Oetiker <tobi@oetiker.ch>
107 =cut
109 #' this is to make cperl.el happy
111 use strict;
112 use Fcntl;
113 use Carp;
114 use IO::Handle;
115 use IPC::Open2;
116 use vars qw($Sequence $RRDpid $VERSION);
117 my $Sequence;
118 my $RRDpid;
120 # Prototypes
122 sub start ($);
123 sub cmd (@);
124 sub end ();
125 sub read ();
127 $VERSION=1.4003;
129 sub start ($){
130 croak "rrdtool is already running"
131 if defined $Sequence;
132 $Sequence = 'S';
133 my $rrdtool = shift @_;
134 $RRDpid = open2 \*RRDreadHand,\*RRDwriteHand, $rrdtool,"-"
135 or croak "Can't Start rrdtool: $!";
136 RRDwriteHand->autoflush(); #flush after every write
137 fcntl RRDreadHand, F_SETFL,O_NONBLOCK|O_NDELAY; #make readhandle NON BLOCKING
138 return $RRDpid;
139 }
142 sub read () {
143 croak "RRDp::read can only be called after RRDp::cmd"
144 unless $Sequence eq 'C';
145 $RRDp::error = undef;
146 $Sequence = 'R';
147 my $inmask = 0;
148 my $srbuf;
149 my $minibuf;
150 my $buffer;
151 my $nfound;
152 my $timeleft;
153 vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
154 while (1) {
155 my $rout;
156 $nfound = select($rout=$inmask,undef,undef,2);
157 if ($nfound == 0 ) {
158 # here, we could do something sensible ...
159 next;
160 }
161 sysread(RRDreadHand,$srbuf,4096);
162 $minibuf .= $srbuf;
163 while ($minibuf =~ s|^(.+?)\n||s) {
164 my $line = $1;
165 # print $line,"\n";
166 $RRDp::error = undef;
167 if ($line =~ m|^ERROR|) {
168 $RRDp::error_mode eq 'catch' ? $RRDp::error = $line : croak $line;
169 $RRDp::sys = undef;
170 $RRDp::user = undef;
171 $RRDp::real = undef;
172 return undef;
173 }
174 elsif ($line =~ m|^OK(?: u:([\d\.]+) s:([\d\.]+) r:([\d\.]+))?|){
175 ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
176 return \$buffer;
177 } else {
178 $buffer .= $line. "\n";
179 }
180 }
181 }
182 }
184 sub cmd (@){
185 croak "RRDp::cmd can only be called after RRDp::read or RRDp::start"
186 unless $Sequence eq 'R' or $Sequence eq 'S';
187 $Sequence = 'C';
188 my $cmd = join " ", @_;
189 if ($Sequence ne 'S') {
190 }
191 $cmd =~ s/\n/ /gs;
192 $cmd =~ s/\s/ /gs;
194 # The generated graphs aren't necessarily terminated by a newline,
195 # causing RRDp::read() to wait for a line matching '^OK' forever.
196 if ($cmd =~ m/^\s*graph\s+-\s+/) {
197 croak "RRDp does not support the 'graph -' command - "
198 . "use 'graphv -' instead";
199 }
200 print RRDwriteHand "$cmd\n";
201 }
203 sub end (){
204 croak "RRDp::end can only be called after RRDp::start"
205 unless $Sequence;
206 close RRDwriteHand;
207 close RRDreadHand;
208 $Sequence = undef;
209 waitpid $RRDpid,0;
210 return $?
211 }
213 1;