#!/usr/bin/perl -w # # bacula report generation # # (C) Arno Lehmann 2005 # IT-Service Lehmann # # # Usage: See funtion print_usage # or use this script with option --help # # Version history: # # 0.2 publicly available, works reliable # 0.3 increasing weight of No. of tapes in guess reliability # and including tape capacity guessing when no volumes in subpool # using default values from temp. table use strict; use DBI; use Getopt::Long; use Math::BigInt; my $version="0.3"; $0 =~ /.*\/([^\/]*)$/; my $ME = $1; my $debug = 0; my $db_host = ""; my $db_user = "bacula"; my $db_database = "mysql:bacula"; my $db_pass = ""; my $do_usage = ""; my $do_version = ""; my @temp_tables; my @the_pools; my $out_pooldetails = ""; my $out_bargraph = 1; my $out_bargraphlen = 70; my $out_subpools = ""; my $out_subpooldetails = ""; my $out_subbargraph = ""; my $out_cutmarks = ""; # This is the data we're interested in: # In this array we have a hash reference to each Pool. # A pool consists of a hash having # Name # Id # BytesTotal # VolumesTotal # VolumesFull (This is State Full # VolumesEmpty (This is Purged and Recycle) # VolumesPartly (Append) # VolumesAway (Archive, Read-Only) # VolumesOther (Busy, Used) # VolumesOff (Disabled, Error) # VolumesCleaning # BytesFree # GuessReliability (This is the weighted average of the Reliability # of all the Media Type Guesses in this Pool) # MediaTypes is an array of references to hashes for collected # information for all the Media Types in this pool. # This has the same as the pools summary and adds # MediaType The String # AvgFullBytes (The Avg. Number of Bytes per full Volume) # BytesFreeEmpty (The estimated Free Bytes on Empty Volumes) # BytesFreePartly # # We use: $the_pools[0]->MediaTypes[0]->{MediaType} or # $the_pools[1]->Id # I hope you get the point. I hope I do. Getopt::Long::Configure("bundling"); GetOptions("host=s"=>\$db_host, "user|U=s"=>\$db_user, "database|D=s"=>\$db_database, "password|P=s"=>\$db_pass, "debug=i"=>\$debug, "help|h"=>\$do_usage, "version|V"=>\$do_version, "subpools|s"=>\$out_subpools, "subpool-details"=>\$out_subpooldetails, "pool-details|d"=>\$out_pooldetails, "pool-bargraph!"=>\$out_bargraph, "bar-length|l=i"=>\$out_bargraphlen, "cutmarks|c"=>\$out_cutmarks, "subpool-bargraph"=>\$out_subbargraph ); debug_out(100, "I've got host: $db_host user: $db_user database: $db_database password: $db_pass debug: $debug help: $do_usage version: $do_version output requested: pool details: $out_pooldetails subpools: $out_subpools subpool details: $out_subpooldetails bargraph: $out_bargraph subpool bargraph: $out_subbargraph bar length: $out_bargraphlen cutmarks: $out_cutmarks I was called as $0 and am version $version. Was that helpful?"); if ($do_usage) { do_usage(); exit 1; } if ($do_version) { do_version(); exit 1; } $out_subpools = 1 if ($out_subpooldetails); $out_subpools = 1 if ($out_subbargraph); $out_bargraphlen = 70 if (15 > $out_bargraphlen); $out_bargraphlen = 70 if (200 < $out_bargraphlen); $out_bargraph = 1 if (! $out_pooldetails); debug_out(100, "Output options after dependencies: pool details: $out_pooldetails subpools: $out_subpools subpool details: $out_subpooldetails bargraph: $out_bargraph subpool bargraph: $out_subbargraph bar length: $out_bargraphlen cutmarks: $out_cutmarks "); my (undef, $min, $hour, $mday, $mon, $year) = localtime(); $year += 1900; $mon = sprintf("%02i", $mon+1); $mday = sprintf("%02i", $mday); $min = sprintf("%02i", $min); $hour = sprintf("%02i", $hour); print "bacula volume / pool status report $year-$mon-$mday $hour:$min\n", "Volumes Are Full, Other, Append, Empty, aWay or X (error)\n"; my $dbconn = "dbi:" . $db_database; $dbconn .= "\@" . $db_host if $db_host; debug_out(40, "DBI connect with $dbconn"); my $h_db = DBI->connect($dbconn, $db_user, $db_pass, { PrintError => 0, AutoCommit => 1 } ) || die DBI::errstr; debug_out(10, "Have database connection $h_db"); debug_out(100, "creating temp tables..."); $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?"); unshift @temp_tables, "alrep_M"; debug_out(45, "Table alrep_M created."); debug_out(40, "All tables done."); debug_out(40, "Filling temp tables..."); if ($h_db->do("INSERT INTO alrep_M SELECT Pool.PoolId,Media.MediaType FROM Pool,Media WHERE Pool.PoolId=Media.PoolId GROUP BY PoolId,MediaType")) { debug_out(45, "PoolId-MediaType table populated."); } else { debug_abort(0, "Couldn't populate PoolId and MediaType table alrep_M."); } debug_out(40, "All tables done."); debug_out(40, "Getting Pool Names."); my $h_st = $h_db->prepare("SELECT Name,PoolId FROM Pool ORDER BY Name") || debug_abort(0, "Couldn't get Pool Information.", $h_db->errstr()); $h_st->execute() || debug_abort(0, "Couldn't query Pool information.", $h_db->errstr()); my $pools; while ($pools=$h_st->fetchrow_hashref()) { process_pool($pools->{Name}, $pools->{PoolId}) } debug_out(10, "All Pool data collected."); debug_out(7, "Pools analyzed: $#the_pools."); debug_out(10, "Going to print..."); my $pi; for $pi (@the_pools) { output_pool($pi); } debug_out(10, "Program terminates normally."); do_closedb(); debug_out(10, "Finishing."); exit 0; =pod =head1 NAME baculareport.pl - a script to produce some bacula reports out of the catalog database. =head1 SYNTAX B B<--help>|B<-h> B B<--version>|B<-V> B [B<--host> I] [B<--user>|B<-U> I] [B<--database>|B<-D> I] [B<--password>|B<-P> I] [B<--debug> I] [B<--pool-details>|B<-d>] [B<--pool-bargraph>|B<--nopool-bargraph>] [B<--subpools>|B<-s>] [B<--subpool-details>] [B<--subpool-bargraph>] [B<--bar-length>|B<-l> I] [B<--cutmarks>|B<-c>] The long options can be abbreviated, as long as they remain unique. Short options (and values) can be grouped, for more information see B. =head1 DESCRIPTION B accesses the catalog used by the backup program bacula to produce some report about pool and volume usage. The command line options B<--host> I, B<--user> or B<-U> I, B<--database> or B<-D> and B<--password> or B<-P> define the database to query. See below for security considerations concerning databse passwords. The I must be given in perl's B-syntax, as in I. Currently, only MySQL is supported, though PostgreSQL should work with only minor modifications to B. Output of reports is controlled using the command-line switches B<--*pool*>, B<--bar-length> and B<--cutmarks> or there one-letter equivalents. The report for a pool can contain a one-line overview of the volumes in that pool, giving the numbers of volumes in different states, the total bytes stored and an estimate of the available capacity. The estimated consists of a percentage describing the reliability of this estimate and the guessed free capacity. A visual representation of the pools state represented as a bar graph, together with the number of full, appendable and free volumes is the default report. The length of this graph can be set with B<--bar-length> or B<-l> I. As a pool can contain volumes of different media type, the report's output can include the information about those collections of volumes called subpools in Bs documentation. The subpool overview data presents the same information about the volumes the pool details have, but includes the media type and excludes the free capacity guess. Subpool details report the average amount of data on full volumes, together with what is estimated to be available on appendable and empty volumes. A measurement on the reliability of this estimate is given as a percent value. See below in L<"CAPACITY GUESSING"> for more information. Finally, a bar graph representing this subpools fill-level can be printed. For easier overview it is scaled like the pools bargraph. B<--cutmarks> or B<-c> prints some marks above each pool report to make cutting the report easier if you want to file it. Sample reports are in L<"SAMPLE REPORTS">. The B<--debug>-option activates debug output. Without understanding the source code this will not be helpful. See below L<"DEBUG OUTPUT">. =head1 DATABASE ACCESS AND SECURITY baculareport.pl needs access to baculas catalog. This might introduce a security risk if the database access password is published to people who shouldn't know it, but need to create reports. The solution is to set up a database account which can only read from baculas catalog. Use your favorite database administration tool for this. Command line passing of the password is also not really secure - anybody with 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 =over 4 =item 1. I, or =item 2. I =back This should limit security risks to a minimum. If B is used by your backup admin only, don't bother - she has access to all your data anyway. (B) =head1 SAMPLE REPORTS The reports can be customized using the above explained command line switches. Some examples are: bacula volume / pool status report 2005-01-18 23:40 Volumes Are Full, Other, Append, Empty, aWay or X (error) Pool Diff ######################################################---------------- |0% |20% |40% |60% |80% 100%| 48.38GB used Rel: 24% free 13.88GB 17 F Volumes 3 A and 4 E Volumes Pool Full #######################################------------------------------- |0% |20% |40% |60% |80% 100%| 310.66GB used Rel: 58% free 241.64GB 43 F Volumes 2 A and 14 E Volumes Pool Incr #######################################################--------------- |0% |20% |40% |60% |80% 100%| 28.51GB used Rel: 0% (def.) free 7.61GB 0 F Volumes 3 A and 4 E Volumes Pool TMPDisk Nothing to report. This is the sort of report you get when you use this script without any special output options. After a short header, for all pools in the catalog a graphic representation of its usage is printed. Below that, you find some essential information: The capacity used, a guess of the remaining capacity (see L<"CAPACITY GUESSING"> below), and an overview of the volumes: Here, in pool Incr we have no full volumes, 3 appendable ones and 4 empty volumes. In this example, the pool TMPDisk does not contain anything which can be reported. Following you have an example with all output options set. - - Pool Incr ###################################################---- |0% |25% |50% |75% 100%| 10 Volumes (2 F, 0 O, 2 A, 6 E, 0 W, 0 X) Total 59.64GB Rel: 29% avail.: 4.57GB Details by Mediatype: DDS1 (0 F, 0 O, 1 A, 4 E, 0 W, 0 X) Total 4.53GB #### |0% |25% |50% |75% 100%| Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0% DDS2 (0 F, 0 O, 0 A, 2 E, 0 W, 0 X) Total 0.00B Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0% DLTIV (2 F, 0 O, 1 A, 0 E, 0 W, 0 X) Total 55.11GB #############################################---- |0% |25% |50% |75% 100%| Avg, avail. Partly, Empty, Total, Rel.: 19.89GB 4.57GB N/A 4.57GB 96% - - Pool TMPDisk Nothing to report. 1 Volumes (0 F, 0 O, 0 A, 1 E, 0 W, 0 X) Total 0.00B Rel: 0% avail.: 0.00B Details by Mediatype: File (0 F, 0 O, 0 A, 1 E, 0 W, 0 X) Total 0.00B Nothing to report. Avg, avail. Partly, Empty, Total, Rel.: N/A N/A N/A N/A 0% Cut marks are included for easier cutting in case you want to file the printed report. Then, the length of the bar graphs was changed. More detail for the pools is shown: Not only the overwiev graphics, but also a listing of the status of all media in this pool, followed by the reliability of the guess of available capacity and the probable available capacity itself. After this summary you find a similar report for all media types in this pool. Here, the media type starts the details line. The next line is a breakdown of the capacity inside this subpool: The average capacity of the full volumes, followed by the probable available capacity on appendable and empty volumes. Total is the probable free capacity on these volumes, and Rel is the reliability of the capacity guessing. Note that some of the items are not always displayed: A pool or subpool with no bytes in it will not have a bar graph, and some of the statistical data is marked as N/A for not available. The above output was generated with the following command: B<< C<< baculareport.pl --password \ --pool-bargraph --pool-details --subpools\ --subpool-details --subpool-bargraph --bar-length 55\ --cutmarks >> >> The following command would have given the same output: B<< C<< baculareport.pl -P -csdl55\ --subpool-d --subpool-b >> >> =head1 CAPACITY GUESSING For empty and appendable volumes, the average capacity of the full volumes is used as the base for estimating what can be stored. This usually depends heavily on the type of data to store, and of course this works only with volumes of the same nominal capacity. The reliability of all this guesswork is expressed based on the standard deviation among the full volumes, scaled to percent. 100% is a very reliable estimate (Note: NOT absolutely reliable!) while a small percentage (from personal experience: below 60-70 percent) means that you shouldn't rely on the reported available data storage. To determine the overall reliability in a pool, the reliabilites of the subpools are weighted - a subpool with many volumes has a higer influence on overall reliability. Keep in mind that the reported free capacities and reliabilities can only be a help and don't rely on these figures alone. Keep enough spare tapes available! Default capacities for some media types are included now. Consider this feature a temporarily kludge - At the moment, there is a very simple media capacity guessing implemented. Search for the function `get_default_bytes' and modify it to your needs. In the future, I expect some nominal volume capacity knowledge inside baculas catalog, and when this is available, that data will be used. Capacity estimates with defaults in the calculation are marked with B<(def.)> after the reliability percentage. If you see B<0% (def.)> only the defaults are used because no full tapes were available. =head1 DEBUG OUTPUT Debugging, or more generally verbose output, is activated by the --debug command switch. The higher the level, the more output you get. Currently, levels 10 and up are real debugging output. Levels above 100 are not used. I The debug levels used are: =over 4 =item 1 Some warnings are printed. =item 10 Program Flow is reported. =item 15 More detailed Program flow, for example loops. =item 40 Database actions are printed. =item 45 Table actions are reported. =item 48 Even more database activity. =item 100 All internal state data is printed. Beware: This includes the database password! =back =head1 BUGS Probably many. If you find one, notify the author. Better: notify me how to correct it. Currently this script works only with MySQL and catalog version 8 (probably older versions as well, but that is untested). =head1 AUTHOR Arno Lehmann al@its-lehmann.de =head1 LICENSE This is copyrighted work: (C) 2005 Arno Lehmann IT-Service Lehmann Use, modification and (re-)distribution are allowed provided this license and the names of all contributing authors are included. No author or contributor gives any warranty on this script. If you want to use it, you are all on your own. Please read the documentation, and, if you feel unsure, read and understand the sourcecode. The terms and idea of the GNU GPL, version 2 or, at you option, any later version, apply. See http://www.fsf.org. You can contact the author using the above email address. I will try to answer any question concerning this script, but still - no promises! Bacula is (C) copyright 2000-2006 Free Software Foundation Europe e.V. See http://www.bacula.org. (Bacula consulting available.) =cut sub process_pool { my %pool = (BytesTotal=>0, VolumesTotal=>0, VolumesFull=>0, VolumesEmpty=>0, VolumesPartly=>0, VolumesAway=>0, VolumesOther=>0, VolumesOff=>0, VolumesCleaning=>"Not counted", BytesFree=>0, GuessReliability=>0, AvgFullUsesDefaults=>"" ); debug_out(10, "Working on Pool $pools->{Name}."); $pool{Name} = shift; $pool{Id} = shift; my @subpools; debug_out(30, "Pool $pool{Name} is Id $pool{Id}."); my $h_st = $h_db->prepare("SELECT MediaType FROM alrep_M WHERE PoolId = $pool{Id} ORDER BY MediaType") || debug_abort(0, "Can't query Media table.", $h_st->errstr()); $h_st->execute() || debug_abort(0, "Can't get Media Information", $h_st->errstr()); while (my $mt=$h_st->fetchrow_hashref()) { # In this loop, we process one media type in a pool my %subpool = (MediaType=>$mt->{MediaType}); debug_out(45, "Working on MediaType $mt->{MediaType}."); my $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes," . "STD(VolBytes) AS Std,AVG(VolBytes) AS Avg " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND (VolStatus=\'Full\')") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Full"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesFull} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; $subpool{BytesTotal} = $qr->{Bytes} if (defined($qr->{Bytes})); if (defined($qr->{Bytes}) && (0 < $qr->{Bytes}) && (0 < $qr->{Nr})) { $subpool{AvgFullBytes} = int($qr->{Bytes} / $qr->{Nr}); } else { $subpool{AvgFullBytes} = get_default_bytes($mt->{MediaType}); $subpool{AvgFullUsesDefaults} = 1; } if (defined($qr->{Std}) && defined($qr->{Avg}) && (0 < $qr->{Avg})) { # $subpool{GuessReliability} = 100-(100*$qr->{Std}/$qr->{Avg}); $subpool{GuessReliability} = 100 - # 100 Percent minus... ( 100 * # Percentage of ( $qr->{Std}/$qr->{Avg} ) * # V ( 1 - 1 / $qr->{Nr} ) # ... the more tapes # the better the guess ); } else { $subpool{GuessReliability} = 0; } } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesFull} = 0; $subpool{BytesTotal} = 0; $subpool{GuessReliability} = 0; $subpool{AvgFullBytes} = -1; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Full Media are done debug_out(15, "Full Media done. Now Empty ones."); $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND ((VolStatus=\'Purged\') OR " . "(VolStatus=\'Recycle\'))") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesEmpty} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; if (($subpool{AvgFullBytes} > 0) && ($qr->{Nr} > 0)) { $subpool{BytesFreeEmpty} = $qr->{Nr} * $subpool{AvgFullBytes}; } else { $subpool{BytesFreeEmpty} = -1; } } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesEmpty} = 0; $subpool{BytesFreeEmpty} = 0; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Empty Volumes are processed. debug_out(15, "Empty Media done. Now Partly filled ones."); $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND (VolStatus=\'Append\')") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Append"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesPartly} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; $subpool{BytesTotal} += $qr->{Bytes}; if (($subpool{AvgFullBytes} > 0) && ($qr->{Nr} > 0)) { $subpool{BytesFreePartly} = $qr->{Nr} * $subpool{AvgFullBytes} - $qr->{Bytes}; $subpool{BytesFreePartly} = $qr->{Nr} if $subpool{BytesFreePartly} < 1; } else { $subpool{BytesFreePartly} = -1; } } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesPartly} = 0; $subpool{BytesFreePartly} = 0; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Partly filled volumes are done debug_out(15, "Partly Media done. Now Away ones."); $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND ((VolStatus=\'Archive\') OR " . "(VolStatus=\'Read-Only\'))") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesAway} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; $subpool{BytesTotal} += $qr->{Bytes}; } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesAway} = 0; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Away Volumes are processed. debug_out(15, "Away Media done. Now Other ones."); $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND ((VolStatus=\'Busy\') OR " . "(VolStatus=\'Used\'))") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesOther} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; $subpool{BytesTotal} += $qr->{Bytes}; } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesOther} = 0; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Other Volumes are processed. debug_out(15, "Other Media done. Now Off ones."); $h_qu = $h_db->prepare("SELECT COUNT(*) AS Nr,SUM(VolBytes) AS Bytes " . "FROM Media WHERE (PoolId=$pool{Id}) AND " . "(MediaType=" . $h_db->quote($mt->{MediaType}) . ") AND ((VolStatus=\'Disabled\') OR " . "(VolStatus=\'Error\'))") || debug_abort(0, "Can't query Media Summary Information by MediaType.", $h_db->errstr()); debug_out(48, "Query active: ", $h_qu->{Active}?"Yes":"No"); debug_out(45, "Now selecting Summary Information for $pool{Name}:$mt->{MediaType}:Recycle OR Purged"); debug_out(48, "Query: ", $h_qu->{Statement}, "Params: ", $h_qu->{NUM_OF_PARAMS}, " Rows: ", $h_qu->rows); $h_qu->execute(); debug_out(48, "Result:", $h_qu->rows(), "Rows."); # Don't know why, but otherwise the handle access # methods result in a warning... $^W = 0; if (1 == $h_qu->rows()) { if (my $qr = $h_qu->fetchrow_hashref) { debug_out(45, "Got $qr->{Nr} and $qr->{Bytes}."); $subpool{VolumesOff} = $qr->{Nr}; $subpool{VolumesTotal} += $qr->{Nr}; } else { debug_out(1, "Can't get Media Summary Information by MediaType.", $h_qu->errstr()); $subpool{VolumesOff} = 0; } } else { debug_out(45, "Got nothing: ", (defined($h_qu->errstr()))?$h_qu->errstr():"No error."); } $^W = 1; # Here, Off Volumes are processed. if ((0 < $subpool{BytesFreeEmpty}) || (0 < $subpool{BytesFreePartly})) { debug_out(15, "We have a guess."); $subpool{BytesFree} = 0; $subpool{BytesFree} += $subpool{BytesFreeEmpty} if (0 < $subpool{BytesFreeEmpty}); $subpool{BytesFree} += $subpool{BytesFreePartly} if (0 < $subpool{BytesFreePartly}); } else { debug_out(15, "Neither Empty nor Partly BytesFree available - no guess!"); $subpool{BytesFree} = -1; } if ($subpool{AvgFullUsesDefaults}) { debug_out(15, "Average Full Capacity calculation included defaults."); $pool{AvgFullUsesDefaults} = 1; } $pool{BytesTotal} += $subpool{BytesTotal}; $pool{VolumesTotal} += $subpool{VolumesTotal}; $pool{VolumesFull} += $subpool{VolumesFull}; $pool{VolumesEmpty} += $subpool{VolumesEmpty}; $pool{VolumesPartly} += $subpool{VolumesPartly}; $pool{VolumesAway} += $subpool{VolumesAway}; $pool{VolumesOther} += $subpool{VolumesOther}; $pool{VolumesOff} += $subpool{VolumesOff}; # not counted! # $pool{VolumesCleaning} += $subpool{VolumesCleaning}; $pool{BytesFree} += $subpool{BytesFree} if ($subpool{BytesFree} > 0); debug_out(10, "Now storing sub-pool with MediaType", $subpool{MediaType}); push @subpools, \%subpool; } $pool{MediaTypes} = \@subpools; # GuessReliability my $allrels = 0; my $subcnt = scalar(@{$pool{MediaTypes}}); my $guess_includes_defaults = 0; debug_out(10, "Summarizing Reliabilities from $subcnt sub-pools."); foreach my $rel (@{$pool{MediaTypes}}) { $allrels += $rel->{GuessReliability} * $rel->{VolumesTotal}; } debug_out(15, "We have $allrels summed/weighted reliabilites and $pool{VolumesTotal} Volumes."); if ($pool{VolumesTotal} > 0) { $pool{GuessReliability} = $allrels / $pool{VolumesTotal}; } else { $pool{GuessReliability} = "N/A"; } push @the_pools, \%pool; } sub output_pool { debug_out(10, "Printing pool data."); my $pool = shift; $pool->{GuessReliability} += 1000.0 if (($pool->{GuessReliability} ne "N/A") && $pool->{AvgFullUsesDefaults}); printf((($out_cutmarks)?" -" . " " x ($out_bargraphlen - 6) . "-\n": "\n") . "Pool%15.15s%s\n", "$pool->{Name}", ($debug>=5)?sprintf(" %5.9s", "(" . $pool->{Id} . ")"):""); my $poolbarbytes = $pool->{BytesTotal} + $pool->{BytesFree}; if ($out_bargraph) { print bargraph($out_bargraphlen, 2, $poolbarbytes, $pool->{BytesTotal}, $pool->{BytesFree}); } if ($out_pooldetails) { print(" $pool->{VolumesTotal} Volumes ($pool->{VolumesFull} F, ", "$pool->{VolumesOther} O, $pool->{VolumesPartly} A, ", "$pool->{VolumesEmpty} E, $pool->{VolumesAway} W, ", "$pool->{VolumesOff} X) Total ", human_readable("B", $pool->{BytesTotal}), " Rel: ", human_readable("P", $pool->{GuessReliability}), " avail.: ", human_readable("B", $pool->{BytesFree}), "\n"); } else { print bargraph_legend($out_bargraphlen, 2, $pool->{BytesTotal} + $pool->{BytesFree}, $pool->{BytesTotal}, $pool->{BytesFree}, $pool->{VolumesFull}, $pool->{VolumesPartly}, $pool->{VolumesEmpty}, $pool->{GuessReliability}); } if ($out_subpools) { debug_out(10, "Printing details:", $#{$pool->{MediaTypes}}+1, "MediaTypes"); if (0 < scalar($pool->{MediaTypes})) { print " Details by Mediatype:\n"; foreach my $i (@{$pool->{MediaTypes}}) { debug_out(15, "Media Type $i->{MediaType}"); $i->{GuessReliability} += 1000.0 if ($i->{AvgFullUsesDefaults}); print(" $i->{MediaType} ($i->{VolumesFull} F, ", "$i->{VolumesOther} O, $i->{VolumesPartly} A, ", "$i->{VolumesEmpty} E, $i->{VolumesAway} W, " , "$i->{VolumesOff} X) Total ", human_readable("B", $i->{BytesTotal}), "\n"); if ($out_subbargraph) { print bargraph($out_bargraphlen - 3, 5, $poolbarbytes, $i->{BytesTotal}, $i->{BytesFree}); } if ($out_subpooldetails) { print " Avg, avail. Partly, Empty, Total, Rel.: ", ($i->{AvgFullBytes} > 0)?human_readable("B", $i->{AvgFullBytes}):"N/A", " ", ($i->{BytesFreePartly} > 0)?human_readable("B", $i->{BytesFreePartly}):"N/A", " ", ($i->{BytesFreeEmpty} > 0)?human_readable("B", $i->{BytesFreeEmpty}):"N/A", " ", ($i->{BytesFree} > 0)?human_readable("B", $i->{BytesFree}):"N/A", " ", human_readable("P", $i->{GuessReliability}), "\n"; } else { print bargraph_legend($out_bargraphlen - 3, 5, $poolbarbytes, $i->{BytesTotal}, $i->{BytesFree}, $i->{VolumesFull}, $i->{VolumesPartly}, $i->{VolumesEmpty}, $i->{GuessReliability} ) if ($out_subbargraph); } } } } } sub bargraph_legend { debug_out(15, "bargraph_legend called with ", join(":", @_)); my ($len, $pad, $b_all, $b_tot, $b_free, $v_total, $v_app, $v_empty, $g_r) = @_; if ((9 == scalar(@_)) && defined($len) && ($len >= 0) && ($len =~ /^\d+$/) && defined($pad) && ($pad >= 0) && ($pad =~ /^\d+$/) && defined($b_all) && ($b_all =~ /^\d+$/) && defined($b_tot) && ($b_tot =~ /^-?\d+$/) && defined($b_free) && ($b_free =~ /^-?\d+$/) && defined($v_total) && ($v_total =~ /^\d+$/) && defined($v_app) && ($v_app =~ /^\d+$/) && defined($v_empty) && ($v_empty =~ /^\d+$/) && ($g_r =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/) ) { return "" if ( 0 == $b_all); $b_tot = 0 if ($b_tot < 0); $b_free = 0 if ($b_free < 0); return "" if (0 == ($b_tot + $b_free)); my ($ll, $lm); my $l1 = human_readable("B", $b_tot) . " used "; my $l2 = "Rel: " . human_readable("P", $g_r) . " free " . human_readable("B", $b_free); $ll = $l1 . " " x ($len - length($l1) - length($l2)) . $l2; $l1 = $v_total . " F Volumes "; $l2 = $v_app . " A and " . $v_empty . " E Volumes"; $lm = $l1 . " " x ($len - length($l1) - length($l2)) . $l2; return " " x $pad . $ll . "\n" . " " x $pad . $lm . "\n"; } else { debug_out(1, "bargraph_legend called without proper parameters"); return ""; } } sub bargraph { debug_out(15, "bargraph called with ", join(":", @_)); my ($len, $pad, $p_all, $p_full, $p_empty) = @_; if ((5 == scalar(@_)) && defined($len) && ($len >= 0) && ($len =~ /^\d+$/) && defined($pad) && ($pad >= 0) && ($pad =~ /^\d+$/) && defined($p_full) && ($p_full =~ /^-?\d+$/) && defined($p_empty) && ($p_empty =~ /^-?\d+$/) && defined($p_all) && ($p_all >= $p_full + $p_empty) && ($p_all =~ /^\d+$/) ) { $len = 12 if ($len < 12); $p_full = 0 if ($p_full < 0); $p_empty = 0 if ($p_empty < 0); debug_out(15, "bargraph: len $len all $p_all full $p_full empty $p_empty"); return " " x $pad . "Nothing to report.\n" if (0 == $p_all); return "" if (0 == ($p_full + $p_empty)); my $contperbox = $p_all / $len; my $boxfull = sprintf("%u", ($p_full / $contperbox) + 0.5); my $boxempty = sprintf("%u", ($p_empty / $contperbox) + 0.5); my $boxnon = $len - $boxfull - $boxempty; debug_out(15, "bargraph: output $boxfull $boxempty $boxnon"); $contperbox = sprintf("%f", $len / 100.0); my $leg = "|0%"; my $ticks = sprintf("%u", ($len-12) / 12.5); my $be = 0; my $now = 4; for my $i (1..$ticks) { debug_out(15, "Tick loop. Previous pos: $now Previous Tick: ", $i-1); my $pct = sprintf("%f", 100.0 / ($ticks+1.0) * $i); $be = sprintf("%u", 0.5 + ($pct * $contperbox)); debug_out(15, "Tick $i ($pct percent) goes to pos $be. Chars per Percent: $contperbox"); my $bl = $be - $now; debug_out(15, "Need $bl blanks to fill up."); $leg .= " " x $bl . sprintf("|%2u%%", 0.5 + $pct); $now = $be + 4; } debug_out(15, "Fillup... Now at pos $now and $contperbox char/pct."); $be = $len - $now - 4; $leg .= " " x $be . "100%|"; return " " x $pad . "#" x $boxfull . "-" x $boxempty . " " x $boxnon . "\n" . " " x $pad . "$leg\n"; } else { debug_out(1, "bargrahp called without proper parameters."); return ""; } } sub human_readable { debug_out(15, "human_readable called with ", join(":", @_)); if (2 == scalar(@_)) { debug_out(15, "2 Params - let's see what we've got."); my ($t, $v) = @_; SWITCH: for ($t) { /B/ && do { debug_out(15, "Working with Bytes."); my $d = 'B'; if ($v > 1024) { $v /= 1024; $d = 'kB'; } if ($v > 1024) { $v /= 1024; $d = 'MB'; } if ($v > 1024) { $v /= 1024; $d = 'GB'; } if ($v > 1024) { $v /= 1024; $d = 'TB'; } return sprintf("%0.2f%s", $v, $d); last SWITCH; }; /P/ && do { debug_out(15, "Working with Percent value."); my $ret = $v; if ($v =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/) { if ($v >= 1000.0) { $ret = " (def.)"; $v -= 1000.0; } else { $ret = ""; } $ret = sprintf("%1.0f%%", $v) . $ret; } return $ret; last SWITCH; }; return $v; } } else { return join("", @_); } } sub get_default_bytes { debug_out(15, "get_default_bytes called with ", join(":", @_)); if (1 == scalar(@_)) { debug_out(15, "1 Param - let's see what we've got."); SWITCH: for (@_) { /DDS/ && return 2000000000; /DDS1/ && return 2000000000; /DDS2/ && return 4000000000; /DLTIV/ && return 20000000000; /DC6525/ && return 525000000; /File/ && return 128*1024*1024; { debug_out(0, "$_ is not a known Media Type. Assuming 1 kBytes"); return 1024; }; }; } else { debug_out(0, "This is not right..."); return 999; } } sub debug_out { if ($debug >= shift) { print "@_\n"; } } sub debug_abort { debug_out(@_); do_closedb(); exit 1; } sub do_closedb { my $t; debug_out(40, "Closing database connection..."); while ($t=shift @temp_tables) { debug_out(40, "Now dropping table $t"); $h_db->do("DROP TABLE $t") || debug_out(0, "Can't drop $t."); } $h_db->disconnect(); debug_out(40, "Database disconnected."); } sub do_usage { print<