1#!/usr/bin/perl -w
2#
3# bacula report generation
4#
5# (C) Arno Lehmann 2005
6# IT-Service Lehmann
7#
8
9#
10# Usage: See funtion print_usage
11# or use this script with option --help
12#
13# Version history:
14#
15# 0.2     publicly available, works reliable
16# 0.3     increasing weight of No. of tapes in guess reliability
17#         and including tape capacity guessing when no volumes in subpool
18#         using default values from temp. table
19
20use strict;
21use DBI;
22use Getopt::Long;
23use Math::BigInt;
24
25my $version="0.3";
26$0 =~ /.*\/([^\/]*)$/;
27my $ME = $1;
28
29my $debug = 0;
30my $db_host = "";
31my $db_user = "bacula";
32my $db_database = "mysql:bacula";
33my $db_pass = "";
34
35my $do_usage = "";
36my $do_version = "";
37
38my @temp_tables;
39
40my @the_pools;
41
42my $out_pooldetails = "";
43my $out_bargraph = 1;
44my $out_bargraphlen = 70;
45my $out_subpools = "";
46my $out_subpooldetails = "";
47my $out_subbargraph = "";
48my $out_cutmarks = "";
49
50# This is the data we're interested in:
51# In this array we have a hash reference to each Pool.
52# A pool consists of a hash having
53#  Name
54#  Id
55#  BytesTotal
56#  VolumesTotal
57#  VolumesFull (This is State Full
58#  VolumesEmpty (This is Purged and Recycle)
59#  VolumesPartly (Append)
60#  VolumesAway (Archive, Read-Only)
61#  VolumesOther (Busy, Used)
62#  VolumesOff (Disabled, Error)
63#  VolumesCleaning
64#  BytesFree
65#  GuessReliability (This is the weighted average of the Reliability
66#    of all the Media Type Guesses in this Pool)
67#  MediaTypes is an array of references to hashes for collected
68#    information for all the Media Types in this pool.
69#    This has the same as the pools summary and adds
70#   MediaType The String
71#   AvgFullBytes (The Avg. Number of Bytes per full Volume)
72#   BytesFreeEmpty (The estimated Free Bytes on Empty Volumes)
73#   BytesFreePartly
74#
75# We use: $the_pools[0]->MediaTypes[0]->{MediaType} or
76#         $the_pools[1]->Id
77# I hope you get the point. I hope I do.
78
79Getopt::Long::Configure("bundling");
80GetOptions("host=s"=>\$db_host,
81           "user|U=s"=>\$db_user,
82           "database|D=s"=>\$db_database,
83           "password|P=s"=>\$db_pass,
84           "debug=i"=>\$debug,
85           "help|h"=>\$do_usage,
86           "version|V"=>\$do_version,
87           "subpools|s"=>\$out_subpools,
88           "subpool-details"=>\$out_subpooldetails,
89           "pool-details|d"=>\$out_pooldetails,
90           "pool-bargraph!"=>\$out_bargraph,
91           "bar-length|l=i"=>\$out_bargraphlen,
92           "cutmarks|c"=>\$out_cutmarks,
93           "subpool-bargraph"=>\$out_subbargraph
94           );
95
96debug_out(100, "I've got
97host: $db_host
98user: $db_user
99database: $db_database
100password: $db_pass
101debug: $debug
102help: $do_usage
103version: $do_version
104output requested:
105  pool details: $out_pooldetails
106  subpools: $out_subpools
107  subpool details: $out_subpooldetails
108  bargraph: $out_bargraph
109  subpool bargraph: $out_subbargraph
110  bar length: $out_bargraphlen
111  cutmarks: $out_cutmarks
112I was called as $0 and am version $version.
113Was that helpful?");
114
115if ($do_usage) {
116    do_usage();
117    exit 1;
118}
119if ($do_version) {
120    do_version();
121    exit 1;
122}
123
124$out_subpools = 1 if ($out_subpooldetails);
125$out_subpools = 1 if ($out_subbargraph);
126$out_bargraphlen = 70 if (15 > $out_bargraphlen);
127$out_bargraphlen = 70 if (200 < $out_bargraphlen);
128$out_bargraph = 1 if (! $out_pooldetails);
129
130debug_out(100, "Output options after dependencies:
131  pool details: $out_pooldetails
132  subpools: $out_subpools
133  subpool details: $out_subpooldetails
134  bargraph: $out_bargraph
135  subpool bargraph: $out_subbargraph
136  bar length: $out_bargraphlen
137  cutmarks: $out_cutmarks
138");
139
140my (undef, $min, $hour, $mday, $mon, $year) = localtime();
141$year += 1900;
142$mon = sprintf("%02i", $mon+1);
143$mday = sprintf("%02i", $mday);
144$min = sprintf("%02i", $min);
145$hour = sprintf("%02i", $hour);
146print "bacula volume / pool status report $year-$mon-$mday $hour:$min\n",
147    "Volumes Are Full, Other, Append, Empty, aWay or X (error)\n";
148my $dbconn = "dbi:" . $db_database;
149$dbconn .= "\@" . $db_host if $db_host;
150debug_out(40, "DBI connect with $dbconn");
151
152my $h_db = DBI->connect($dbconn,
153                        $db_user, $db_pass,
154                        { PrintError => 0,
155                          AutoCommit => 1 }
156                        ) || die DBI::errstr;
157debug_out(10, "Have database connection $h_db");
158
159debug_out(100, "creating temp tables...");
160
161$h_db->do("CREATE TABLE alrep_M(PoolId INT(10) UNSIGNED,MediaType TINYBLOB)") || debug_abort(0, "Can't create temp table alrep_M - another script running?");
162unshift  @temp_tables, "alrep_M";
163debug_out(45, "Table alrep_M created.");
164
165
166debug_out(40, "All tables done.");
167
168debug_out(40, "Filling temp tables...");
169if ($h_db->do("INSERT INTO alrep_M SELECT Pool.PoolId,Media.MediaType FROM Pool,Media WHERE Pool.PoolId=Media.PoolId GROUP BY PoolId,MediaType")) {
170    debug_out(45, "PoolId-MediaType table populated.");
171} else {
172    debug_abort(0, "Couldn't populate PoolId and MediaType table alrep_M.");
173}
174
175debug_out(40, "All tables done.");
176
177debug_out(40, "Getting Pool Names.");
178my $h_st = $h_db->prepare("SELECT Name,PoolId FROM Pool ORDER BY Name") ||
179    debug_abort(0, "Couldn't get Pool Information.", $h_db->errstr());
180$h_st->execute() || debug_abort(0, "Couldn't query Pool information.",
181                                $h_db->errstr());
182my $pools;
183while ($pools=$h_st->fetchrow_hashref()) {
184    process_pool($pools->{Name}, $pools->{PoolId})
185}
186debug_out(10, "All Pool data collected.");
187debug_out(7, "Pools analyzed: $#the_pools.");
188debug_out(10, "Going to print...");
189
190my $pi;
191for $pi (@the_pools) {
192    output_pool($pi);
193}
194
195debug_out(10, "Program terminates normally.");
196do_closedb();
197debug_out(10, "Finishing.");
198exit 0;
199
200=pod
201
202=head1 NAME
203
204baculareport.pl - a script to produce some bacula reports out of
205the catalog database.
206
207=head1 SYNTAX
208
209B<baculareport.pl> B<--help>|B<-h>
210
211B<baculareport.pl> B<--version>|B<-V>
212
213B<baculareport.pl> [B<--host> I<Hostname>] [B<--user>|B<-U> I<Username>]
214[B<--database>|B<-D> I<Database>] [B<--password>|B<-P> I<Password>]
215[B<--debug> I<Level>] [B<--pool-details>|B<-d>]
216[B<--pool-bargraph>|B<--nopool-bargraph>] [B<--subpools>|B<-s>]
217[B<--subpool-details>] [B<--subpool-bargraph>] [B<--bar-length>|B<-l>
218I<Length>] [B<--cutmarks>|B<-c>]
219
220The long options can be abbreviated, as long as they remain unique.
221Short options (and values) can be grouped, for more information see
222B<perldoc Getopt::Long>.
223
224=head1 DESCRIPTION
225
226B<baculareport.pl> accesses the catalog used by the backup program bacula
227to produce some report about pool and volume usage.
228
229The command line options B<--host> I<host>, B<--user> or B<-U>
230I<user>, B<--database> or B<-D> and B<--password> or B<-P> define the
231database to query. See below for security considerations concerning
232databse passwords.
233
234The I<database> must be given in perl's B<DBI>-syntax, as in
235I<mysql:bacula>. Currently, only MySQL is supported, though PostgreSQL
236should work with only minor modifications to B<baculareport.pl>.
237
238Output of reports is controlled using the command-line switches
239B<--*pool*>, B<--bar-length> and B<--cutmarks> or there one-letter
240equivalents.
241
242The report for a pool can contain a one-line overview of the volumes
243in that pool, giving the numbers of volumes in different states, the
244total bytes stored and an estimate of the available capacity.
245
246The estimated consists of a percentage describing the reliability of
247this estimate and the guessed free capacity.
248
249A visual representation of the pools state represented as a bar graph,
250together with the number of full, appendable and free volumes is the
251default report.
252
253The length of this graph can be set with B<--bar-length> or B<-l>
254I<length in characters>.
255
256As a pool can contain volumes of different media type, the report's
257output can include the information about those collections of volumes
258called subpools in B<baculareport.pl>s documentation.
259
260The subpool overview data presents the same information about the
261volumes the pool details have, but includes the media type and excludes
262the free capacity guess.
263
264Subpool details report the average amount of data on full volumes,
265together with what is estimated to be available on appendable and empty
266volumes. A measurement on the reliability of this estimate is given as a
267percent value. See below in L<"CAPACITY GUESSING"> for more
268information.
269
270Finally, a bar graph representing this subpools fill-level can be printed.
271For easier overview it is scaled like the pools bargraph.
272
273B<--cutmarks> or B<-c> prints some marks above each pool report to
274make cutting the report easier if you want to file it.
275
276Sample reports are in L<"SAMPLE REPORTS">.
277
278The B<--debug>-option activates debug output. Without understanding the
279source code this will not be helpful. See below L<"DEBUG OUTPUT">.
280
281=head1 DATABASE ACCESS AND SECURITY
282
283baculareport.pl needs access to baculas catalog. This might introduce
284a security risk if the database access password is published to people who
285shouldn't know it, but need to create reports.
286
287The solution is to set up a database account which can only read from
288baculas catalog. Use your favorite database administration tool for
289this.
290
291Command line passing of the password is also not really secure - anybody
292with sufficient access rights can read the command line etc. So, if you use this script on a multi-user machine, you are well advised to
293
294=over 4
295
296=item 1.
297
298I<use a special, limited database account for catalog access>, or
299
300=item 2.
301
302I<modify the hard-coded default database password to the one
303you have set.>
304
305=back
306
307This should limit security risks to a minimum.
308
309If B<baculareport.pl> is used by your backup admin only, don't bother
310- she has access to all your data anyway. (B<No. Please not. This was
311just a joke!>)
312
313=head1 SAMPLE REPORTS
314
315The reports can be customized using the above explained command line switches.
316Some examples are:
317
318    bacula volume / pool status report 2005-01-18 23:40
319    Volumes Are Full, Other, Append, Empty, aWay or X (error)
320
321    Pool           Diff
322      ######################################################----------------
323      |0%          |20%          |40%          |60%          |80%      100%|
324      48.38GB used                                     Rel: 24% free 13.88GB
325      17 F Volumes                                       3 A and 4 E Volumes
326
327    Pool           Full
328      #######################################-------------------------------
329      |0%          |20%          |40%          |60%          |80%      100%|
330      310.66GB used                                   Rel: 58% free 241.64GB
331      43 F Volumes                                      2 A and 14 E Volumes
332
333    Pool           Incr
334      #######################################################---------------
335      |0%          |20%          |40%          |60%          |80%      100%|
336      28.51GB used                                Rel: 0% (def.) free 7.61GB
337      0 F Volumes                                        3 A and 4 E Volumes
338
339    Pool        TMPDisk
340      Nothing to report.
341
342This is the sort of report you get when you use this script without
343any special output options. After a short header, for all pools in
344the catalog a graphic representation of its usage is
345printed. Below that, you find some essential information: The
346capacity used, a guess of the remaining capacity (see
347L<"CAPACITY GUESSING"> below), and
348an overview of the volumes: Here, in pool Incr we have no full
349volumes, 3 appendable ones and 4 empty volumes.
350
351In this example, the pool TMPDisk does not contain anything which can
352be reported.
353
354Following you have an example with all output options set.
355
356      -                                                 -
357  Pool           Incr
358    ###################################################----
359    |0%          |25%          |50%         |75%      100%|
360    10 Volumes (2 F, 0 O, 2 A, 6 E, 0 W, 0 X) Total 59.64GB Rel: 29% avail.: 4.57GB
361       Details by Mediatype:
362       DDS1 (0 F, 0 O, 1 A, 4 E, 0 W, 0 X) Total 4.53GB
363       ####
364       |0%         |25%         |50%         |75%     100%|
365       Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0%
366       DDS2 (0 F, 0 O, 0 A, 2 E, 0 W, 0 X) Total 0.00B
367       Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0%
368       DLTIV (2 F, 0 O, 1 A, 0 E, 0 W, 0 X) Total 55.11GB
369       #############################################----
370       |0%         |25%         |50%         |75%     100%|
371       Avg, avail. Partly, Empty, Total, Rel.: 19.89GB 4.57GB N/A 4.57GB 96%
372      -                                                 -
373  Pool        TMPDisk
374    Nothing to report.
375    1 Volumes (0 F, 0 O, 0 A, 1 E, 0 W, 0 X) Total 0.00B Rel: 0% avail.: 0.00B
376       Details by Mediatype:
377       File (0 F, 0 O, 0 A, 1 E, 0 W, 0 X) Total 0.00B
378       Nothing to report.
379       Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0%
380
381Cut marks are included for easier cutting in case you want to file the
382printed report. Then, the length of the bar graphs was changed.
383
384More detail for the pools is shown: Not only the overwiev graphics,
385but also a listing of the status of all media in this
386pool, followed by the reliability of the guess of available
387capacity and the probable available capacity itself.
388
389After this summary you find a similar report for all media types in
390this pool. Here, the media type starts the details line. The next
391line is a breakdown of the capacity inside this subpool: The
392average capacity of the full volumes, followed by the probable
393available capacity on appendable and empty volumes. Total is the
394probable free capacity on these volumes, and Rel is the
395reliability of the capacity guessing.
396
397Note that some of the items are not always displayed: A pool or
398subpool with no bytes in it will not have a bar graph, and some of
399the statistical data is marked as N/A for not available.
400
401The above output was generated with the following command:
402
403B<< C<<
404 baculareport.pl --password <yestherewasapassword>\
405 --pool-bargraph  --pool-details --subpools\
406 --subpool-details --subpool-bargraph --bar-length 55\
407 --cutmarks >> >>
408
409The following command would have given the same output:
410
411B<< C<<
412 baculareport.pl -P <therightpassphrase> -csdl55\
413 --subpool-d --subpool-b >> >>
414
415=head1 CAPACITY GUESSING
416
417For empty and appendable volumes, the average capacity of the full
418volumes is used as the base for estimating what can be
419stored. This usually depends heavily on the type of data to store,
420and of course this works only with volumes of the same nominal
421capacity.
422
423The reliability of all this guesswork is expressed based on the
424standard deviation among the full volumes, scaled to percent. 100%
425is a very reliable estimate (Note: NOT absolutely reliable!) while
426a small percentage (from personal experience: below 60-70 percent)
427means that you shouldn't rely on the reported available data storage.
428
429To determine the overall reliability in a pool, the reliabilites of
430the subpools are weighted - a subpool with many volumes has a higer
431influence on overall reliability.
432
433Keep in mind that the reported free capacities and reliabilities can
434only be a help and don't rely on these figures alone. Keep enough
435spare tapes available!
436
437Default capacities for some media types are included now. Consider this
438feature a temporarily kludge - At the moment, there is a very simple
439media capacity guessing implemented. Search for the function
440`get_default_bytes' and modify it to your needs.
441
442In the future, I expect some nominal volume capacity knowledge inside
443baculas catalog, and when this is available, that data will be used.
444
445Capacity estimates with defaults in the calculation are marked with
446B<(def.)> after the reliability percentage. If you see B<0% (def.)>
447only the defaults are used because no full tapes were available.
448
449=head1 DEBUG OUTPUT
450
451Debugging, or more generally verbose output, is activated by the
452--debug <level> command switch.
453
454The higher the level, the more output you get.
455
456Currently, levels 10 and up are real debugging output.  Levels above
457100 are not used. I<With debug level 100 (and above) the database
458password is printed!>
459
460The debug levels used are:
461
462=over 4
463
464=item 1
465
466Some warnings are printed.
467
468=item 10
469
470Program Flow is reported.
471
472=item 15
473
474More detailed Program flow, for example loops.
475
476=item 40
477
478Database actions are printed.
479
480=item 45
481
482Table actions are reported.
483
484=item 48
485
486Even more database activity.
487
488=item 100
489
490All internal state data is printed. Beware: This includes the database
491password!
492
493=back
494
495=head1 BUGS
496
497Probably many. If you find one, notify the author. Better: notify me
498how to correct it.
499
500Currently this script works only with MySQL and catalog version 8
501(probably older versions as well, but that is untested).
502
503=head1 AUTHOR
504
505Arno Lehmann al@its-lehmann.de
506
507=head1 LICENSE
508
509This is copyrighted work: (C) 2005 Arno Lehmann IT-Service Lehmann
510
511Use, modification and (re-)distribution are allowed provided this
512license and the names of all contributing authors are included.
513
514No author or contributor gives any warranty on this script. If you
515want to use it, you are all on your own. Please read the documentation,
516and, if you feel unsure, read and understand the sourcecode.
517
518The terms and idea of the GNU GPL, version 2 or, at you option, any
519later version, apply. See http://www.fsf.org.
520
521You can contact the author using the above email address. I will try to
522answer any question concerning this script, but still - no promises!
523
524Bacula is (C) copyright 2000-2006 Free Software Foundation Europe e.V.  See http://www.bacula.org.
525
526(Bacula consulting available.)
527
528=cut
529
530sub process_pool {
531    my %pool = (BytesTotal=>0,
532                VolumesTotal=>0,
533                VolumesFull=>0,
534                VolumesEmpty=>0,
535                VolumesPartly=>0,
536                VolumesAway=>0,
537                VolumesOther=>0,
538                VolumesOff=>0,
539                VolumesCleaning=>"Not counted",
540                BytesFree=>0,
541                GuessReliability=>0,
542                AvgFullUsesDefaults=>""
543                );
544    debug_out(10, "Working on Pool $pools->{Name}.");
545    $pool{Name} = shift;
546    $pool{Id} = shift;
547    my @subpools;
548
549    debug_out(30, "Pool $pool{Name} is Id $pool{Id}.");
550    my $h_st = $h_db->prepare("SELECT MediaType FROM alrep_M WHERE
551    PoolId = $pool{Id} ORDER BY MediaType") ||
552        debug_abort(0,
553                    "Can't query Media table.", $h_st->errstr());
554    $h_st->execute() ||
555        debug_abort(0,
556                    "Can't get Media Information", $h_st->errstr());
557    while (my $mt=$h_st->fetchrow_hashref()) {
558# In this loop, we process one media type in a pool
559        my %subpool = (MediaType=>$mt->{MediaType});
560        debug_out(45, "Working on MediaType $mt->{MediaType}.");
561        my $h_qu =
562            $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes," .
563                           "STD(VolBytes) AS Std,AVG(VolBytes) AS Avg " .
564                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
565                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
566                           ") AND (VolStatus=\'Full\')")
567                || debug_abort(0,
568                               "Can't query Media Summary Information by MediaType.",
569                               $h_db->errstr());
570        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
571        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Full");
572        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
573                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
574        $h_qu->execute();
575        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
576# Don't know why, but otherwise the handle access
577# methods result in a warning...
578        $^W = 0;
579        if (1 == $h_qu->rows()) {
580            if (my $qr = $h_qu->fetchrow_hashref) {
581                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
582                $subpool{VolumesFull} = $qr->{Nr};
583                $subpool{VolumesTotal} += $qr->{Nr};
584                $subpool{BytesTotal} = $qr->{Bytes} if (defined($qr->{Bytes}));
585                if (defined($qr->{Bytes}) && (0 < $qr->{Bytes}) &&
586                    (0 < $qr->{Nr})) {
587                    $subpool{AvgFullBytes} = int($qr->{Bytes} / $qr->{Nr});
588                } else {
589                    $subpool{AvgFullBytes} = get_default_bytes($mt->{MediaType});
590                    $subpool{AvgFullUsesDefaults} = 1;
591                }
592                if (defined($qr->{Std}) &&
593                    defined($qr->{Avg}) &&
594                    (0 < $qr->{Avg})) {
595#                   $subpool{GuessReliability} = 100-(100*$qr->{Std}/$qr->{Avg});
596                    $subpool{GuessReliability} =
597                        100 -                    # 100 Percent minus...
598                            ( 100 *              # Percentage of
599                              ( $qr->{Std}/$qr->{Avg} ) *  # V
600                              ( 1 - 1 / $qr->{Nr} )        # ... the more tapes
601                                                           # the better the guess
602                              );
603                } else {
604                    $subpool{GuessReliability} = 0;
605                }
606            } else {
607                debug_out(1, "Can't get Media Summary Information by MediaType.",
608                            $h_qu->errstr());
609                $subpool{VolumesFull} = 0;
610                $subpool{BytesTotal} = 0;
611                $subpool{GuessReliability} = 0;
612                $subpool{AvgFullBytes} = -1;
613            }
614        } else {
615            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
616        }
617        $^W = 1;
618# Here, Full Media are done
619        debug_out(15, "Full Media done. Now Empty ones.");
620        $h_qu =
621            $h_db->prepare("SELECT COUNT(*) AS Nr " .
622                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
623                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
624                           ") AND ((VolStatus=\'Purged\') OR " .
625                           "(VolStatus=\'Recycle\'))")
626                || debug_abort(0,
627                               "Can't query Media Summary Information by MediaType.",
628                               $h_db->errstr());
629        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
630        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged");
631        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
632                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
633        $h_qu->execute();
634        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
635# Don't know why, but otherwise the handle access
636# methods result in a warning...
637        $^W = 0;
638        if (1 == $h_qu->rows()) {
639            if (my $qr = $h_qu->fetchrow_hashref) {
640                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
641                $subpool{VolumesEmpty} = $qr->{Nr};
642                $subpool{VolumesTotal} += $qr->{Nr};
643                if (($subpool{AvgFullBytes} > 0) && ($qr->{Nr} > 0)) {
644                    $subpool{BytesFreeEmpty} = $qr->{Nr} * $subpool{AvgFullBytes};
645                } else {
646                    $subpool{BytesFreeEmpty} = -1;
647                }
648            } else {
649                debug_out(1, "Can't get Media Summary Information by MediaType.",
650                            $h_qu->errstr());
651                $subpool{VolumesEmpty} = 0;
652                $subpool{BytesFreeEmpty} = 0;
653            }
654        } else {
655            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
656        }
657        $^W = 1;
658# Here, Empty Volumes are processed.
659
660        debug_out(15, "Empty Media done. Now Partly filled ones.");
661        $h_qu =
662            $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " .
663                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
664                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
665                           ") AND (VolStatus=\'Append\')")
666                || debug_abort(0,
667                               "Can't query Media Summary Information by MediaType.",
668                               $h_db->errstr());
669        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
670        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Append");
671        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
672                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
673        $h_qu->execute();
674        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
675# Don't know why, but otherwise the handle access
676# methods result in a warning...
677        $^W = 0;
678        if (1 == $h_qu->rows()) {
679            if (my $qr = $h_qu->fetchrow_hashref) {
680                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
681                $subpool{VolumesPartly} = $qr->{Nr};
682                $subpool{VolumesTotal} += $qr->{Nr};
683                $subpool{BytesTotal} += $qr->{Bytes};
684                if (($subpool{AvgFullBytes} > 0) && ($qr->{Nr} > 0)) {
685                    $subpool{BytesFreePartly} = $qr->{Nr} * $subpool{AvgFullBytes} - $qr->{Bytes};
686                    $subpool{BytesFreePartly} = $qr->{Nr} if $subpool{BytesFreePartly} < 1;
687                } else {
688                    $subpool{BytesFreePartly} = -1;
689                }
690            } else {
691                debug_out(1, "Can't get Media Summary Information by MediaType.",
692                            $h_qu->errstr());
693                $subpool{VolumesPartly} = 0;
694                $subpool{BytesFreePartly} = 0;
695            }
696        } else {
697            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
698        }
699        $^W = 1;
700# Here, Partly filled volumes are done
701
702        debug_out(15, "Partly Media done. Now Away ones.");
703        $h_qu =
704            $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " .
705                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
706                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
707                           ") AND ((VolStatus=\'Archive\') OR " .
708                           "(VolStatus=\'Read-Only\'))")
709                || debug_abort(0,
710                               "Can't query Media Summary Information by MediaType.",
711                               $h_db->errstr());
712        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
713        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged");
714        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
715                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
716        $h_qu->execute();
717        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
718# Don't know why, but otherwise the handle access
719# methods result in a warning...
720        $^W = 0;
721        if (1 == $h_qu->rows()) {
722            if (my $qr = $h_qu->fetchrow_hashref) {
723                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
724                $subpool{VolumesAway} = $qr->{Nr};
725                $subpool{VolumesTotal} += $qr->{Nr};
726                $subpool{BytesTotal} += $qr->{Bytes};
727            } else {
728                debug_out(1, "Can't get Media Summary Information by MediaType.",
729                            $h_qu->errstr());
730                $subpool{VolumesAway} = 0;
731            }
732        } else {
733            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
734        }
735        $^W = 1;
736# Here, Away Volumes are processed.
737
738        debug_out(15, "Away Media done. Now Other ones.");
739        $h_qu =
740            $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " .
741                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
742                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
743                           ") AND ((VolStatus=\'Busy\') OR " .
744                           "(VolStatus=\'Used\'))")
745                || debug_abort(0,
746                               "Can't query Media Summary Information by MediaType.",
747                               $h_db->errstr());
748        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
749        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged");
750        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
751                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
752        $h_qu->execute();
753        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
754# Don't know why, but otherwise the handle access
755# methods result in a warning...
756        $^W = 0;
757        if (1 == $h_qu->rows()) {
758            if (my $qr = $h_qu->fetchrow_hashref) {
759                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
760                $subpool{VolumesOther} = $qr->{Nr};
761                $subpool{VolumesTotal} += $qr->{Nr};
762                $subpool{BytesTotal} += $qr->{Bytes};
763            } else {
764                debug_out(1, "Can't get Media Summary Information by MediaType.",
765                            $h_qu->errstr());
766                $subpool{VolumesOther} = 0;
767            }
768        } else {
769            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
770        }
771        $^W = 1;
772# Here, Other Volumes are processed.
773
774        debug_out(15, "Other Media done. Now Off ones.");
775        $h_qu =
776            $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " .
777                           "FROM Media WHERE (PoolId=$pool{Id}) AND " .
778                           "(MediaType=" . $h_db->quote($mt->{MediaType}) .
779                           ") AND ((VolStatus=\'Disabled\') OR " .
780                           "(VolStatus=\'Error\'))")
781                || debug_abort(0,
782                               "Can't query Media Summary Information by MediaType.",
783                               $h_db->errstr());
784        debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No");
785        debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged");
786        debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ",
787                  $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows);
788        $h_qu->execute();
789        debug_out(48, "Result:", $h_qu->rows(), "Rows.");
790# Don't know why, but otherwise the handle access
791# methods result in a warning...
792        $^W = 0;
793        if (1 == $h_qu->rows()) {
794            if (my $qr = $h_qu->fetchrow_hashref) {
795                debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}.");
796                $subpool{VolumesOff} = $qr->{Nr};
797                $subpool{VolumesTotal} += $qr->{Nr};
798                            } else {
799                debug_out(1, "Can't get Media Summary Information by MediaType.",
800                          $h_qu->errstr());
801                $subpool{VolumesOff} = 0;
802            }
803        } else {
804            debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error.");
805        }
806        $^W = 1;
807# Here, Off Volumes are processed.
808
809        if ((0 < $subpool{BytesFreeEmpty}) ||
810            (0 < $subpool{BytesFreePartly})) {
811            debug_out(15, "We have a guess.");
812            $subpool{BytesFree} = 0;
813            $subpool{BytesFree} += $subpool{BytesFreeEmpty} if
814                (0 < $subpool{BytesFreeEmpty});
815            $subpool{BytesFree} += $subpool{BytesFreePartly} if
816                (0 < $subpool{BytesFreePartly});
817        } else {
818            debug_out(15, "Neither Empty nor Partly BytesFree available - no guess!");
819            $subpool{BytesFree} = -1;
820        }
821        if ($subpool{AvgFullUsesDefaults}) {
822            debug_out(15, "Average Full Capacity calculation included defaults.");
823            $pool{AvgFullUsesDefaults} = 1;
824        }
825        $pool{BytesTotal} += $subpool{BytesTotal};
826        $pool{VolumesTotal} += $subpool{VolumesTotal};
827        $pool{VolumesFull} += $subpool{VolumesFull};
828        $pool{VolumesEmpty} += $subpool{VolumesEmpty};
829        $pool{VolumesPartly} += $subpool{VolumesPartly};
830        $pool{VolumesAway} += $subpool{VolumesAway};
831        $pool{VolumesOther} += $subpool{VolumesOther};
832        $pool{VolumesOff} += $subpool{VolumesOff};
833# not counted!
834#       $pool{VolumesCleaning} += $subpool{VolumesCleaning};
835
836        $pool{BytesFree} += $subpool{BytesFree} if ($subpool{BytesFree} > 0);
837
838        debug_out(10, "Now storing sub-pool with MediaType", $subpool{MediaType});
839        push @subpools, \%subpool;
840    }
841    $pool{MediaTypes} = \@subpools;
842# GuessReliability
843    my $allrels = 0;
844    my $subcnt = scalar(@{$pool{MediaTypes}});
845    my $guess_includes_defaults = 0;
846    debug_out(10, "Summarizing Reliabilities from $subcnt sub-pools.");
847    foreach my $rel (@{$pool{MediaTypes}}) {
848        $allrels += $rel->{GuessReliability} * $rel->{VolumesTotal};
849    }
850    debug_out(15, "We have $allrels summed/weighted reliabilites and $pool{VolumesTotal} Volumes.");
851    if ($pool{VolumesTotal} > 0) {
852        $pool{GuessReliability} = $allrels / $pool{VolumesTotal};
853    } else {
854        $pool{GuessReliability} = "N/A";
855    }
856    push @the_pools, \%pool;
857}
858
859sub output_pool {
860    debug_out(10, "Printing pool data.");
861    my $pool = shift;
862    $pool->{GuessReliability} += 1000.0 if
863        (($pool->{GuessReliability} ne "N/A") &&
864         $pool->{AvgFullUsesDefaults});
865    printf((($out_cutmarks)?"    -" . " " x ($out_bargraphlen - 6) . "-\n":
866           "\n") .
867           "Pool%15.15s%s\n", "$pool->{Name}",
868           ($debug>=5)?sprintf(" %5.9s", "(" . $pool->{Id} . ")"):"");
869    my $poolbarbytes = $pool->{BytesTotal} + $pool->{BytesFree};
870    if ($out_bargraph) {
871        print bargraph($out_bargraphlen, 2,
872                       $poolbarbytes,
873                       $pool->{BytesTotal}, $pool->{BytesFree});
874    }
875    if ($out_pooldetails) {
876        print("  $pool->{VolumesTotal} Volumes ($pool->{VolumesFull} F, ",
877              "$pool->{VolumesOther} O, $pool->{VolumesPartly} A, ",
878              "$pool->{VolumesEmpty} E, $pool->{VolumesAway} W, ",
879              "$pool->{VolumesOff} X) Total ",
880              human_readable("B", $pool->{BytesTotal}),
881              " Rel: ", human_readable("P", $pool->{GuessReliability}),
882              " avail.: ", human_readable("B", $pool->{BytesFree}), "\n");
883    } else {
884        print bargraph_legend($out_bargraphlen, 2,
885                              $pool->{BytesTotal} + $pool->{BytesFree},
886                              $pool->{BytesTotal}, $pool->{BytesFree},
887                              $pool->{VolumesFull}, $pool->{VolumesPartly},
888                              $pool->{VolumesEmpty}, $pool->{GuessReliability});
889    }
890    if ($out_subpools) {
891        debug_out(10, "Printing details:", $#{$pool->{MediaTypes}}+1, "MediaTypes");
892        if (0 < scalar($pool->{MediaTypes})) {
893            print "     Details by Mediatype:\n";
894            foreach my $i (@{$pool->{MediaTypes}}) {
895                debug_out(15, "Media Type $i->{MediaType}");
896                $i->{GuessReliability} += 1000.0 if ($i->{AvgFullUsesDefaults});
897                print("     $i->{MediaType} ($i->{VolumesFull} F, ",
898                      "$i->{VolumesOther} O, $i->{VolumesPartly} A, ",
899                      "$i->{VolumesEmpty} E, $i->{VolumesAway} W, " ,
900                      "$i->{VolumesOff} X) Total ",
901                      human_readable("B", $i->{BytesTotal}), "\n");
902                if ($out_subbargraph) {
903                    print bargraph($out_bargraphlen - 3, 5,
904                                   $poolbarbytes,
905                                   $i->{BytesTotal},
906                                   $i->{BytesFree});
907                }
908                if ($out_subpooldetails) {
909                    print "     Avg, avail. Partly, Empty, Total, Rel.: ",
910                    ($i->{AvgFullBytes} > 0)?human_readable("B", $i->{AvgFullBytes}):"N/A", " ",
911                    ($i->{BytesFreePartly} > 0)?human_readable("B", $i->{BytesFreePartly}):"N/A", " ",
912                    ($i->{BytesFreeEmpty} > 0)?human_readable("B", $i->{BytesFreeEmpty}):"N/A", " ",
913                    ($i->{BytesFree} > 0)?human_readable("B", $i->{BytesFree}):"N/A", " ",
914                    human_readable("P", $i->{GuessReliability}), "\n";
915                } else {
916                    print bargraph_legend($out_bargraphlen - 3, 5,
917                                          $poolbarbytes,
918                                          $i->{BytesTotal},
919                                          $i->{BytesFree},
920                                          $i->{VolumesFull},
921                                          $i->{VolumesPartly},
922                                          $i->{VolumesEmpty},
923                                          $i->{GuessReliability}
924                                          ) if ($out_subbargraph);
925                }
926            }
927        }
928    }
929}
930
931sub bargraph_legend {
932    debug_out(15, "bargraph_legend called with ", join(":", @_));
933    my ($len, $pad, $b_all, $b_tot, $b_free, $v_total, $v_app,
934        $v_empty, $g_r) = @_;
935    if ((9 == scalar(@_)) &&
936        defined($len) && ($len >= 0) && ($len =~ /^\d+$/) &&
937        defined($pad) && ($pad >= 0) && ($pad =~ /^\d+$/) &&
938        defined($b_all) && ($b_all =~ /^\d+$/) &&
939        defined($b_tot) && ($b_tot =~ /^-?\d+$/) &&
940        defined($b_free) && ($b_free =~ /^-?\d+$/) &&
941        defined($v_total) && ($v_total =~ /^\d+$/) &&
942        defined($v_app) && ($v_app =~ /^\d+$/) &&
943        defined($v_empty) && ($v_empty =~ /^\d+$/) &&
944        ($g_r =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/)
945        ) {
946        return "" if ( 0 == $b_all);
947        $b_tot = 0 if ($b_tot < 0);
948        $b_free = 0 if ($b_free < 0);
949        return "" if (0 == ($b_tot + $b_free));
950        my ($ll, $lm);
951        my $l1 = human_readable("B", $b_tot) . " used ";
952        my $l2 = "Rel: " . human_readable("P", $g_r) . " free " . human_readable("B", $b_free);
953        $ll = $l1 . " " x ($len - length($l1) - length($l2)) . $l2;
954        $l1 = $v_total . " F Volumes ";
955        $l2 = $v_app . " A and " . $v_empty . " E Volumes";
956        $lm = $l1 . " " x ($len - length($l1) - length($l2)) . $l2;
957        return " " x $pad . $ll . "\n" .
958            " " x $pad . $lm . "\n";
959    } else {
960        debug_out(1, "bargraph_legend called without proper parameters");
961        return "";
962    }
963}
964
965sub bargraph {
966    debug_out(15, "bargraph called with ", join(":", @_));
967    my ($len, $pad, $p_all, $p_full, $p_empty) = @_;
968    if ((5 == scalar(@_)) &&
969        defined($len) && ($len >= 0) && ($len =~ /^\d+$/) &&
970        defined($pad) && ($pad >= 0) && ($pad =~ /^\d+$/) &&
971        defined($p_full) && ($p_full =~ /^-?\d+$/) &&
972        defined($p_empty) && ($p_empty =~ /^-?\d+$/) &&
973        defined($p_all) && ($p_all >= $p_full + $p_empty) &&
974        ($p_all =~ /^\d+$/)
975        ) {
976        $len = 12 if ($len < 12);
977        $p_full = 0 if ($p_full < 0);
978        $p_empty = 0 if ($p_empty < 0);
979        debug_out(15, "bargraph: len $len all $p_all full $p_full empty $p_empty");
980        return " " x $pad . "Nothing to report.\n" if (0 == $p_all);
981        return "" if (0 == ($p_full + $p_empty));
982        my $contperbox = $p_all / $len;
983        my $boxfull = sprintf("%u", ($p_full / $contperbox) + 0.5);
984        my $boxempty = sprintf("%u", ($p_empty / $contperbox) + 0.5);
985        my $boxnon = $len - $boxfull - $boxempty;
986        debug_out(15, "bargraph: output $boxfull $boxempty $boxnon");
987        $contperbox = sprintf("%f", $len / 100.0);
988        my $leg = "|0%";
989        my $ticks = sprintf("%u", ($len-12) / 12.5);
990        my $be = 0;
991        my $now = 4;
992        for my $i (1..$ticks) {
993            debug_out(15, "Tick loop. Previous pos: $now Previous Tick: ", $i-1);
994            my $pct = sprintf("%f", 100.0 / ($ticks+1.0) * $i);
995            $be = sprintf("%u", 0.5 + ($pct * $contperbox));
996            debug_out(15, "Tick $i ($pct percent) goes to pos $be. Chars per Percent: $contperbox");
997            my $bl = $be - $now;
998            debug_out(15, "Need $bl blanks to fill up.");
999            $leg .= " " x $bl . sprintf("|%2u%%", 0.5 + $pct);
1000            $now = $be + 4;
1001        }
1002        debug_out(15, "Fillup... Now at pos $now and $contperbox char/pct.");
1003        $be = $len - $now - 4;
1004        $leg .= " " x $be . "100%|";
1005        return " " x $pad . "#" x $boxfull . "-" x $boxempty .
1006            " " x $boxnon . "\n" . " " x $pad . "$leg\n";
1007    } else {
1008        debug_out(1, "bargrahp called without proper parameters.");
1009        return "";
1010    }
1011}
1012
1013sub human_readable {
1014    debug_out(15, "human_readable called with ", join(":", @_));
1015    if (2 == scalar(@_)) {
1016        debug_out(15, "2 Params - let's see what we've got.");
1017        my ($t, $v) = @_;
1018      SWITCH: for ($t) {
1019          /B/ && do {
1020              debug_out(15, "Working with Bytes.");
1021              my $d = 'B';
1022              if ($v > 1024) {
1023                  $v /= 1024;
1024                  $d = 'kB';
1025              }
1026              if ($v > 1024) {
1027                  $v /= 1024;
1028                  $d = 'MB';
1029              }
1030              if ($v > 1024) {
1031                  $v /= 1024;
1032                  $d = 'GB';
1033              }
1034              if ($v > 1024) {
1035                  $v /= 1024;
1036                  $d = 'TB';
1037              }
1038              return sprintf("%0.2f%s", $v, $d);
1039              last SWITCH;
1040          };
1041          /P/ && do {
1042              debug_out(15, "Working with Percent value.");
1043              my $ret = $v;
1044              if ($v =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/) {
1045                  if ($v >= 1000.0) {
1046                      $ret = " (def.)";
1047                      $v -= 1000.0;
1048                  } else {
1049                      $ret = "";
1050                  }
1051                  $ret = sprintf("%1.0f%%", $v) . $ret;
1052              }
1053              return $ret;
1054              last SWITCH;
1055          };
1056          return $v;
1057      }
1058    } else {
1059        return join("", @_);
1060    }
1061}
1062
1063sub get_default_bytes {
1064    debug_out(15, "get_default_bytes called with ", join(":", @_));
1065    if (1 == scalar(@_)) {
1066        debug_out(15, "1 Param - let's see what we've got.");
1067      SWITCH: for (@_) {
1068          /DDS/ && return 2000000000;
1069          /DDS1/ && return 2000000000;
1070          /DDS2/ && return 4000000000;
1071          /DLTIV/ && return 20000000000;
1072          /DC6525/ && return 525000000;
1073          /File/ && return 128*1024*1024;
1074          {
1075              debug_out(0, "$_ is not a known Media Type. Assuming 1 kBytes");
1076              return 1024;
1077          };
1078      };
1079    } else {
1080        debug_out(0, "This is not right...");
1081        return 999;
1082    }
1083}
1084
1085sub debug_out {
1086    if ($debug >= shift) {
1087        print "@_\n";
1088    }
1089}
1090
1091sub debug_abort {
1092    debug_out(@_);
1093    do_closedb();
1094    exit 1;
1095}
1096
1097sub do_closedb {
1098    my $t;
1099    debug_out(40, "Closing database connection...");
1100    while ($t=shift @temp_tables) {
1101        debug_out(40, "Now dropping table $t");
1102        $h_db->do("DROP TABLE $t") || debug_out(0, "Can't drop $t.");
1103    }
1104    $h_db->disconnect();
1105    debug_out(40, "Database disconnected.");
1106}
1107
1108sub do_usage {
1109    print<<EOF;
1110$ME (C) 2005 Arno Lehmann, IT-Service Lehmann
1111
1112produce bacula statistics to stdout
1113
1114usage: $ME options      more help: perldoc $ME
1115Options can be abbreviated to uniqueness. Negating --option is done
1116like --nooption.
1117  --help     -h  print this help
1118  --version  -V  print version and license
1119  --host         database host, default unset (use unix socket)
1120  --user     -U  database user, default unset
1121  --database -D  database name, default "mysql:bacula"
1122                 (notice database driver!)
1123  --password -P  database password, default unset
1124  --debug        debug level, default 0. Higer level, more output
1125  General output control:
1126  --subpools        -s  no   subpool (Media types in each pool) details
1127  --subpool-details     no   more detailed information
1128  --pool-details    -d  no   detailed pool information
1129  --pool-bargraph       yes  show visual pool usage, can be negated
1130  --subpool-bargraph    no   show visual subpool usage
1131  --bar-length      -l  70   length for graphical pool usage display
1132  --cutmarks        -c  no   print cut marks above the pools
1133EOF
1134}
1135
1136sub do_version {
1137    print<<EOF;
1138This is baculareport.pl called as $0
1139This program was created by Arno Lehmann (al\@its-lehmann.de) in
11402005.
1141
1142You have Version $version.
1143
1144This program is copyrighted, but everybody is allowed to use, modify
1145and distribute this program under the following conditions:
1146- This license and the original copyright holder must not be changed
1147- The terms and the idea of the GPL apply. If you are unsure, ask
1148  the copyright holder if your planned usage is ok.
1149- No warranties, no promises. You are all on your own.
1150  This program needs access to your bacula catalog. If you don't like
1151  that idea, don't use it or check the sourcecode!
1152
1153Although I give no warranties, in case of problems you can contact me.
1154I will help as good as possible.
1155Bacula consulting available.
1156
1157Bacula is a Trademark of John Walker. See www.bacula.org
1158
1159EOF
1160
1161}
1162