From blair at orcaware.com Sat Jul 3 10:40:34 2004 From: blair at orcaware.com (Blair Zajac) Date: Sat, 3 Jul 2004 10:40:34 -0700 Subject: [Orca-checkins] r364 - in trunk/orca: . packages/Storable-2.12 packages/Storable-2.13 packages/Storable-2.13/t Message-ID: <200407031740.i63HeY6Q021644@orcaware.com> Author: blair Date: Sat Jul 3 10:38:07 2004 New Revision: 364 Added: trunk/orca/packages/Storable-2.13/ - copied from r363, trunk/orca/packages/Storable-2.12/ trunk/orca/packages/Storable-2.13/t/make_overload.pl Removed: trunk/orca/packages/Storable-2.12/ Modified: trunk/orca/INSTALL trunk/orca/configure.in trunk/orca/packages/Storable-2.13/ChangeLog trunk/orca/packages/Storable-2.13/MANIFEST trunk/orca/packages/Storable-2.13/README trunk/orca/packages/Storable-2.13/Storable.pm trunk/orca/packages/Storable-2.13/Storable.xs trunk/orca/packages/Storable-2.13/t/utf8.t Log: Upgrade Storable from 2.12 to 2.13 and require the new version for Orca. * configure.in: Bump Storable's version number to 2.13. * INSTALL (Determine which Perl modules need compiling and installing): Update all references to Storable's version number from 2.12 to 2.13. * packages/Storable-2.13: Renamed from packages/Storable-2.12. Directory contents updated from Storable-2.13.tar.gz. Modified: trunk/orca/INSTALL ============================================================================== --- trunk/orca/INSTALL (original) +++ trunk/orca/INSTALL Sat Jul 3 10:38:07 2004 @@ -176,7 +176,7 @@ Digest::MD5 >= 2.33 >= 2.33 2.33 Math::IntervalSearch >= 1.05 >= 1.05 1.05 RRDs >= 1.000461 >= 1.0.46 1.0.46 - Storable >= 2.12 >= 2.12 2.12 + Storable >= 2.13 >= 2.13 2.13 Time::HiRes Not required by Orca 1.59 version >= 0.39 >= 0.39 0.39 @@ -268,10 +268,10 @@ Storable - http://www.perl.com/CPAN/authors/id/A/AM/AMS/Storable-2.12.tar.gz + http://www.perl.com/CPAN/authors/id/A/AM/AMS/Storable-2.13.tar.gz - % gunzip -c Storable-2.12.tar.gz | tar xvf - - % cd Storable-2.12 + % gunzip -c Storable-2.13.tar.gz | tar xvf - + % cd Storable-2.13 % perl Makefile.PL % make % make test Modified: trunk/orca/configure.in ============================================================================== --- trunk/orca/configure.in (original) +++ trunk/orca/configure.in Sat Jul 3 10:38:07 2004 @@ -39,8 +39,8 @@ MATH_INTERVALSEARCH_VER=1.05 RRDTOOL_DIR=rrdtool-1.0.46 RRDTOOL_VER=1.000461 -STORABLE_DIR=Storable-2.12 -STORABLE_VER=2.12 +STORABLE_DIR=Storable-2.13 +STORABLE_VER=2.13 TIME_HIRES_DIR=Time-HiRes-1.59 TIME_HIRES_VER=1.59 VERSION_DIR=version-0.39 Modified: trunk/orca/packages/Storable-2.13/ChangeLog ============================================================================== --- trunk/orca/packages/Storable-2.12/ChangeLog (original) +++ trunk/orca/packages/Storable-2.13/ChangeLog Sat Jul 3 10:38:07 2004 @@ -1,3 +1,12 @@ +Thu Jun 17 12:26:43 BST 2004 Nicholas Clark + + Version 2.13 + + 1. Don't change the type of top level overloaded references to RV - + they are perfectly correct as PVMG + 2. Storable needs to cope with incoming frozen data that happens to be + utf8 encoded. + Wed Mar 17 15:40:29 GMT 2004 Nicholas Clark Version 2.12 Modified: trunk/orca/packages/Storable-2.13/MANIFEST ============================================================================== --- trunk/orca/packages/Storable-2.12/MANIFEST (original) +++ trunk/orca/packages/Storable-2.13/MANIFEST Sat Jul 3 10:38:07 2004 @@ -23,6 +23,7 @@ t/lock.t See if Storable works t/make_56_interwork.pl Make test data for interwork56.t t/make_downgrade.pl Make test data for downgrade.t +t/make_overload.pl Make test data for overload.t t/malice.t See if Storable copes with corrupt files t/overload.t See if Storable works t/recurse.t See if Storable works Modified: trunk/orca/packages/Storable-2.13/README ============================================================================== --- trunk/orca/packages/Storable-2.12/README (original) +++ trunk/orca/packages/Storable-2.13/README Sat Jul 3 10:38:07 2004 @@ -1,4 +1,4 @@ - Storable 2.12 + Storable 2.13 Copyright (c) 1995-2000, Raphael Manfredi Copyright (c) 2001-2004, Larry Wall Modified: trunk/orca/packages/Storable-2.13/Storable.pm ============================================================================== --- trunk/orca/packages/Storable-2.12/Storable.pm (original) +++ trunk/orca/packages/Storable-2.13/Storable.pm Sat Jul 3 10:38:07 2004 @@ -21,7 +21,7 @@ use AutoLoader; use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.12'; +$VERSION = '2.13'; *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... # Modified: trunk/orca/packages/Storable-2.13/Storable.xs ============================================================================== --- trunk/orca/packages/Storable-2.12/Storable.xs (original) +++ trunk/orca/packages/Storable-2.13/Storable.xs Sat Jul 3 10:38:07 2004 @@ -4287,9 +4287,8 @@ */ if (cname) { - /* Do not use sv_upgrade to preserve STASH */ - SvFLAGS(rv) &= ~SVTYPEMASK; - SvFLAGS(rv) |= SVt_RV; + /* No need to do anything, as rv will already be PVMG. */ + assert (SvTYPE(rv) >= SVt_RV); } else { sv_upgrade(rv, SVt_RV); } @@ -5798,8 +5797,46 @@ KBUFINIT(); /* Allocate hash key reading pool once */ - if (!f && in) + if (!f && in) { +#ifdef SvUTF8_on + if (SvUTF8(in)) { + STRLEN length; + const char *orig = SvPV(in, length); + char *asbytes; + /* This is quite deliberate. I want the UTF8 routines + to encounter the '\0' which perl adds at the end + of all scalars, so that any new string also has + this. + */ + STRLEN klen_tmp = length + 1; + bool is_utf8 = TRUE; + + /* Just casting the &klen to (STRLEN) won't work + well if STRLEN and I32 are of different widths. + --jhi */ + asbytes = (char*)bytes_from_utf8((U8*)orig, + &klen_tmp, + &is_utf8); + if (is_utf8) { + CROAK(("Frozen string corrupt - contains characters outside 0-255")); + } + if (asbytes != orig) { + /* String has been converted. + There is no need to keep any reference to + the old string. */ + in = sv_newmortal(); + /* We donate the SV the malloc()ed string + bytes_from_utf8 returned us. */ + SvUPGRADE(in, SVt_PV); + SvPOK_on(in); + SvPVX(in) = asbytes; + SvLEN(in) = klen_tmp; + SvCUR(in) = klen_tmp - 1; + } + } +#endif MBUF_SAVE_AND_LOAD(in); + } /* * Magic number verifications. Added: trunk/orca/packages/Storable-2.13/t/make_overload.pl ============================================================================== --- (empty file) +++ trunk/orca/packages/Storable-2.13/t/make_overload.pl Sat Jul 3 10:38:07 2004 @@ -0,0 +1,13 @@ +#!/usr/local/bin/perl -w +use strict; + +use Storable qw(nfreeze); +use HAS_OVERLOAD; + +my $o = HAS_OVERLOAD->make("snow"); +my $f = nfreeze \$o; + +my $uu = pack 'u', $f; + +print $uu; + Modified: trunk/orca/packages/Storable-2.13/t/utf8.t ============================================================================== --- trunk/orca/packages/Storable-2.12/t/utf8.t (original) +++ trunk/orca/packages/Storable-2.13/t/utf8.t Sat Jul 3 10:38:07 2004 @@ -1,3 +1,4 @@ + #!./perl -w # # Copyright (c) 1995-2000, Raphael Manfredi @@ -30,7 +31,7 @@ use Storable qw(thaw freeze); -print "1..3\n"; +print "1..6\n"; my $x = chr(1234); ok 1, $x eq ${thaw freeze \$x}; @@ -43,3 +44,20 @@ $x = chr (175) . chr (256); chop $x; ok 3, $x eq ${thaw freeze \$x}; + +# Storable needs to cope if a frozen string happens to be internall utf8 +# encoded + +$x = chr 256; +my $data = freeze \$x; +ok 4, $x eq ${thaw $data}; + +$data .= chr 256; +chop $data; +ok 5, $x eq ${thaw $data}; + + +$data .= chr 256; +# This definately isn't valid +eval {thaw $data}; +ok 6, $@ =~ /corrupt.*characters outside/; From blair at orcaware.com Sat Jul 3 17:56:59 2004 From: blair at orcaware.com (Blair Zajac) Date: Sat, 3 Jul 2004 17:56:59 -0700 Subject: [Orca-checkins] r365 - trunk/orca/lib/Orca Message-ID: <200407040056.i640ux6J000885@orcaware.com> Author: blair Date: Sat Jul 3 17:54:34 2004 New Revision: 365 Modified: trunk/orca/lib/Orca/HTMLFile.pm Log: * lib/Orca/HTMLFile.pm (DESTROY): Remove some unwarranted HTML markup. Modified: trunk/orca/lib/Orca/HTMLFile.pm ============================================================================== --- trunk/orca/lib/Orca/HTMLFile.pm (original) +++ trunk/orca/lib/Orca/HTMLFile.pm Sat Jul 3 17:54:34 2004 @@ -136,10 +136,6 @@ evidence that this has some effect. --> blair@orcaware.com - - Orca home page -    From blair at orcaware.com Sat Jul 3 23:17:26 2004 From: blair at orcaware.com (Blair Zajac) Date: Sat, 3 Jul 2004 23:17:26 -0700 Subject: [Orca-checkins] r366 - in trunk/orca: lib/Orca orca Message-ID: <200407040617.i646HQ7Y007024@orcaware.com> Author: blair Date: Sat Jul 3 23:14:36 2004 New Revision: 366 Modified: trunk/orca/lib/Orca/Config.pm trunk/orca/lib/Orca/ImageFile.pm trunk/orca/orca/orca.pl.in Log: Add the ability to add a horizontal line (rule) using a new hrule configuration parameter to a plot. Patch by Jon Tankersley . * orca/orca.pl.in (pod): Add documentation for the new hrule plot parameter. * lib/Orca/Config.pm: (%pcl_plot_elements), (%pcl_plot_append_elements), Add hrule to these hashes. (check_config): Initialize the hrule's array reference if it doesn't exist in the plot. * lib/Orca/ImageFile.pm (_update_graph_options): Add all the hrule's to the RRDs::graph options. Modified: trunk/orca/lib/Orca/Config.pm ============================================================================== --- trunk/orca/lib/Orca/Config.pm (original) +++ trunk/orca/lib/Orca/Config.pm Sat Jul 3 23:14:36 2004 @@ -102,6 +102,7 @@ data_type => 1, flush_regexps => 1, href => 1, + hrule => 1, legend => 1, line_type => 1, logarithmic => 1, @@ -127,6 +128,7 @@ data_min => 1, data_max => 1, data_type => 1, + hrule => 1, legend => 1, line_type => 1, summary_format => 1); @@ -830,7 +832,7 @@ $plot->{y_legend} = $plot->{legend}[0]; } - # Set the colors of any data not defined. + # Set the colors of any data's not defined. $plot->{color} = [] unless defined $plot->{color}; for (my $k=@{$plot->{color}}; $k<$number_datas; ++$k) { $plot->{color}[$k] = data_index_to_color($k); @@ -873,6 +875,9 @@ } $plot->{title} = $title; } + + # The hrule array reference must exist. + $plot->{hrule} = [] unless defined $plot->{hrule} } $number_errors; Modified: trunk/orca/lib/Orca/ImageFile.pm ============================================================================== --- trunk/orca/lib/Orca/ImageFile.pm (original) +++ trunk/orca/lib/Orca/ImageFile.pm Sat Jul 3 23:14:36 2004 @@ -180,6 +180,13 @@ my $rrd_version = $rrd->version; push(@options, "DEF:average$i=$rrd_filename:Orca$rrd_version:AVERAGE"); } + + # Add any hrule's to the plot. + for (my $i=0; $i<@{$plot_ref->{hrule}}; ++$i) { + push(@options, "HRULE:$plot_ref->{hrule}[$i]"); + } + + # Put the legends on the plot. my @legends; my $max_legend_length = 0; for (my $i=0; $i<$data_sources; ++$i) { Modified: trunk/orca/orca/orca.pl.in ============================================================================== --- trunk/orca/orca/orca.pl.in (original) +++ trunk/orca/orca/orca.pl.in Sat Jul 3 23:14:36 2004 @@ -2234,11 +2234,19 @@ the exact text matched by the ()'s and %G is replaced with the same text, except the first character is capitalized. -=item B +=item B I Setting B sets the text to be displayed along the Y axis of the PNG plot. +=item B I#I[:I] + +Draw a horizontal line (rule) into the graph at the vertical Y +I with the specified color I and optionally add a +I for it. + +An arbitrary number of B's may be added to a plot. + =back =head2 Multiple Plot Plotting Parameters From blair at orcaware.com Sun Jul 4 11:24:43 2004 From: blair at orcaware.com (Blair Zajac) Date: Sun, 4 Jul 2004 11:24:43 -0700 Subject: [Orca-checkins] r367 - trunk/orca/lib/Orca Message-ID: <200407041824.i64IOhQO028921@orcaware.com> Author: blair Date: Sun Jul 4 11:22:17 2004 New Revision: 367 Modified: trunk/orca/lib/Orca/ImageFile.pm Log: * lib/Orca/ImageFile.pm (add_additional_plot): Do not copy the hrule attributes from the additional plot to the existing image, as hrule's do not change as plots are added to an image. Modified: trunk/orca/lib/Orca/ImageFile.pm ============================================================================== --- trunk/orca/lib/Orca/ImageFile.pm (original) +++ trunk/orca/lib/Orca/ImageFile.pm Sun Jul 4 11:22:17 2004 @@ -249,12 +249,15 @@ # For those attributes of the new plot that are array references # and need to be indexed for the particular data being plotted, # copy them over. Skip the 'created_orca_images' attribute which - # is not used for plotting and skip the color attribute as the - # color is treated specially. + # is not used for plotting. Skip the color attribute as the color + # is treated specially below. Skip the hrule attribute as the + # hrule's do not change as additional data sources are added to an + # image. for my $attribute (keys %$new_plot_ref) { + next unless UNIVERSAL::isa($new_plot_ref->{$attribute}, 'ARRAY'); next if $attribute eq 'color'; next if $attribute eq 'created_orca_images'; - next unless UNIVERSAL::isa($new_plot_ref->{$attribute}, 'ARRAY'); + next if $attribute eq 'hrule'; $existing_plot_ref->{$attribute}[$i] = $new_plot_ref->{$attribute}[$j]; } From blair at orcaware.com Sun Jul 4 13:02:27 2004 From: blair at orcaware.com (Blair Zajac) Date: Sun, 4 Jul 2004 13:02:27 -0700 Subject: [Orca-checkins] r368 - trunk/orca/lib/Orca Message-ID: <200407042002.i64K2RS9001104@orcaware.com> Author: blair Date: Sun Jul 4 12:58:53 2004 New Revision: 368 Modified: trunk/orca/lib/Orca/SourceFile.pm Log: * lib/Orca/SourceFile.pm (add_plots): Do not allow data expressions that have a # in them to compile when the column name is not in the data file, otherwise the compiled Perl subroutine may compile and will return undef. Modified: trunk/orca/lib/Orca/SourceFile.pm ============================================================================== --- trunk/orca/lib/Orca/SourceFile.pm (original) +++ trunk/orca/lib/Orca/SourceFile.pm Sun Jul 4 12:58:53 2004 @@ -553,16 +553,18 @@ # not changing the original plot structure. Look through each # element of each data and look for names appearing in the column # description array. If there is a match for this file, then - # convert the element to index the @_ array where the data will be - # pulled from. If there is not a match, then see if the element - # matches a name from one of the other column names from the same + # replace the column name with the Perl code that indexes the @_ + # array for use in a dynamically generated anonymous subroutine. + # If there is no match, then see if the element matches a name + # from one of the other column names from other files in the same # group. In this case the data argument for this file will not be # used. - # To allow data gathering program to send unknown values to Orca, - # check if any of the substituted values equals 'U' and return - # immediately the value 'U' to pass to RRDtool. Keep track of the - # substituted values. + # This hash is keyed by the Perl expression that indexes the @_ + # array in the dynamically generated anonymous subroutine. The + # keys of this hash are checked later on to see if the value is + # undefined or 'U', in which case the subroutine returns 'U' + # early instead of evaluating the entire data expression. my %substituted_values; my @datas; @@ -599,18 +601,17 @@ } } - # Because users may place code into the data statements that do not - # have any substitutions, then the only way to check for the validity - # is to create valid anonymous subroutines and try them. Invalid - # ones will either return undef or fail to compile. If the plot is - # required, then replace invalid subroutines with one that returns 0. - # Here the results of eval'ing a test subroutine on a data is kept. - # The cached result is either a 1 or a 0. To test the subroutine, - # pass the newly created subroutine a fake array of numbers, where the - # array has as manay elements as there are in one line from the file. - # If it is an invalid subroutine but the plot is required, then set - # the subroutine to return 'U', which is RRD's way of declaring - # undefined data. + # Because users may place code into the data statements that do + # not have any substitutions, then the only way to check for the + # validity is to create valid anonymous subroutines and try them. + # Invalid ones will either return undef or fail to compile. If + # the plot is required, then replace invalid subroutines with one + # that returns the character 'U', which is RRD's way of declaring + # undefined data. Here the results of eval'ing a test subroutine + # on a data is kept. The cached result is either a 1 or a 0. To + # test the subroutine, pass the newly created subroutine a fake + # array of numbers, where the array has as many elements as there + # are in one line from the file. my @fake_numbers = 1 .. @column_description; my @substituted_data_expressions; my $one_ok_data = 0; @@ -619,9 +620,23 @@ if (defined $datas[$j]) { my $sub_expr = "sub {\n"; foreach my $s (sort keys %substituted_values) { - $sub_expr .= " if (!defined($s) || $s eq 'U') { return 'U';\n }\n"; + $sub_expr .= " if (!defined($s) || $s eq 'U') { return 'U'; }\n"; } - $data_expression = "@{$datas[$j]}"; + + # The extra set of parentheses around the data statement are + # added to cause a compile failure in the subroutine if the + # column name in the data expression has a # in it and the + # file does not have that column name in it. Otherwise, the + # expression may compile successfully, but return undef. For + # example, for the data expression + # data #httpds + # the subroutine will be + # sub { + # return #httpds; + # } + # Adding the parentheses around '#httpds' will cause a compile + # failure because the opening parenthesis is not closed. + $data_expression = "(@{$datas[$j]})"; $sub_expr .= " $data_expression;\n}"; my $sub_expr_md5 = md5($data_expression); my $eval_result = $choose_data_sub_cache{$sub_expr_md5}; @@ -640,12 +655,12 @@ $eval_result = 0; $@ =~ s/\s+$//g; my $m = $old_i + 1; - $message = "$0: warning: cannot compile '$sub_expr' for " . + $message = "$0: warning: cannot compile\n$sub_expr\nfor " . "plot #$m 'data @{$plot->{data}[$j]}': $@\n"; } elsif (!defined $test_value) { $eval_result = 0; my $m = $old_i + 1; - $message = "$0: warning: testing of '$sub_expr' for " . + $message = "$0: warning: testing of\n$sub_expr\nfor " . "plot #$m 'data @{$plot->{data}[$j]}' yielded " . "an undefined value.\n"; } From blair at orcaware.com Tue Jul 6 21:15:43 2004 From: blair at orcaware.com (Blair Zajac) Date: Tue, 6 Jul 2004 21:15:43 -0700 Subject: [Orca-checkins] r370 - trunk/orca/data_gatherers/aix Message-ID: <200407070415.i674FhIv012302@orcaware.com> Author: blair Date: Tue Jul 6 21:10:09 2004 New Revision: 370 Removed: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in Log: Step 1 of moving deleting orca-aix-stat.pl.in and renaming orca-aixtsm-stat.pl.in to orca-aix-stat.pl.in. Since the differences between orca-aixtsm-stat.pl.in and orca-aix-stat.pl.in are just the addition of some TSM statistics, it's better just to have a single script that measures everything with an optional flag to turn on or off the new measurements. * data_gatherers/aix/orca-aix-stat.pl.in: Removed. From blair at orcaware.com Tue Jul 6 21:25:29 2004 From: blair at orcaware.com (Blair Zajac) Date: Tue, 6 Jul 2004 21:25:29 -0700 Subject: [Orca-checkins] r371 - in trunk/orca: . data_gatherers/aix Message-ID: <200407070425.i674PT77012886@orcaware.com> Author: blair Date: Tue Jul 6 21:21:42 2004 New Revision: 371 Added: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in - copied unchanged from r370, trunk/orca/data_gatherers/aix/orca-aixtsm-stat.pl.in Removed: trunk/orca/data_gatherers/aix/orca-aixtsm-stat.pl.in Modified: trunk/orca/configure.in trunk/orca/data_gatherers/aix/Makefile.in Log: Step 2 of moving deleting orca-aix-stat.pl.in and renaming orca-aixtsm-stat.pl.in to orca-aix-stat.pl.in. * data_gatherers/aix/orca-aix-stat.pl.in: Renamed from orca-aixtsm-stat.pl.in. * data_gatherers/aix/Makefile.in: Remove all rules related to orca-aixtsm-stat.pl. * configure.in: Do not create data_gatherers/aix/orca-aixtsm-stat.pl. Modified: trunk/orca/configure.in ============================================================================== --- trunk/orca/configure.in (original) +++ trunk/orca/configure.in Tue Jul 6 21:21:42 2004 @@ -626,8 +626,7 @@ #-------------------------------------------------------------------- if test "$BUILD_AIXALLATOR" = yes; then OUTPUT_AIXALLATOR="data_gatherers/aix/Makefile - data_gatherers/aix/orca-aix-stat.pl - data_gatherers/aix/orca-aixtsm-stat.pl" + data_gatherers/aix/orca-aix-stat.pl" fi if test "$BUILD_HPALLATOR" = yes; then Modified: trunk/orca/data_gatherers/aix/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/aix/Makefile.in (original) +++ trunk/orca/data_gatherers/aix/Makefile.in Tue Jul 6 21:21:42 2004 @@ -10,7 +10,7 @@ VAR_DIR = @VAR_DIR@ RAW_ORCALLATOR_DIR = $(VAR_DIR)/orcallator -BIN_PERL_SCRIPTS = orca-aix-stat orca-aixtsm-stat +BIN_PERL_SCRIPTS = orca-aix-stat LIBEXEC_PERL_SCRIPTS = NOINST_PERL_SCRIPTS = PERL_SCRIPTS = $(BIN_PERL_SCRIPTS) \ @@ -44,7 +44,7 @@ $(RM) $(TARGETS) distclean: clean - $(RM) *.sh orca-aix-stat.pl orca-aixtsm-stat.pl Makefile + $(RM) *.sh orca-aix-stat.pl Makefile .SUFFIXES: .pl .sh @@ -61,6 +61,3 @@ orca-aix-stat.pl: orca-aix-stat.pl.in cd ../.. && CONFIG_FILES=data_gatherers/aix/orca-aix-stat.pl ./config.status - -orca-aixtsm-stat.pl: orca-aixtsm-stat.pl.in - cd ../.. && CONFIG_FILES=data_gatherers/aix/orca-aixtsm-stat.pl ./config.status From blair at orcaware.com Tue Jul 6 22:48:38 2004 From: blair at orcaware.com (Blair Zajac) Date: Tue, 6 Jul 2004 22:48:38 -0700 Subject: [Orca-checkins] r372 - in trunk/orca/data_gatherers: aix hp Message-ID: <200407070548.i675mcg6016445@orcaware.com> Author: blair Date: Tue Jul 6 22:43:40 2004 New Revision: 372 Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Log: Begin massive Perl cleanup of orca-aix-stat.pl.in and orca-hp-stat.pl.in. * data_gatherers/aix/orca-aix-stat.pl.in, * data_gatherers/hp/orca-hp-stat.pl.in: Whitespace fixes and indent using two spaces per level. Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in (original) +++ trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in Tue Jul 6 22:43:40 2004 @@ -76,30 +76,24 @@ ############################## # Parse the command line arguments -while ( $#ARGV >= 0 ) { - - if ( $ARGV[0] eq "-r" ) { - shift @ARGV; - $OUT_ROOT = shift @ARGV; - } - elsif ( $ARGV[0] eq "-i" ) { - shift @ARGV; - $INTERVAL = shift @ARGV; - } - elsif ( $ARGV[0] eq "-d" ) { - shift @ARGV; - $DURATION = shift @ARGV; - } - elsif ( $ARGV[0] eq "-h" ) { - print $Usage_Message; - exit 0; - } - elsif ( $ARGV[0] =~ /^-/ ) { - die "Invalid flag: $ARGV[0]\n$Usage_Message"; - } - else { - die "Invalid argument: $ARGV[0]\n$Usage_Message"; - } +while ($#ARGV >= 0) { + if ($ARGV[0] eq "-r" ) { + shift @ARGV; + $OUT_ROOT = shift @ARGV; + } elsif ($ARGV[0] eq "-i" ) { + shift @ARGV; + $INTERVAL = shift @ARGV; + } elsif ($ARGV[0] eq "-d" ) { + shift @ARGV; + $DURATION = shift @ARGV; + } elsif ($ARGV[0] eq "-h" ) { + print $Usage_Message; + exit 0; + } elsif ($ARGV[0] =~ /^-/ ) { + die "Invalid flag: $ARGV[0]\n$Usage_Message"; + } else { + die "Invalid argument: $ARGV[0]\n$Usage_Message"; + } } ## BEGIN set defaults @@ -112,13 +106,18 @@ ## Derived variables. $iterations = $DURATION * 60 * 60 / $INTERVAL; # Number of checks. -chomp( $HOST = `uname -n` ); +chomp($HOST = `uname -n`); $out_dir = "${OUT_ROOT}/${HOST}"; -( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = +($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $stat_file = - sprintf( "%s/percol-%.2d-%.2d-%.2d-%1d%.2d", $out_dir, $year + 1900, $mon + 1, - $mday, $hour, $min ); + sprintf("%s/percol-%.2d-%.2d-%.2d-%1d%.2d", + $out_dir, + $year + 1900, + $mon + 1, + $mday, + $hour, + $min); # Base all timestamps on start time. $start_time = time(); @@ -128,30 +127,28 @@ #open IN, "ifconfig -a|"; open IN, "netstat -ni|"; while () { - - # if ( /^(\S+):/ ) { - if (/^(\w+).*link/) { - push @net_interfaces, $1; - } + # if (/^(\S+):/ ) { + if (/^(\w+).*link/) { + push @net_interfaces, $1; + } } close IN; # Grab some base system info prior to collecting stats. open IN, "lsattr -El sys0 -a realmem |"; while () { - if (/^realmem (\d+) /) { - $pagestotl = $1 * 1024 / 4096; # Grab realmem in KB and convert to pages. - $mem_totl = $1 * 1024; # Grab realmem in KB and convert to Bytes. - - # this gets used down in the vmstat section - } + if (/^realmem (\d+) /) { + $pagestotl = $1 * 1024 / 4096; # Grab realmem in KB and convert to pages. + $mem_totl = $1 * 1024; # Grab realmem in KB and convert to Bytes. + # this gets used down in the vmstat section + } } close IN; ## Make sure we can write output. umask 0022; # make sure the file can be harvested unless ( -d $out_dir ) { - system( "mkdir", "-p", "$out_dir" ); + system( "mkdir", "-p", "$out_dir" ); } open OUT, ">$stat_file" or die "ERROR: Could not open $stat_file: $!"; my $oldfh = select OUT; @@ -171,450 +168,431 @@ $prev_info_cnt = 0; while ( $iterations-- > 0 ) { - - $timestamp = $timestamp ? time() : $start_time; - ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = - localtime(time); - $locltime = sprintf( "%.2d:%.2d:%.2d", $hour, $min, $sec ); - - ## Get runq data - ## Get runq data - $uptime = 0; - open IN, "uptime |"; - while () { - if (/load average:\s+(\S+),\s+(\S+),\s+(\S+)/) { - $load_info = join "\t", $1, $2, $3; - } - @upt = split(/ +/,); - $uptd = $upt[3]; - $nusr = $upt[6]; - $up_day = $uptd * 24 * 60 * 60; - if (/days,\s+(\S+):(\S+), /) { - $up_hrs = $1 * 60 * 60; - $up_min = $2 * 60; - } - $uptime = $up_day + $up_hrs + $up_min; - } - close IN; - $load_header = "1runq\t5runq\t15runq"; - $up_header = "uptime\tnusr"; - $up_info = "$uptime\t$nusr"; - - if ( scalar( split ' ', $load_header ) != scalar( split ' ', $load_info ) ) - { - $load_header = ''; - $load_info = ''; - $need_header = 1; - print STDERR "WARNING: load header does not match load info.\n"; - } - if ( scalar( split ' ', $up_header ) != scalar( split ' ', $up_info ) ) - { - $up_header = ''; - $up_info = ''; - $need_header = 1; - print STDERR "WARNING: UP header does not match load info.\n"; - } - - - ## Get number of system processes - $num_proc = -1; # Don't count the header. - open IN, "ps -ek |"; - while () { - $num_proc++; - } - close IN; - $proc_info = $num_proc; - $proc_header = '#proc'; - - if ( scalar( split ' ', $proc_header ) != scalar( split ' ', $proc_info ) ) - { - $proc_header = ''; - $proc_info = ''; - $need_header = 1; - print STDERR "WARNING: #proc header does not match #proc info.\n"; - } - - ## Get pstat data for pages - $sw_used = 0; - $sw_free = 0; - open IN, "pstat -s |tail -3 |"; - while () { - @swp = split(/ +/,); - if (/\d/) { - $sw_used = $swp[1]; - $sw_free = $swp[2]; - $swap_used = $sw_used * 4096; - $swap_free = $sw_free * 4096; - } - } - close IN; - $swap_info = "$swap_used\t$swap_free"; - $swap_header = "\tswap_used\tswap_free"; - - if ( scalar( split ' ', $swap_header ) != - scalar( split ' ', $swap_info ) ) - { - print STDERR "WARNING: pstat header does not match pstat info.\n"; - $swap_header = ''; - $swap_info = ''; - $need_header = 1; - } - - - - ## Get vmstat data - open IN, "vmstat 1 2|"; - while () { - chomp; - if (/^[\s\d]+$/) { - - # overwrite first line on 2nd pass - ( - $vmstat_r, $vmstat_b, $vmstat_avm, $vmstat_fre, - $vmstat_re, $vmstat_pi, $vmstat_po, $vmstat_fr, - $vmstat_sr, $vmstat_cy, $vmstat_inf, $vmstat_syf, - $vmstat_csf, $vmstat_us, $vmstat_sy, $vmstat_id, - $vmstat_wa ) - = split; - $vmstat_info = join "\t", $vmstat_r, $vmstat_b, $vmstat_avm, - $vmstat_fre, $pagestotl, $vmstat_pi, $vmstat_po, $vmstat_fr, - $vmstat_sr, $vmstat_us, $vmstat_sy, $vmstat_wa, $vmstat_id; - } - } - close IN; - $vmstat_header = -"runque\twaiting\tpagesactive\tpagesfree\tpagestotl\tPagesI/s\tPagesO/s\tPagesF/s\tscanrate\tusr%\tsys%\twio%\tidle%"; - - if ( scalar( split ' ', $vmstat_header ) != - scalar( split ' ', $vmstat_info ) ) - { - print STDERR "WARNING: vmstat header does not match vmstat info.\n"; - $vmstat_header = ''; - $vmstat_info = ''; - $need_header = 1; - } - - ## Get filesystem data - $fs_header = ''; - $fs_info = ''; - open IN, "df -k -v |"; - while () { - chomp; - - if (m%^/dev%) { - ( $mnt_dev, $blocks, $used, $free, $pct_used, $iused, $ifree, - $ipct_used, $mnt ) = split; - - # Recalculate percents because df rounds. - $fs_info .= "\t" - . sprintf( "%s\t%s\t%s\t%.5f\t%d\t%s\t%s\t%.5f", $blocks, $used, - $free, ( $used / $blocks ) * 100, ( $iused + $ifree ), $iused, - $ifree, ( $iused / ( $iused + $ifree ) ) * 100 ); - $fs_header .= "\t" . join "\t", "mntC_$mnt", "mntU_$mnt", - "mntA_$mnt", "mntP_$mnt", "mntc_$mnt", "mntu_$mnt", "mnta_$mnt", - "mntp_$mnt"; - } - } - close IN; - - if ( scalar( split ' ', $fs_header ) != scalar( split ' ', $fs_info ) ) { - print STDERR - "WARNING: filesystem header does not match filesystem info.\n"; - $fs_header = ''; - $fs_info = ''; - $need_header = 1; - } - - ## Get iostat data - $disk_t = 0; - $disk_rK = 0; - $disk_wK = 0; - undef %disks; - open IN, "iostat -d 1 2|"; - - while () { - if (/^(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\d+)\s+(\d+)/) { - my $disk = $1; - my $tps = $2; - my $rK = $3; - my $wK = $4; - if ( not $disks{$disk} ) { - $disks{$disk}++; # Get rK & wK from first pass. - $disk_rK += $rK; - $disk_wK += $wK; - } - else { - $disk_t += $tps; # Get trans per sec from second pass. - } - } + $timestamp = $timestamp ? time() : $start_time; + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(time); + $locltime = sprintf( "%.2d:%.2d:%.2d", $hour, $min, $sec ); + + ## Get runq data + $uptime = 0; + open IN, "uptime |"; + while () { + if (/load average:\s+(\S+),\s+(\S+),\s+(\S+)/) { + $load_info = join "\t", $1, $2, $3; + } + @upt = split(/ +/,); + $uptd = $upt[3]; + $nusr = $upt[6]; + $up_day = $uptd * 24 * 60 * 60; + if (/days,\s+(\S+):(\S+), /) { + $up_hrs = $1 * 60 * 60; + $up_min = $2 * 60; + } + $uptime = $up_day + $up_hrs + $up_min; + } + close IN; + $load_header = "1runq\t5runq\t15runq"; + $up_header = "uptime\tnusr"; + $up_info = "$uptime\t$nusr"; + + if (scalar(split ' ', $load_header) != scalar(split ' ', $load_info)) { + $load_header = ''; + $load_info = ''; + $need_header = 1; + warn "WARNING: load header does not match load info.\n"; + } + + if (scalar(split ' ', $up_header) != scalar(split ' ', $up_info)) { + $up_header = ''; + $up_info = ''; + $need_header = 1; + warn "WARNING: UP header does not match load info.\n"; + } + + ## Get number of system processes + $num_proc = -1; # Don't count the header. + open IN, "ps -ek |"; + while () { + $num_proc++; + } + close IN; + $proc_info = $num_proc; + $proc_header = '#proc'; + + if (scalar(split ' ', $proc_header) != scalar(split ' ', $proc_info)) { + $proc_header = ''; + $proc_info = ''; + $need_header = 1; + warn "WARNING: #proc header does not match #proc info.\n"; + } + + ## Get pstat data for pages + $sw_used = 0; + $sw_free = 0; + open IN, "pstat -s |tail -3 |"; + while () { + @swp = split(/ +/,); + if (/\d/) { + $sw_used = $swp[1]; + $sw_free = $swp[2]; + $swap_used = $sw_used * 4096; + $swap_free = $sw_free * 4096; + } + } + close IN; + $swap_info = "$swap_used\t$swap_free"; + $swap_header = "\tswap_used\tswap_free"; + + if (scalar(split ' ', $swap_header) != scalar(split ' ', $swap_info)) { + warn "WARNING: pstat header does not match pstat info.\n"; + $swap_header = ''; + $swap_info = ''; + $need_header = 1; + } + + ## Get vmstat data + open IN, "vmstat 1 2|"; + while () { + chomp; + if (/^[\s\d]+$/) { + # overwrite first line on 2nd pass + my ($vmstat_r, $vmstat_b, $vmstat_avm, $vmstat_fre, + $vmstat_re, $vmstat_pi, $vmstat_po, $vmstat_fr, + $vmstat_sr, $vmstat_cy, $vmstat_inf, $vmstat_syf, + $vmstat_csf, $vmstat_us, $vmstat_sy, $vmstat_id, + $vmstat_wa) + = split; + $vmstat_info = join("\t", + $vmstat_r, $vmstat_b, $vmstat_avm, $vmstat_fre, + $pagestotl, $vmstat_pi, $vmstat_po, $vmstat_fr, + $vmstat_sr, $vmstat_us, $vmstat_sy, $vmstat_wa, + $vmstat_id); + } + } + close IN; + $vmstat_header = "runque\twaiting\tpagesactive\tpagesfree\tpagestotl\t" . + "PagesI/s\tPagesO/s\tPagesF/s\tscanrate\tusr%\tsys%\t" . + "wio%\tidle%"; + + if (scalar(split ' ', $vmstat_header) != scalar(split ' ', $vmstat_info)) { + warn "WARNING: vmstat header does not match vmstat info.\n"; + $vmstat_header = ''; + $vmstat_info = ''; + $need_header = 1; + } + + ## Get filesystem data + $fs_header = ''; + $fs_info = ''; + open IN, "df -k -v |"; + while () { + chomp; + if (m%^/dev%) { + my ($mnt_dev, $blocks, $used, $free, $pct_used, $iused, $ifree, + $ipct_used, $mnt) = split; + + # Recalculate percents because df rounds. + $fs_info .= "\t" + . sprintf("%s\t%s\t%s\t%.5f\t%d\t%s\t%s\t%.5f", + $blocks, + $used, + $free, + 100*($used/$blocks), + ($iused + $ifree), + $iused, + $ifree, + 100*$iused/($iused + $ifree)); + $fs_header .= "\t" . join("\t", + "mntC_$mnt", "mntU_$mnt", "mntA_$mnt", + "mntP_$mnt", "mntc_$mnt", "mntu_$mnt", + "mnta_$mnt", "mntp_$mnt"); + } + } + close IN; + + if (scalar(split ' ', $fs_header) != scalar(split ' ', $fs_info)) { + warn "WARNING: filesystem header does not match filesystem info.\n"; + $fs_header = ''; + $fs_info = ''; + $need_header = 1; + } + + ## Get iostat data + $disk_t = 0; + $disk_rK = 0; + $disk_wK = 0; + undef %disks; + open IN, "iostat -d 1 2|"; + + while () { + if (/^(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\d+)\s+(\d+)/) { + my $disk = $1; + my $tps = $2; + my $rK = $3; + my $wK = $4; + if (not $disks{$disk}) { + $disks{$disk}++; # Get rK & wK from first pass. + $disk_rK += $rK; + $disk_wK += $wK; + } else { + $disk_t += $tps; # Get trans per sec from second pass. + } + } + } + close IN; + $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s"; + $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; + + if (scalar(split ' ', $iostat_header) != scalar(split ' ', $iostat_info)) { + warn "WARNING: iostat header does not match iostat info.\n"; + $iostat_header = ''; + $iostat_info = ''; + $need_header = 1; + } + + ## Get packet data + $packet_header = ''; + $packet_info = ''; + + #foreach $interface ( split(/\s+/, $NET_INTERFACES) ) { + foreach $interface (@net_interfaces) { + $packet_header .= "\t${interface}Ipkt/s\t${interface}IErr/s\t" . + "${interface}Opkt/s\t${interface}OErr/s\t" . + "${interface}Coll/s\t"; + + open IN, "netstat -n -I $interface 1|"; + while () { + if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) { + $packet_info .= "\t" . join("\t", $1, $2, $3, $4, $5); + last; + } } close IN; - $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s"; - $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; - - if ( scalar( split ' ', $iostat_header ) != - scalar( split ' ', $iostat_info ) ) - { - print STDERR "WARNING: iostat header does not match iostat info.\n"; - $iostat_header = ''; - $iostat_info = ''; - $need_header = 1; - } - - ## Get packet data - $packet_header = ''; - $packet_info = ''; - - #foreach $interface ( split(/\s+/, $NET_INTERFACES) ) { - foreach $interface (@net_interfaces) { - $packet_header .= -"\t${interface}Ipkt/s\t${interface}IErr/s\t${interface}Opkt/s\t${interface}OErr/s\t${interface}Coll/s\t"; - open IN, "netstat -n -I $interface 1|"; - - while () { - if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) { - $packet_info .= "\t" . join "\t", $1, $2, $3, $4, $5; - last; - } - } - close IN; - } - - if ( scalar( split ' ', $packet_header ) != - scalar( split ' ', $packet_info ) ) - { - print STDERR "WARNING: packet header does not match packet info.\n"; - $packet_header = ''; - $packet_info = ''; - $need_header = 1; - } + } +} - ## Get TCP Connection data - $tcp_estb = 0; - open IN, "netstat -an |"; - while () { - if (/^tcp.+ESTABLISHED$/) { - $tcp_estb++; - } - } - close IN; - $tcp_info = $tcp_estb; - $tcp_header = 'tcp_estb'; +if (scalar(split ' ', $packet_header) != scalar(split ' ', $packet_info)) { + warn "WARNING: packet header does not match packet info.\n"; + $packet_header = ''; + $packet_info = ''; + $need_header = 1; +} - if ( scalar( split ' ', $tcp_estb_header ) != - scalar( split ' ', $tcp_estb_info ) ) - { - print STDERR "WARNING: tcp_estb header does not match tcp_estb info.\n"; - $tcp_estb_header = ''; - $tcp_estb_info = ''; - $need_header = 1; - } +## Get TCP Connection data +$tcp_estb = 0; +open IN, "netstat -an |"; +while () { + if (/^tcp.+ESTABLISHED$/) { + $tcp_estb++; + } +} +close IN; - ## Get TSM Database space usage - $tsmdb = 0; - open IN, "dsmadmc -id=view -password=view 'query db' |tail -r -n 5 |"; - while () { - @fld = split(/ +/,); - if (/\d/) { - $tsmdb = $fld[8]; - } - } - close IN; - $tsm_info = $tsmdb; - $tsm_header = "tsmdb\t"; +$tcp_info = $tcp_estb; +$tcp_header = 'tcp_estb'; - if ( scalar( split ' ', $tsm_header ) != - scalar( split ' ', $tsm_info ) ) - { - print STDERR "WARNING: tsmdb header does not match tsmdb info.\n"; - $tsm_header = ''; - $tsm_info = ''; - $need_header = 1; - } +if (scalar(split ' ', $tcp_estb_header) != scalar(split ' ', $tcp_estb_info)) { + warn "WARNING: tcp_estb header does not match tcp_estb info.\n"; + $tcp_estb_header = ''; + $tcp_estb_info = ''; + $need_header = 1; +} - ## Get Memory Usage breakup using SVMON - $mem_work = 0; - $mem_pres = 0; - $mem_clnt = 0; - open IN, "svmon -G |tail -2 |"; - while () { - @memp = split(/ +/,); - if (/use\s+(\d+) /) { - $m_work = $memp[2]; - $m_pres = $memp[3]; - $m_clnt = $memp[4]; - $mem_work = $m_work * 4096; - $mem_pres = $m_pres * 4096; - $mem_clnt = $m_clnt * 4096; - } - } - close IN; - $mem_info = "$mem_work\t$mem_pres\t$mem_clnt\t$mem_totl"; - $mem_header = "mem_work\tmem_pres\tmem_clnt\tmem_totl"; +## Get TSM Database space usage +$tsmdb = 0; +open IN, "dsmadmc -id=view -password=view 'query db' |tail -r -n 5 |"; +while () { + @fld = split(/ +/,); + if (/\d/) { + $tsmdb = $fld[8]; + } +} +close IN; +$tsm_info = $tsmdb; +$tsm_header = "tsmdb\t"; - if ( scalar( split ' ', $mem_header ) != - scalar( split ' ', $mem_info ) ) - { - print STDERR "WARNING: memory header does not match memory info.\n"; - $mem_header = ''; - $mem_info = ''; - $need_header = 1; - } +if (scalar(split ' ', $tsm_header) != scalar(split ' ', $tsm_info)) { + warn "WARNING: tsmdb header does not match tsmdb info.\n"; + $tsm_header = ''; + $tsm_info = ''; + $need_header = 1; +} - ## Get TSM Tape Drive usage - $rmt = 0; - $rmt5 = 5; - open IN, "dsmadmc -id=view -password=view 'query mount' |grep matches |"; - while () { - @fld = split(/ +/,); - if (/\d/) { - $rmt = $fld[1]; - } - } - close IN; - $tsm_rmt_header = "rmt5\trmt\t"; - $tsm_rmt_info = "$rmt5\t$rmt"; +## Get Memory Usage breakup using SVMON +$mem_work = 0; +$mem_pres = 0; +$mem_clnt = 0; +open IN, "svmon -G |tail -2 |"; +while () { + @memp = split(/ +/,); + if (/use\s+(\d+) /) { + $m_work = $memp[2]; + $m_pres = $memp[3]; + $m_clnt = $memp[4]; + $mem_work = $m_work * 4096; + $mem_pres = $m_pres * 4096; + $mem_clnt = $m_clnt * 4096; + } +} +close IN; - if ( scalar( split ' ', $tsm_rmt_header ) != - scalar( split ' ', $tsm_rmt_info ) ) - { - print STDERR "WARNING: TSM RMT header does not match TSM RMT info.\n"; - $tsm_rmt_header = ''; - $tsm_rmt_info = ''; - $need_header = 1; - } +$mem_info = "$mem_work\t$mem_pres\t$mem_clnt\t$mem_totl"; +$mem_header = "mem_work\tmem_pres\tmem_clnt\tmem_totl"; - ## Get TSM Recovery Log space usage - $tsmdb = 0; - open IN, "dsmadmc -id=view -password=view 'query log' |tail -r -n 4 |"; - while () { - @fld = split(/ +/,); - if (/\d/) { - $tsmlog = $fld[8]; - } - } - close IN; - $tsm_log_info = $tsmlog; - $tsm_log_header = 'tsmlog'; +if (scalar(split ' ', $mem_header) != scalar(split ' ', $mem_info)) { + warn "WARNING: memory header does not match memory info.\n"; + $mem_header = ''; + $mem_info = ''; + $need_header = 1; +} - if ( scalar( split ' ', $tsm_log_header ) != - scalar( split ' ', $tsm_log_info ) ) - { - print STDERR "WARNING: TSM Log header does not match TSM Log info.\n"; - $tsm_log_header = ''; - $tsm_log_info = ''; - $need_header = 1; - } +## Get TSM Tape Drive usage +$rmt = 0; +$rmt5 = 5; +open IN, "dsmadmc -id=view -password=view 'query mount' |grep matches |"; +while () { + @fld = split(/ +/,); + if (/\d/) { + $rmt = $fld[1]; + } +} +close IN; +$tsm_rmt_header = "rmt5\trmt\t"; +$tsm_rmt_info = "$rmt5\t$rmt"; - ## Get TSM Tape usage - $tsmpvt = 0; - open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Private' | wc -l |"; - while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmpvt = $fld[1]; - } - } - close IN; +if (scalar(split ' ', $tsm_rmt_header) != scalar(split ' ', $tsm_rmt_info)) { + warn "WARNING: TSM RMT header does not match TSM RMT info.\n"; + $tsm_rmt_header = ''; + $tsm_rmt_info = ''; + $need_header = 1; +} - $tsmscr = 0; - open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Scratch' | wc -l |"; - while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmscr = $fld[1]; - } - } - close IN; +## Get TSM Recovery Log space usage +$tsmdb = 0; +open IN, "dsmadmc -id=view -password=view 'query log' |tail -r -n 4 |"; +while () { + @fld = split(/ +/,); + if (/\d/) { + $tsmlog = $fld[8]; + } +} +close IN; +$tsm_log_info = $tsmlog; +$tsm_log_header = 'tsmlog'; - $tsmvlt = 0; - open IN, "dsmadmc -id=view -password=view 'query drmedia' | grep 'Vault' | wc -l |"; - while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmvlt = $fld[1]; - } - } +if (scalar(split ' ', $tsm_log_header) != scalar(split ' ', $tsm_log_info)) { + warn "WARNING: TSM Log header does not match TSM Log info.\n"; + $tsm_log_header = ''; + $tsm_log_info = ''; + $need_header = 1; +} - $tsm_tape_info = join "\t", $tsmpvt, $tsmscr, $tsmvlt; - $tsm_tape_header = join "\t", tsmpvt, tsmscr, tsmvlt; +## Get TSM Tape usage +$tsmpvt = 0; +open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Private' | wc -l |"; +while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmpvt = $fld[1]; + } +} +close IN; - if ( scalar( split ' ', $tsm_tape_header ) != - scalar( split ' ', $tsm_tape_info ) ) - { - print STDERR "WARNING: TSM Tape header does not match TSM Tape info.\n"; - $tsm_tape_header = ''; - $tsm_tape_info = ''; - $need_header = 1; - } +$tsmscr = 0; +open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Scratch' | wc -l |"; +while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmscr = $fld[1]; + } +} +close IN; - ## Get TSM Disk Storage Pool usage - $tsmphcy = 0; - $tsmphcn = 0; - open IN, "dsmadmc -id=view -password=view 'query stgpool' |"; - while () { - @fld = split(/ +/,); - if (/\d/) { - if ( $fld[0] eq "PHCYDISKPO-" ) { - $tsmphcy = $fld[3]; - } - elsif ( $fld[0] eq "PHCNDISKPO-" ) { - $tsmphcn = $fld[3]; - } - } - } - close IN; +$tsmvlt = 0; +open IN, "dsmadmc -id=view -password=view 'query drmedia' | grep 'Vault' | wc -l |"; +while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmvlt = $fld[1]; + } +} - $tsm_stg_info = join "\t", $tsmphcy, $tsmphcn; - $tsm_stg_header = join "\t", tsmphcy, tsmphcn; +$tsm_tape_info = join "\t", $tsmpvt, $tsmscr, $tsmvlt; +$tsm_tape_header = join "\t", tsmpvt, tsmscr, tsmvlt; - if ( scalar( split ' ', $tsm_stg_header ) != - scalar( split ' ', $tsm_stg_info ) ) - { - print STDERR "WARNING: TSM Storage Pool header does not match TSM Storage Pool info.\n"; - $tsm_stg_header = ''; - $tsm_stg_info = ''; - $need_header = 1; - } +if (scalar(split ' ', $tsm_tape_header) != scalar(split ' ', $tsm_tape_info)) { +{ + warn "WARNING: TSM Tape header does not match TSM Tape info.\n"; + $tsm_tape_header = ''; + $tsm_tape_info = ''; + $need_header = 1; +} - ## Join header and info then verify column counts. - $out_header = join "\t", "timestamp", "locltime", $load_header, $up_header, - $proc_header, $vmstat_header, $fs_header, $iostat_header, $packet_header, - $tcp_header, $tsm_header, $swap_header, $mem_header, $tsm_rmt_header, - $tsm_log_header, $tsm_tape_header, $tsm_stg_header; - $out_header =~ tr/ \t/\t/s; # translate whitespace to single tabs - - $out_info = join "\t", $timestamp, $locltime, $load_info, $up_info, $proc_info, - $vmstat_info, $fs_info, $iostat_info, $packet_info, $tcp_info, $tsm_info, - $swap_info, $mem_info, $tsm_rmt_info, $tsm_log_info, $tsm_tape_info, - $tsm_stg_info; - $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs - - $header_cnt = split ' ', $out_header; - $info_cnt = split ' ', $out_info; - if ( $header_cnt != $info_cnt ) { - print STDERR - "ERROR: header columns do not equal data columns. Exiting.\n"; - &exit_nicely; - } - elsif ( $header_cnt != $prev_header_cnt or $info_cnt != $prev_info_cnt ) { - $need_header = 1; +## Get TSM Disk Storage Pool usage +$tsmphcy = 0; +$tsmphcn = 0; +open IN, "dsmadmc -id=view -password=view 'query stgpool' |"; +while () { + @fld = split(/ +/,); + if (/\d/) { + if ($fld[0] eq "PHCYDISKPO-" ) { + $tsmphcy = $fld[3]; + } elsif ($fld[0] eq "PHCNDISKPO-" ) { + $tsmphcn = $fld[3]; } - $prev_header_cnt = $header_cnt; - $prev_info_cnt = $info_cnt; + } +} +close IN; - ## Write output - if ($need_header) { - print OUT $out_header, "\n"; - $need_header = 0; - } - print OUT $out_info, "\n"; +$tsm_stg_info = join "\t", $tsmphcy, $tsmphcn; +$tsm_stg_header = join "\t", tsmphcy, tsmphcn; - sleep $INTERVAL - ( time() - $timestamp ); +if (scalar(split ' ', $tsm_stg_header) != scalar(split ' ', $tsm_stg_info)) { + warn "WARNING: TSM Storage Pool header does not match ", + "TSM Storage Pool info.\n"; + $tsm_stg_header = ''; + $tsm_stg_info = ''; + $need_header = 1; + } + + ## Join header and info then verify column counts. + $out_header = join("\t", + "timestamp", "locltime", $load_header, $up_header, + $proc_header, $vmstat_header, $fs_header, $iostat_header, + $packet_header, $tcp_header, $tsm_header, $swap_header, + $mem_header, $tsm_rmt_header, $tsm_log_header, + $tsm_tape_header, $tsm_stg_header); + $out_header =~ tr/ \t/\t/s; # translate whitespace to single tabs + + $out_info = join("\t", + $timestamp, $locltime, $load_info, $up_info, $proc_info, + $vmstat_info, $fs_info, $iostat_info, $packet_info, + $tcp_info, $tsm_info, $swap_info, $mem_info, $tsm_rmt_info, + $tsm_log_info, $tsm_tape_info, $tsm_stg_info); + $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs + + $header_cnt = split ' ', $out_header; + $info_cnt = split ' ', $out_info; + if ($header_cnt != $info_cnt) { + warn "ERROR: header columns do not equal data columns. Exiting.\n"; + &exit_nicely; + } elsif ($header_cnt != $prev_header_cnt or $info_cnt != $prev_info_cnt) { + $need_header = 1; + } + $prev_header_cnt = $header_cnt; + $prev_info_cnt = $info_cnt; + + ## Write output + if ($need_header) { + print OUT $out_header, "\n"; + $need_header = 0; + } + print OUT $out_info, "\n"; + sleep $INTERVAL - ( time() - $timestamp ); } close OUT; @@ -625,8 +603,8 @@ # This subroutine is called by the signal handler. sub exit_nicely { - close OUT; - @args = ($COMPRESS, "-f", $stat_file); - system(@args); - exit 0; + close OUT; + @args = ($COMPRESS, "-f", $stat_file); + system(@args); + exit 0; } Modified: trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in (original) +++ trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Tue Jul 6 22:43:40 2004 @@ -63,7 +63,7 @@ # #To compile: cc -o phys_mem phys_mem.c # - #*/ +#*/ # #static char SCCSid[] = "@(#)phys_mem 1.1"; # @@ -111,30 +111,24 @@ '; # Parse the command line arguments -while ( $#ARGV >= 0 ) { - - if ( $ARGV[0] eq "-r" ) { - shift @ARGV; - $OUT_ROOT = shift @ARGV; - } - elsif ( $ARGV[0] eq "-i" ) { - shift @ARGV; - $INTERVAL = shift @ARGV; - } - elsif ( $ARGV[0] eq "-d" ) { - shift @ARGV; - $DURATION = shift @ARGV; - } - elsif ( $ARGV[0] eq "-h" ) { - print $Usage_Message; - exit 0; - } - elsif ( $ARGV[0] =~ /^-/ ) { - die "Invalid flag: $ARGV[0]\n$Usage_Message"; - } - else { - die "Invalid argument: $ARGV[0]\n$Usage_Message"; - } +while ($#ARGV >= 0) { + if ($ARGV[0] eq "-r") { + shift @ARGV; + $OUT_ROOT = shift @ARGV; + } elsif ($ARGV[0] eq "-i") { + shift @ARGV; + $INTERVAL = shift @ARGV; + } elsif ($ARGV[0] eq "-d") { + shift @ARGV; + $DURATION = shift @ARGV; + } elsif ($ARGV[0] eq "-h") { + print $Usage_Message; + exit 0; + } elsif ($ARGV[0] =~ /^-/) { + die "Invalid flag: $ARGV[0]\n$Usage_Message"; + } else { + die "Invalid argument: $ARGV[0]\n$Usage_Message"; + } } ## BEGIN set defaults @@ -147,13 +141,18 @@ ## Derived variables. $iterations = $DURATION * 60 * 60 / $INTERVAL; # Number of checks. -chomp( $HOST = `uname -n` ); +chomp($HOST = `uname -n`); $out_dir = "${OUT_ROOT}/${HOST}"; -( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = +($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $stat_file = - sprintf( "%s/percol-%.2d-%.2d-%.2d-%1d%.2d", $out_dir, $year + 1900, $mon + 1, - $mday, $hour, $min ); + sprintf("%s/percol-%.2d-%.2d-%.2d-%1d%.2d", + $out_dir, + $year + 1900, + $mon + 1, + $mday, + $hour, + $min); # Base all timestamps on start time. $start_time = time(); @@ -163,29 +162,26 @@ #open IN, "ifconfig -a|"; open IN, "netstat -i|"; while () { - - # if ( /^(\S+):/ ) { - if (/^(\w+).*link/) { - push @net_interfaces, $1; - } + # if (/^(\S+):/) { + if (/^(\w+).*link/) { + push @net_interfaces, $1; + } } close IN; # Grab some base system info prior to collecting stats. open IN, "/usr/local/bin/phymem|"; while () { - if (/Physical (\d+) /) { - $pagestotl = - $1 * 1024 / 4096; # Grab realmem in KB and convert to pages. - - ## this gets used down in the vmstat section - } + if (/Physical (\d+) /) { + $pagestotl = $1 * 1024 / 4096; # Grab realmem in KB and convert to pages. + # this gets used down in the vmstat section + } } close IN; ## Make sure we can write output. umask 0022; # make sure the file can be harvested -unless ( -d $out_dir ) { +unless ( -d $out_dir) { system( "mkdir", "-p", "$out_dir" ); } open OUT, ">$stat_file" or die "ERROR: Could not open $stat_file: $!"; @@ -205,229 +201,223 @@ $prev_header_cnt = 0; $prev_info_cnt = 0; -while ( $iterations-- > 0 ) { - - $timestamp = $timestamp ? time() : $start_time; - ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = - localtime(time); - $locltime = sprintf( "%.2d:%.2d:%.2d", $hour, $min, $sec ); - - ## Get runq data - open IN, "uptime |"; - while () { - if (/load average:\s+(\S+),\s+(\S+),\s+(\S+)/) { - $load_info = join "\t", $1, $2, $3; - } - } - close IN; - $load_header = "1runq\t5runq\t15runq"; - - if ( scalar( split ' ', $load_header ) != scalar( split ' ', $load_info ) ) - { - $load_header = ''; - $load_info = ''; - $need_header = 1; - print STDERR "WARNING: load header does not match load info.\n"; - } - - ## Get number of system processes - $num_proc = -1; # Don't count the header. - open IN, "ps -e |"; - while () { - $num_proc++; - } - close IN; - $proc_info = $num_proc; - $proc_header = '#proc'; - - if ( scalar( split ' ', $proc_header ) != scalar( split ' ', $proc_info ) ) - { - $proc_header = ''; - $proc_info = ''; - $need_header = 1; - print STDERR "WARNING: #proc header does not match #proc info.\n"; - } - - ## Get vmstat data - open IN, "vmstat 1 2|"; - while () { - chomp; - if (/^[\s\d]+$/) { - - # overwrite first line on 2nd pass - ( - $vmstat_r, $vmstat_b, $vmstat_wa, $vmstat_avm, $vmstat_fre, - $vmstat_re, $vmstat_at, $vmstat_pi, $vmstat_po, $vmstat_fr, - $vmstat_cy, $vmstat_sr, $vmstat_inf, $vmstat_syf, - $vmstat_csf, $vmstat_us, $vmstat_sy, $vmstat_id - ) - = split; - $vmstat_info = join "\t", $vmstat_avm, $vmstat_fre, $pagestotl, - $vmstat_pi, $vmstat_po, $vmstat_fr, $vmstat_sr, $vmstat_us, - $vmstat_sy, $vmstat_wa, $vmstat_id; - } - } - close IN; - $vmstat_header = -"pagesactive\tpagesfree\tpagestotl\tPagesI/s\tPagesO/s\tPagesF/s\tscanrate\tusr%\tsys%\twio%\tidle%"; - - if ( scalar( split ' ', $vmstat_header ) != - scalar( split ' ', $vmstat_info ) ) - { - print STDERR "WARNING: vmstat header does not match vmstat info.\n"; - $vmstat_header = ''; - $vmstat_info = ''; - $need_header = 1; - } +while ( $iterations-- > 0) { + $timestamp = $timestamp ? time() : $start_time; + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(time); + $locltime = sprintf("%.2d:%.2d:%.2d", $hour, $min, $sec); + + ## Get runq data + open IN, "uptime |"; + while () { + if (/load average:\s+(\S+),\s+(\S+),\s+(\S+)/) { + $load_info = join "\t", $1, $2, $3; + } + } + close IN; + $load_header = "1runq\t5runq\t15runq"; + + if (scalar(split ' ', $load_header) != scalar(split ' ', $load_info)) { + $load_header = ''; + $load_info = ''; + $need_header = 1; + warn "WARNING: load header does not match load info.\n"; + } + + ## Get number of system processes + $num_proc = -1; # Don't count the header. + open IN, "ps -e |"; + while () { + $num_proc++; + } + close IN; + $proc_info = $num_proc; + $proc_header = '#proc'; + + if (scalar(split ' ', $proc_header) != scalar(split ' ', $proc_info)) { + $proc_header = ''; + $proc_info = ''; + $need_header = 1; + warn "WARNING: #proc header does not match #proc info.\n"; + } + + ## Get vmstat data + open IN, "vmstat 1 2|"; + while () { + chomp; + if (/^[\s\d]+$/) { + + # overwrite first line on 2nd pass + my ($vmstat_r, $vmstat_b, $vmstat_wa, $vmstat_avm, $vmstat_fre, + $vmstat_re, $vmstat_at, $vmstat_pi, $vmstat_po, $vmstat_fr, + $vmstat_cy, $vmstat_sr, $vmstat_inf, $vmstat_syf, + $vmstat_csf, $vmstat_us, $vmstat_sy, $vmstat_id) + = split; + $vmstat_info = join("\t", + $vmstat_avm, $vmstat_fre, $pagestotl, $vmstat_pi, + $vmstat_po, $vmstat_fr, $vmstat_sr, $vmstat_us, + $vmstat_sy, $vmstat_wa, $vmstat_id); + } + } + close IN; + $vmstat_header = "pagesactive\tpagesfree\tpagestotl\tPagesI/s\tPagesO/s\t" . + "PagesF/s\tscanrate\tusr%\tsys%\twio%\tidle%"; + + if (scalar(split ' ', $vmstat_header) != scalar(split ' ', $vmstat_info)) { + warn "WARNING: vmstat header does not match vmstat info.\n"; + $vmstat_header = ''; + $vmstat_info = ''; + $need_header = 1; + } + + ## Get filesystem data + $fs_header = ''; + $fs_info = ''; + open IN, "/usr/local/bin/hpdf |"; + while () { + chomp; + + if (m%^/%) { + my ($mnt_dev, $blocks, $used, $free, $pct_used, $iused, $ifree, + $ipct_used, $mnt) = split; + + # Recalculate percents because df rounds. + $fs_info .= "\t" + . sprintf("%s\t%s\t%s\t%.5f\t%d\t%s\t%s\t%.5f", + $blocks, + $used, + $free, + 100*($used/$blocks), + ($iused + $ifree), + $iused, + $ifree, + 100*($iused/($iused + $ifree))); + $fs_header .= "\t" . join("\t", + "mntC_$mnt", "mntU_$mnt", "mntA_$mnt", + "mntP_$mnt", "mntc_$mnt", "mntu_$mnt", + "mnta_$mnt", "mntp_$mnt"); + } + } + close IN; + + if (scalar(split ' ', $fs_header) != scalar(split ' ', $fs_info )) { + warn "WARNING: filesystem header does not match filesystem info.\n"; + $fs_header = ''; + $fs_info = ''; + $need_header = 1; + } + + ## Get iostat data + $disk_t = 0; + $disk_rK = 0; + $disk_wK = 0; + undef %disks; + open IN, "iostat 1 2|"; + + while () { + if (/^(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\d+)\s+(\d+)/) { + my $disk = $1; + my $tps = $2; + my $rK = $3; + my $wK = $4; + if (not $disks{$disk}) { + $disks{$disk}++; # Get rK & wK from first pass. + $disk_rK += $rK; + $disk_wK += $wK; + } else { + $disk_t += $tps; # Get trans per sec from second pass. + } + } + } + close IN; + $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s\t"; + $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; + + if (scalar(split ' ', $iostat_header) != scalar(split ' ', $iostat_info)) { + warn "WARNING: iostat header does not match iostat info.\n"; + $iostat_header = ''; + $iostat_info = ''; + $need_header = 1; + } + + ## Get packet data + $packet_header = ''; + $packet_info = ''; + + #foreach $interface ( split(/\s+/, $NET_INTERFACES)) { + foreach $interface (@net_interfaces) { + $packet_header .= "${interface}Ipkt/s\t${interface}IErr/s\t" . + "${interface}Opkt/s\t${interface}OErr/s\t" . + "${interface}Coll/s\t"; + open IN, "netstat -I $interface 1|"; - ## Get filesystem data - $fs_header = ''; - $fs_info = ''; - open IN, "/usr/local/bin/hpdf |"; while () { - chomp; - - if (m%^/%) { - ( $mnt_dev, $blocks, $used, $free, $pct_used, $iused, $ifree, - $ipct_used, $mnt ) = split; - - # Recalculate percents because df rounds. - $fs_info .= "\t" - . sprintf( "%s\t%s\t%s\t%.5f\t%d\t%s\t%s\t%.5f", $blocks, $used, - $free, ( $used / $blocks ) * 100, ( $iused + $ifree ), $iused, - $ifree, ( $iused / ( $iused + $ifree ) ) * 100 ); - $fs_header .= "\t" . join "\t", "mntC_$mnt", "mntU_$mnt", - "mntA_$mnt", "mntP_$mnt", "mntc_$mnt", "mntu_$mnt", "mnta_$mnt", - "mntp_$mnt"; - } + if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) { + $packet_info .= "\t" . join("\t", $1, $2, $3, $4, $5); + last; + } } close IN; + } - if ( scalar( split ' ', $fs_header ) != scalar( split ' ', $fs_info ) ) { - print STDERR - "WARNING: filesystem header does not match filesystem info.\n"; - $fs_header = ''; - $fs_info = ''; - $need_header = 1; - } - - ## Get iostat data - $disk_t = 0; - $disk_rK = 0; - $disk_wK = 0; - undef %disks; - open IN, "iostat 1 2|"; - - while () { - if (/^(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\d+)\s+(\d+)/) { - my $disk = $1; - my $tps = $2; - my $rK = $3; - my $wK = $4; - if ( not $disks{$disk} ) { - $disks{$disk}++; # Get rK & wK from first pass. - $disk_rK += $rK; - $disk_wK += $wK; - } - else { - $disk_t += $tps; # Get trans per sec from second pass. - } - } - } - close IN; - $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s\t"; - $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; - - if ( scalar( split ' ', $iostat_header ) != - scalar( split ' ', $iostat_info ) ) - { - print STDERR "WARNING: iostat header does not match iostat info.\n"; - $iostat_header = ''; - $iostat_info = ''; - $need_header = 1; - } - - ## Get packet data + if (scalar(split ' ', $packet_header) != scalar(split ' ', $packet_info)) { + warn "WARNING: packet header does not match packet info.\n"; $packet_header = ''; $packet_info = ''; + $need_header = 1; + } - #foreach $interface ( split(/\s+/, $NET_INTERFACES) ) { - foreach $interface (@net_interfaces) { - $packet_header .= -"${interface}Ipkt/s\t${interface}IErr/s\t${interface}Opkt/s\t${interface}OErr/s\t${interface}Coll/s\t"; - open IN, "netstat -I $interface 1|"; - - while () { - if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) { - $packet_info .= "\t" . join "\t", $1, $2, $3, $4, $5; - last; - } - } - close IN; - } - - if ( scalar( split ' ', $packet_header ) != - scalar( split ' ', $packet_info ) ) - { - print STDERR "WARNING: packet header does not match packet info.\n"; - $packet_header = ''; - $packet_info = ''; - $need_header = 1; - } - - ## Get TCP Connection data - $tcp_estb = 0; - open IN, "netstat -a |"; - while () { - if (/^tcp.+ESTABLISHED$/) { - $tcp_estb++; - } - } - close IN; - $tcp_info = $tcp_estb; - $tcp_header = 'tcp_estb'; - - if ( scalar( split ' ', $tcp_estb_header ) != - scalar( split ' ', $tcp_estb_info ) ) - { - print STDERR "WARNING: tcp_estb header does not match tcp_estb info.\n"; - $tcp_estb_header = ''; - $tcp_estb_info = ''; - $need_header = 1; - } - - ## Join header and info then verify column counts. - $out_header = join "\t", "timestamp", "locltime", $load_header, - $proc_header, $vmstat_header, $fs_header, $iostat_header, $packet_header, - $tcp_header; - $out_header =~ tr/ \t/\t/s; # translate whitespace to single tabs - - $out_info = join "\t", $timestamp, $locltime, $load_info, $proc_info, - $vmstat_info, $fs_info, $iostat_info, $packet_info, $tcp_info; - $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs - - $header_cnt = split ' ', $out_header; - $info_cnt = split ' ', $out_info; - if ( $header_cnt != $info_cnt ) { - print STDERR - "ERROR: header columns do not equal data columns. Exiting.\n"; - &exit_nicely; - } - elsif ( $header_cnt != $prev_header_cnt or $info_cnt != $prev_info_cnt ) { - $need_header = 1; - } - $prev_header_cnt = $header_cnt; - $prev_info_cnt = $info_cnt; - - ## Write output - if ($need_header) { - print OUT $out_header, "\n"; - $need_header = 0; - } - print OUT $out_info, "\n"; - - sleep $INTERVAL - ( time() - $timestamp ); + ## Get TCP Connection data + $tcp_estb = 0; + open IN, "netstat -a |"; + while () { + if (/^tcp.+ESTABLISHED$/) { + $tcp_estb++; + } + } + close IN; + $tcp_info = $tcp_estb; + $tcp_header = 'tcp_estb'; + + if (scalar(split ' ', $tcp_estb_header) != scalar(split ' ', $tcp_estb_info)){ + warn "WARNING: tcp_estb header does not match tcp_estb info.\n"; + $tcp_estb_header = ''; + $tcp_estb_info = ''; + $need_header = 1; + } + + ## Join header and info then verify column counts. + $out_header = join("\t", + "timestamp", "locltime", $load_header, $proc_header, + $vmstat_header, $fs_header, $iostat_header, + $packet_header, $tcp_header); + $out_header =~ tr/ \t/\t/s; # translate whitespace to single tabs + + $out_info = join("\t", + $timestamp, $locltime, $load_info, $proc_info, + $vmstat_info, $fs_info, $iostat_info, $packet_info, + $tcp_info); + $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs + + $header_cnt = split ' ', $out_header; + $info_cnt = split ' ', $out_info; + if ($header_cnt != $info_cnt) { + warn "ERROR: header columns do not equal data columns. Exiting.\n"; + &exit_nicely; + } elsif ($header_cnt != $prev_header_cnt or $info_cnt != $prev_info_cnt) { + $need_header = 1; + } + $prev_header_cnt = $header_cnt; + $prev_info_cnt = $info_cnt; + + ## Write output + if ($need_header) { + print OUT $out_header, "\n"; + $need_header = 0; + } + print OUT $out_info, "\n"; + sleep $INTERVAL - ( time() - $timestamp ); } close OUT; @@ -438,8 +428,8 @@ # This subroutine is called by the signal handler. sub exit_nicely { - close OUT; - @args = ($COMPRESS, "-f", $stat_file); - system(@args); - exit 0; + close OUT; + @args = ($COMPRESS, "-f", $stat_file); + system(@args); + exit 0; } From blair at orcaware.com Thu Jul 8 22:25:22 2004 From: blair at orcaware.com (Blair Zajac) Date: Thu, 8 Jul 2004 22:25:22 -0700 Subject: [Orca-checkins] r373 - in trunk/orca/data_gatherers: aix hp Message-ID: <200407090525.i695PMKe021363@orcaware.com> Author: blair Date: Thu Jul 8 22:20:41 2004 New Revision: 373 Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Log: Continue massive Perl cleanup of orca-aix-stat.pl.in and orca-hp-stat.pl.in. * data_gatherers/aix/orca-aix-stat.pl.in, * data_gatherers/hp/orca-hp-stat.pl.in: (strings_have_same_number_words): New subroutine that tests if two strings have the same number of whitespace separated words. (main): Now runs on Perl 5.004_05 through 5.8.4 with -w flag. Diff the two scripts and make them as identical as possible. Fix code to remove 'Use of implicit split to @_ is deprecated' warnings. Use strings_have_same_number_words() instead of testing split == split. Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in (original) +++ trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in Thu Jul 8 22:20:41 2004 @@ -1,11 +1,6 @@ -#!/usr/bin/perl -# -# Version 1.7 - -# Description: -# Collect general performance statistics formatted for +# Collect general AIX performance statistics formatted for # interpretation by Orca. - +# # Usage: # The following variables may be set: # @@ -43,20 +38,18 @@ my $COMPRESS = '@COMPRESSOR@'; -# Note: Execution speed is more important than cleanliness here. - # Explicitly set PATH to prevent odd problems if run manually. -$ENV{PATH} = '/usr/bin:/etc:/usr/sbin:/usr/ucb:/sbin'; +$ENV{PATH} = '/bin:/usr/bin:/etc:/usr/sbin:/usr/ucb:/sbin'; -$Usage_Message = ' -Usage: orca-aix-stat.pl [-r out_root] [-i interval] [-d duration] [-h] +my $Usage_Message = " +usage: $0 [-r out_root] [-i interval] [-d duration] [-h] -r out_root set root output directory, default: /opt/log/performance -i interval number of seconds between checks, default: 300 -d duration number of hours to run, default: 24 -h this message +"; -'; ############################ # These are the packages you need to install # 1. perl @@ -71,25 +64,24 @@ # http://www-1.ibm.com/servers/aix/products/aixos/linux/download.html # http://www.bullfreeware.com # -# -# Good Luck, Rajesh Verma (rajeshverma at yahoo.com) +# Good Luck, Rajesh Verma (rajeshverma at yahoo.com) ############################## # Parse the command line arguments while ($#ARGV >= 0) { - if ($ARGV[0] eq "-r" ) { + if ($ARGV[0] eq "-r") { shift @ARGV; $OUT_ROOT = shift @ARGV; - } elsif ($ARGV[0] eq "-i" ) { + } elsif ($ARGV[0] eq "-i") { shift @ARGV; $INTERVAL = shift @ARGV; - } elsif ($ARGV[0] eq "-d" ) { + } elsif ($ARGV[0] eq "-d") { shift @ARGV; $DURATION = shift @ARGV; - } elsif ($ARGV[0] eq "-h" ) { + } elsif ($ARGV[0] eq "-h") { print $Usage_Message; exit 0; - } elsif ($ARGV[0] =~ /^-/ ) { + } elsif ($ARGV[0] =~ /^-/) { die "Invalid flag: $ARGV[0]\n$Usage_Message"; } else { die "Invalid argument: $ARGV[0]\n$Usage_Message"; @@ -123,11 +115,11 @@ $start_time = time(); $timestamp = 0; -## Auto detect network interfaces +# Auto detect network interfaces #open IN, "ifconfig -a|"; open IN, "netstat -ni|"; while () { - # if (/^(\S+):/ ) { + # if (/^(\S+):/) { if (/^(\w+).*link/) { push @net_interfaces, $1; } @@ -147,8 +139,9 @@ ## Make sure we can write output. umask 0022; # make sure the file can be harvested -unless ( -d $out_dir ) { - system( "mkdir", "-p", "$out_dir" ); +unless (-d $out_dir) { + mkdir($out_dir, 0755) + or die "$0: cannot mkdir '$out_dir': $!\n"; } open OUT, ">$stat_file" or die "ERROR: Could not open $stat_file: $!"; my $oldfh = select OUT; @@ -167,11 +160,11 @@ $prev_header_cnt = 0; $prev_info_cnt = 0; -while ( $iterations-- > 0 ) { +while ($iterations-- > 0) { $timestamp = $timestamp ? time() : $start_time; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); - $locltime = sprintf( "%.2d:%.2d:%.2d", $hour, $min, $sec ); + $locltime = sprintf("%.2d:%.2d:%.2d", $hour, $min, $sec); ## Get runq data $uptime = 0; @@ -195,18 +188,18 @@ $up_header = "uptime\tnusr"; $up_info = "$uptime\t$nusr"; - if (scalar(split ' ', $load_header) != scalar(split ' ', $load_info)) { + unless (strings_have_same_number_words($load_header, $load_info)) { $load_header = ''; $load_info = ''; $need_header = 1; - warn "WARNING: load header does not match load info.\n"; + warn "$0: warning: load header does not match load info.\n"; } - if (scalar(split ' ', $up_header) != scalar(split ' ', $up_info)) { + unless (strings_have_same_number_words($up_header, $up_info)) { $up_header = ''; $up_info = ''; $need_header = 1; - warn "WARNING: UP header does not match load info.\n"; + warn "$0: warning: UP header does not match load info.\n"; } ## Get number of system processes @@ -219,11 +212,11 @@ $proc_info = $num_proc; $proc_header = '#proc'; - if (scalar(split ' ', $proc_header) != scalar(split ' ', $proc_info)) { + unless (strings_have_same_number_words($proc_header, $proc_info)) { $proc_header = ''; $proc_info = ''; $need_header = 1; - warn "WARNING: #proc header does not match #proc info.\n"; + warn "$0: warning: #proc header does not match #proc info.\n"; } ## Get pstat data for pages @@ -243,8 +236,8 @@ $swap_info = "$swap_used\t$swap_free"; $swap_header = "\tswap_used\tswap_free"; - if (scalar(split ' ', $swap_header) != scalar(split ' ', $swap_info)) { - warn "WARNING: pstat header does not match pstat info.\n"; + unless (strings_have_same_number_words($swap_header, $swap_info)) { + warn "$0: warning: pstat header does not match pstat info.\n"; $swap_header = ''; $swap_info = ''; $need_header = 1; @@ -254,6 +247,7 @@ open IN, "vmstat 1 2|"; while () { chomp; + if (/^[\s\d]+$/) { # overwrite first line on 2nd pass my ($vmstat_r, $vmstat_b, $vmstat_avm, $vmstat_fre, @@ -274,8 +268,8 @@ "PagesI/s\tPagesO/s\tPagesF/s\tscanrate\tusr%\tsys%\t" . "wio%\tidle%"; - if (scalar(split ' ', $vmstat_header) != scalar(split ' ', $vmstat_info)) { - warn "WARNING: vmstat header does not match vmstat info.\n"; + unless (strings_have_same_number_words($vmstat_header, $vmstat_info)) { + warn "$0: warning: vmstat header does not match vmstat info.\n"; $vmstat_header = ''; $vmstat_info = ''; $need_header = 1; @@ -287,6 +281,7 @@ open IN, "df -k -v |"; while () { chomp; + if (m%^/dev%) { my ($mnt_dev, $blocks, $used, $free, $pct_used, $iused, $ifree, $ipct_used, $mnt) = split; @@ -310,8 +305,8 @@ } close IN; - if (scalar(split ' ', $fs_header) != scalar(split ' ', $fs_info)) { - warn "WARNING: filesystem header does not match filesystem info.\n"; + unless (strings_have_same_number_words($fs_header, $fs_info)) { + warn "$0: warning: filesystem header does not match filesystem info.\n"; $fs_header = ''; $fs_info = ''; $need_header = 1; @@ -340,11 +335,11 @@ } } close IN; - $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s"; + $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s\t"; $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; - if (scalar(split ' ', $iostat_header) != scalar(split ' ', $iostat_info)) { - warn "WARNING: iostat header does not match iostat info.\n"; + unless (strings_have_same_number_words($iostat_header, $iostat_info)) { + warn "$0: warning: iostat header does not match iostat info.\n"; $iostat_header = ''; $iostat_info = ''; $need_header = 1; @@ -354,7 +349,7 @@ $packet_header = ''; $packet_info = ''; - #foreach $interface ( split(/\s+/, $NET_INTERFACES) ) { + #foreach $interface (split(/\s+/, $NET_INTERFACES)) { foreach $interface (@net_interfaces) { $packet_header .= "\t${interface}Ipkt/s\t${interface}IErr/s\t" . "${interface}Opkt/s\t${interface}OErr/s\t" . @@ -369,190 +364,188 @@ } close IN; } -} -if (scalar(split ' ', $packet_header) != scalar(split ' ', $packet_info)) { - warn "WARNING: packet header does not match packet info.\n"; - $packet_header = ''; - $packet_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($packet_header, $packet_info)) { + warn "$0: warning: packet header does not match packet info.\n"; + $packet_header = ''; + $packet_info = ''; + $need_header = 1; + } -## Get TCP Connection data -$tcp_estb = 0; -open IN, "netstat -an |"; -while () { - if (/^tcp.+ESTABLISHED$/) { - $tcp_estb++; + ## Get TCP Connection data + $tcp_estb = 0; + open IN, "netstat -an |"; + while () { + if (/^tcp.+ESTABLISHED$/) { + $tcp_estb++; + } } -} -close IN; + close IN; -$tcp_info = $tcp_estb; -$tcp_header = 'tcp_estb'; + $tcp_info = $tcp_estb; + $tcp_header = 'tcp_estb'; -if (scalar(split ' ', $tcp_estb_header) != scalar(split ' ', $tcp_estb_info)) { - warn "WARNING: tcp_estb header does not match tcp_estb info.\n"; - $tcp_estb_header = ''; - $tcp_estb_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($tcp_estb_header, $tcp_estb_info)) { + warn "$0: warning: tcp_estb header does not match tcp_estb info.\n"; + $tcp_estb_header = ''; + $tcp_estb_info = ''; + $need_header = 1; + } -## Get TSM Database space usage -$tsmdb = 0; -open IN, "dsmadmc -id=view -password=view 'query db' |tail -r -n 5 |"; -while () { - @fld = split(/ +/,); - if (/\d/) { - $tsmdb = $fld[8]; + ## Get TSM Database space usage + $tsmdb = 0; + open IN, "dsmadmc -id=view -password=view 'query db' |tail -r -n 5 |"; + while () { + @fld = split(/ +/,); + if (/\d/) { + $tsmdb = $fld[8]; + } } -} -close IN; -$tsm_info = $tsmdb; -$tsm_header = "tsmdb\t"; + close IN; + $tsm_info = $tsmdb; + $tsm_header = "tsmdb\t"; -if (scalar(split ' ', $tsm_header) != scalar(split ' ', $tsm_info)) { - warn "WARNING: tsmdb header does not match tsmdb info.\n"; - $tsm_header = ''; - $tsm_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($tsm_header, $tsm_info)) { + warn "$0: warning: tsmdb header does not match tsmdb info.\n"; + $tsm_header = ''; + $tsm_info = ''; + $need_header = 1; + } -## Get Memory Usage breakup using SVMON -$mem_work = 0; -$mem_pres = 0; -$mem_clnt = 0; -open IN, "svmon -G |tail -2 |"; -while () { - @memp = split(/ +/,); - if (/use\s+(\d+) /) { - $m_work = $memp[2]; - $m_pres = $memp[3]; - $m_clnt = $memp[4]; - $mem_work = $m_work * 4096; - $mem_pres = $m_pres * 4096; - $mem_clnt = $m_clnt * 4096; + ## Get Memory Usage breakup using SVMON + $mem_work = 0; + $mem_pres = 0; + $mem_clnt = 0; + open IN, "svmon -G |tail -2 |"; + while () { + @memp = split(/ +/,); + if (/use\s+(\d+) /) { + $m_work = $memp[2]; + $m_pres = $memp[3]; + $m_clnt = $memp[4]; + $mem_work = $m_work * 4096; + $mem_pres = $m_pres * 4096; + $mem_clnt = $m_clnt * 4096; + } } -} -close IN; + close IN; -$mem_info = "$mem_work\t$mem_pres\t$mem_clnt\t$mem_totl"; -$mem_header = "mem_work\tmem_pres\tmem_clnt\tmem_totl"; + $mem_info = "$mem_work\t$mem_pres\t$mem_clnt\t$mem_totl"; + $mem_header = "mem_work\tmem_pres\tmem_clnt\tmem_totl"; -if (scalar(split ' ', $mem_header) != scalar(split ' ', $mem_info)) { - warn "WARNING: memory header does not match memory info.\n"; - $mem_header = ''; - $mem_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($mem_header, $mem_info)) { + warn "$0: warning: memory header does not match memory info.\n"; + $mem_header = ''; + $mem_info = ''; + $need_header = 1; + } -## Get TSM Tape Drive usage -$rmt = 0; -$rmt5 = 5; -open IN, "dsmadmc -id=view -password=view 'query mount' |grep matches |"; -while () { - @fld = split(/ +/,); - if (/\d/) { - $rmt = $fld[1]; + ## Get TSM Tape Drive usage + $rmt = 0; + $rmt5 = 5; + open IN, "dsmadmc -id=view -password=view 'query mount' |grep matches |"; + while () { + @fld = split(/ +/,); + if (/\d/) { + $rmt = $fld[1]; + } } -} -close IN; -$tsm_rmt_header = "rmt5\trmt\t"; -$tsm_rmt_info = "$rmt5\t$rmt"; + close IN; + $tsm_rmt_header = "rmt5\trmt\t"; + $tsm_rmt_info = "$rmt5\t$rmt"; -if (scalar(split ' ', $tsm_rmt_header) != scalar(split ' ', $tsm_rmt_info)) { - warn "WARNING: TSM RMT header does not match TSM RMT info.\n"; - $tsm_rmt_header = ''; - $tsm_rmt_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($tsm_rmt_header, $tsm_rmt_info)) { + warn "$0: warning: TSM RMT header does not match TSM RMT info.\n"; + $tsm_rmt_header = ''; + $tsm_rmt_info = ''; + $need_header = 1; + } -## Get TSM Recovery Log space usage -$tsmdb = 0; -open IN, "dsmadmc -id=view -password=view 'query log' |tail -r -n 4 |"; -while () { - @fld = split(/ +/,); - if (/\d/) { - $tsmlog = $fld[8]; + ## Get TSM Recovery Log space usage + $tsmdb = 0; + open IN, "dsmadmc -id=view -password=view 'query log' |tail -r -n 4 |"; + while () { + @fld = split(/ +/,); + if (/\d/) { + $tsmlog = $fld[8]; + } } -} -close IN; -$tsm_log_info = $tsmlog; -$tsm_log_header = 'tsmlog'; + close IN; + $tsm_log_info = $tsmlog; + $tsm_log_header = 'tsmlog'; -if (scalar(split ' ', $tsm_log_header) != scalar(split ' ', $tsm_log_info)) { - warn "WARNING: TSM Log header does not match TSM Log info.\n"; - $tsm_log_header = ''; - $tsm_log_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($tsm_log_header, $tsm_log_info)) { + warn "$0: warning: TSM Log header does not match TSM Log info.\n"; + $tsm_log_header = ''; + $tsm_log_info = ''; + $need_header = 1; + } -## Get TSM Tape usage -$tsmpvt = 0; -open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Private' | wc -l |"; -while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmpvt = $fld[1]; + ## Get TSM Tape usage + $tsmpvt = 0; + open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Private' | wc -l |"; + while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmpvt = $fld[1]; + } } -} -close IN; + close IN; -$tsmscr = 0; -open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Scratch' | wc -l |"; -while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmscr = $fld[1]; + $tsmscr = 0; + open IN, "dsmadmc -id=view -password=view 'query libvol' | grep 'Scratch' | wc -l |"; + while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmscr = $fld[1]; + } } -} -close IN; + close IN; -$tsmvlt = 0; -open IN, "dsmadmc -id=view -password=view 'query drmedia' | grep 'Vault' | wc -l |"; -while () { - chomp; - @fld = split(/ +/,); - if (/\d/) { - $tsmvlt = $fld[1]; + $tsmvlt = 0; + open IN, "dsmadmc -id=view -password=view 'query drmedia' | grep 'Vault' | wc -l |"; + while () { + chomp; + @fld = split(/ +/,); + if (/\d/) { + $tsmvlt = $fld[1]; + } } -} -$tsm_tape_info = join "\t", $tsmpvt, $tsmscr, $tsmvlt; -$tsm_tape_header = join "\t", tsmpvt, tsmscr, tsmvlt; + $tsm_tape_header = join("\t", 'tsmpvt', 'tsmscr', 'tsmvlt'); + $tsm_tape_info = join("\t", $tsmpvt, $tsmscr, $tsmvlt); -if (scalar(split ' ', $tsm_tape_header) != scalar(split ' ', $tsm_tape_info)) { -{ - warn "WARNING: TSM Tape header does not match TSM Tape info.\n"; - $tsm_tape_header = ''; - $tsm_tape_info = ''; - $need_header = 1; -} + unless (strings_have_same_number_words($tsm_tape_header, $tsm_tape_info)) { + warn "$0: warning: TSM Tape header does not match TSM Tape info.\n"; + $tsm_tape_header = ''; + $tsm_tape_info = ''; + $need_header = 1; + } -## Get TSM Disk Storage Pool usage -$tsmphcy = 0; -$tsmphcn = 0; -open IN, "dsmadmc -id=view -password=view 'query stgpool' |"; -while () { - @fld = split(/ +/,); - if (/\d/) { - if ($fld[0] eq "PHCYDISKPO-" ) { - $tsmphcy = $fld[3]; - } elsif ($fld[0] eq "PHCNDISKPO-" ) { - $tsmphcn = $fld[3]; + ## Get TSM Disk Storage Pool usage + $tsmphcy = 0; + $tsmphcn = 0; + open IN, "dsmadmc -id=view -password=view 'query stgpool' |"; + while () { + @fld = split(/ +/,); + if (/\d/) { + if ($fld[0] eq "PHCYDISKPO-") { + $tsmphcy = $fld[3]; + } elsif ($fld[0] eq "PHCNDISKPO-") { + $tsmphcn = $fld[3]; + } } } -} -close IN; + close IN; -$tsm_stg_info = join "\t", $tsmphcy, $tsmphcn; -$tsm_stg_header = join "\t", tsmphcy, tsmphcn; + $tsm_stg_header = join("\t", 'tsmphcy', 'tsmphcn'); + $tsm_stg_info = join("\t", $tsmphcy, $tsmphcn); -if (scalar(split ' ', $tsm_stg_header) != scalar(split ' ', $tsm_stg_info)) { - warn "WARNING: TSM Storage Pool header does not match ", - "TSM Storage Pool info.\n"; + unless (strings_have_same_number_words($tsm_stg_header, $tsm_stg_info)) { + warn "$0: warning: TSM Storage Pool header does not match ", + "TSM Storage Pool info.\n"; $tsm_stg_header = ''; $tsm_stg_info = ''; $need_header = 1; @@ -574,8 +567,10 @@ $tsm_log_info, $tsm_tape_info, $tsm_stg_info); $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs - $header_cnt = split ' ', $out_header; - $info_cnt = split ' ', $out_info; + my @out_header = split ' ', $out_header; + my @out_info = split ' ', $out_info; + $header_cnt = @out_header; + $info_cnt = @out_info; if ($header_cnt != $info_cnt) { warn "ERROR: header columns do not equal data columns. Exiting.\n"; &exit_nicely; @@ -592,7 +587,7 @@ } print OUT $out_info, "\n"; - sleep $INTERVAL - ( time() - $timestamp ); + sleep $INTERVAL - (time() - $timestamp); } close OUT; @@ -601,6 +596,14 @@ exit 0; +# Subroutine to that tests if two strings have the same number of +# whitespace separated words. +sub strings_have_same_number_words { + my @words1 = split(' ', $_[0]); + my @words2 = split(' ', $_[1]); + scalar @words1 == scalar @words2; +} + # This subroutine is called by the signal handler. sub exit_nicely { close OUT; Modified: trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in (original) +++ trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Thu Jul 8 22:20:41 2004 @@ -1,11 +1,6 @@ -#!/usr/contrib/bin/perl -# -# Version 1.5 - -# Description: -# Collect general performance statistics formatted for +# Collect general HP performance statistics formatted for # interpretation by Orca. - +# # Usage: # The following variables may be set: # @@ -40,45 +35,43 @@ # $LastChangedBy$ # $LastChangedRevision$ -# Note: Execution speed is more important than cleanliness here. -# +# There are some scripts which are used for getting data and there is +# phymem -- for getting physical memory. # -# There are some script which are used for getting data and there are -# -# phymem -- for getting physical memory -# Copy this script in the path /usr/local/bin +# Copy this script into a location in your path. # ##################BEGIN OF FILE################## #/* Program to determine statistics about the physical and virtual -# memory of a HP workstation, independent of HP-UX version. -#Shows some of the fields on std out. -# -#Program: phymem -#Author: Eef Hartman -#Version: 1.1 -#Last change: 97/01/06 -#Compiled: 97/10/17 09:17:31 -# -#Based on code, posted in the HPadmin mailing list. -# -#To compile: cc -o phys_mem phys_mem.c -# -#*/ +# * memory of a HP workstation, independent of HP-UX version. +# * Shows some of the fields on std out. +# * +# * Program: phymem +# * Author: Eef Hartman +# * Version: 1.1 +# * Last change: 97/01/06 +# * Compiled: 97/10/17 09:17:31 +# * +# * Based on code, posted in the HPadmin mailing list. +# * +# * To compile: cc -o phys_mem phys_mem.c +# * +# */ # #static char SCCSid[] = "@(#)phys_mem 1.1"; # ##include # -#void main() { -#struct pst_static stat_buf; -#struct pst_dynamic dyn_buf; +#int main(void) { +# struct pst_static stat_buf; +# struct pst_dynamic dyn_buf; # -#pstat(PSTAT_STATIC,&stat_buf,sizeof(stat_buf),0,0); -#pstat(PSTAT_DYNAMIC,&dyn_buf,sizeof(dyn_buf),0,0); +# pstat(PSTAT_STATIC, &stat_buf, sizeof(stat_buf), 0, 0); +# pstat(PSTAT_DYNAMIC, &dyn_buf, sizeof(dyn_buf), 0, 0); # -#printf("Physical %ld \n",(stat_buf.physical_memory/256)*1000); +# printf("Physical %ld \n",(stat_buf.physical_memory/256)*1000); # -#return; } +# return0 ; +#} # ############END OF FILE################# #Other script is to get the df output correctly. @@ -91,24 +84,20 @@ #s/[ ]*\n[ ]*/ / #}' #####################EOF##################### -# -# -# my $COMPRESS = '@COMPRESSOR@'; # Explicitly set PATH to prevent odd problems if run manually. -$ENV{PATH} = '/usr/bin:/etc:/usr/sbin:/usr/ucb:/sbin'; +$ENV{PATH} = '/bin:/usr/bin:/etc:/usr/sbin:/usr/ucb:/sbin'; -$Usage_Message = ' -Usage: orca-hp-stat.pl [-r out_root] [-i interval] [-d duration] [-h] +my $Usage_Message = " +usage: $0 [-r out_root] [-i interval] [-d duration] [-h] -r out_root set root output directory, default: /opt/log/performance -i interval number of seconds between checks, default: 300 -d duration number of hours to run, default: 24 -h this message - -'; +"; # Parse the command line arguments while ($#ARGV >= 0) { @@ -133,7 +122,7 @@ ## BEGIN set defaults -$OUT_ROOT ||= '/home/orca/orcallator'; # root directory for dateless +$OUT_ROOT ||= '/home/orca/orcallator'; # root directory for data files $INTERVAL ||= 300; # seconds between checks $DURATION ||= 24; # number of hours to run @@ -158,7 +147,7 @@ $start_time = time(); $timestamp = 0; -## Autodetect network interfaces +# Auto detect network interfaces #open IN, "ifconfig -a|"; open IN, "netstat -i|"; while () { @@ -181,8 +170,9 @@ ## Make sure we can write output. umask 0022; # make sure the file can be harvested -unless ( -d $out_dir) { - system( "mkdir", "-p", "$out_dir" ); +unless (-d $out_dir) { + mkdir($out_dir, 0755) + or die "$0: cannot mkdir '$out_dir': $!\n"; } open OUT, ">$stat_file" or die "ERROR: Could not open $stat_file: $!"; my $oldfh = select OUT; @@ -201,7 +191,7 @@ $prev_header_cnt = 0; $prev_info_cnt = 0; -while ( $iterations-- > 0) { +while ($iterations-- > 0) { $timestamp = $timestamp ? time() : $start_time; ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); @@ -217,11 +207,11 @@ close IN; $load_header = "1runq\t5runq\t15runq"; - if (scalar(split ' ', $load_header) != scalar(split ' ', $load_info)) { + unless (strings_have_same_number_words($load_header, $load_info)) { $load_header = ''; $load_info = ''; $need_header = 1; - warn "WARNING: load header does not match load info.\n"; + warn "$0: warning: load header does not match load info.\n"; } ## Get number of system processes @@ -234,19 +224,19 @@ $proc_info = $num_proc; $proc_header = '#proc'; - if (scalar(split ' ', $proc_header) != scalar(split ' ', $proc_info)) { + unless (strings_have_same_number_words($proc_header, $proc_info)) { $proc_header = ''; $proc_info = ''; $need_header = 1; - warn "WARNING: #proc header does not match #proc info.\n"; + warn "$0: warning: #proc header does not match #proc info.\n"; } ## Get vmstat data open IN, "vmstat 1 2|"; while () { chomp; - if (/^[\s\d]+$/) { + if (/^[\s\d]+$/) { # overwrite first line on 2nd pass my ($vmstat_r, $vmstat_b, $vmstat_wa, $vmstat_avm, $vmstat_fre, $vmstat_re, $vmstat_at, $vmstat_pi, $vmstat_po, $vmstat_fr, @@ -263,8 +253,8 @@ $vmstat_header = "pagesactive\tpagesfree\tpagestotl\tPagesI/s\tPagesO/s\t" . "PagesF/s\tscanrate\tusr%\tsys%\twio%\tidle%"; - if (scalar(split ' ', $vmstat_header) != scalar(split ' ', $vmstat_info)) { - warn "WARNING: vmstat header does not match vmstat info.\n"; + unless (strings_have_same_number_words($vmstat_header, $vmstat_info)) { + warn "$0: warning: vmstat header does not match vmstat info.\n"; $vmstat_header = ''; $vmstat_info = ''; $need_header = 1; @@ -291,7 +281,7 @@ ($iused + $ifree), $iused, $ifree, - 100*($iused/($iused + $ifree))); + 100*$iused/($iused + $ifree)); $fs_header .= "\t" . join("\t", "mntC_$mnt", "mntU_$mnt", "mntA_$mnt", "mntP_$mnt", "mntc_$mnt", "mntu_$mnt", @@ -300,8 +290,8 @@ } close IN; - if (scalar(split ' ', $fs_header) != scalar(split ' ', $fs_info )) { - warn "WARNING: filesystem header does not match filesystem info.\n"; + unless (strings_have_same_number_words($fs_header, $fs_info)) { + warn "$0: warning: filesystem header does not match filesystem info.\n"; $fs_header = ''; $fs_info = ''; $need_header = 1; @@ -333,8 +323,8 @@ $iostat_header = "disk_t/s\tdisk_rK/s\tdisk_wK/s\t"; $iostat_info = "${disk_t}\t${disk_rK}\t${disk_wK}"; - if (scalar(split ' ', $iostat_header) != scalar(split ' ', $iostat_info)) { - warn "WARNING: iostat header does not match iostat info.\n"; + unless (strings_have_same_number_words($iostat_header, $iostat_info)) { + warn "$0: warning: iostat header does not match iostat info.\n"; $iostat_header = ''; $iostat_info = ''; $need_header = 1; @@ -344,13 +334,13 @@ $packet_header = ''; $packet_info = ''; - #foreach $interface ( split(/\s+/, $NET_INTERFACES)) { + #foreach $interface (split(/\s+/, $NET_INTERFACES)) { foreach $interface (@net_interfaces) { $packet_header .= "${interface}Ipkt/s\t${interface}IErr/s\t" . "${interface}Opkt/s\t${interface}OErr/s\t" . "${interface}Coll/s\t"; - open IN, "netstat -I $interface 1|"; + open IN, "netstat -I $interface 1|"; while () { if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) { $packet_info .= "\t" . join("\t", $1, $2, $3, $4, $5); @@ -360,8 +350,8 @@ close IN; } - if (scalar(split ' ', $packet_header) != scalar(split ' ', $packet_info)) { - warn "WARNING: packet header does not match packet info.\n"; + unless (strings_have_same_number_words($packet_header, $packet_info)) { + warn "$0: warning: packet header does not match packet info.\n"; $packet_header = ''; $packet_info = ''; $need_header = 1; @@ -376,11 +366,12 @@ } } close IN; + $tcp_info = $tcp_estb; $tcp_header = 'tcp_estb'; - if (scalar(split ' ', $tcp_estb_header) != scalar(split ' ', $tcp_estb_info)){ - warn "WARNING: tcp_estb header does not match tcp_estb info.\n"; + unless (strings_have_same_number_words($tcp_estb_header, $tcp_estb_info)) { + warn "$0: warning: tcp_estb header does not match tcp_estb info.\n"; $tcp_estb_header = ''; $tcp_estb_info = ''; $need_header = 1; @@ -399,8 +390,10 @@ $tcp_info); $out_info =~ tr/ \t/\t/s; # translate whitespace to single tabs - $header_cnt = split ' ', $out_header; - $info_cnt = split ' ', $out_info; + my @out_header = split ' ', $out_header; + my @out_info = split ' ', $out_info; + $header_cnt = @out_header; + $info_cnt = @out_info; if ($header_cnt != $info_cnt) { warn "ERROR: header columns do not equal data columns. Exiting.\n"; &exit_nicely; @@ -417,7 +410,7 @@ } print OUT $out_info, "\n"; - sleep $INTERVAL - ( time() - $timestamp ); + sleep $INTERVAL - (time() - $timestamp); } close OUT; @@ -426,6 +419,14 @@ exit 0; +# Subroutine to that tests if two strings have the same number of +# whitespace separated words. +sub strings_have_same_number_words { + my @words1 = split(' ', $_[0]); + my @words2 = split(' ', $_[1]); + scalar @words1 == scalar @words2; +} + # This subroutine is called by the signal handler. sub exit_nicely { close OUT; From blair at orcaware.com Mon Jul 12 22:08:58 2004 From: blair at orcaware.com (Blair Zajac) Date: Mon, 12 Jul 2004 22:08:58 -0700 Subject: [Orca-checkins] r374 - in trunk/orca/data_gatherers: aix hp Message-ID: <200407130508.i6D58w05003301@orcaware.com> Author: blair Date: Mon Jul 12 22:02:34 2004 New Revision: 374 Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Log: Bug fixes from Frederic Viry . * data_gatherers/aix/orca-aix-stat.pl.in: (main): The script calculates incorrect values for uptime and nusr. Do not sleep in the last iteration of the main loop, because the script will exit the script immediately anyway after the sleep. * data_gatherers/hp/orca-hp-stat.pl.in: (main): Do not sleep in the last iteration of the main loop, because the script will exit the script immediately anyway after the sleep. Modified: trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in (original) +++ trunk/orca/data_gatherers/aix/orca-aix-stat.pl.in Mon Jul 12 22:02:34 2004 @@ -175,12 +175,37 @@ } @upt = split(/ +/,); $uptd = $upt[3]; - $nusr = $upt[6]; $up_day = $uptd * 24 * 60 * 60; - if (/days,\s+(\S+):(\S+), /) { + $up_hrs = 0; + $up_min = 0; + + if (/day(?:s?),\s+(\S+)\s+min(?:s?),/) { + $nusr = $upt[7]; + $up_min = $1 * 60; + } elsif (/day(?:s?),\s+(\S+)\s+hr(?:s?),/) { + $nusr = $upt[7]; + $up_hrs = $1 * 60 * 60; + } elsif (/day(?:s?),\s+(\S+):(\S+), /) { + $nusr = $upt[6]; $up_hrs = $1 * 60 * 60; $up_min = $2 * 60; + } elsif ($_ !~ /day/) { + $up_day = 0; + if (/\s+(\S+):(\S+),/) { + $nusr = $upt[4]; + $up_hrs = $1 * 60 * 60; + $up_min = $2 * 60; + } elsif (/\s+(\S+)\s+min(?:s?),/) { + $nusr = $upt[5]; + $up_min = $1 * 60; + } elsif (/\s+(\S+)\s+hr(?:s?),/) { + $nusr = $upt[5]; + $up_hrs = $1 * 60 * 60; + } + } else { + $nusr = $upt[5]; } + $uptime = $up_day + $up_hrs + $up_min; } close IN; @@ -587,7 +612,9 @@ } print OUT $out_info, "\n"; - sleep $INTERVAL - (time() - $timestamp); + if ($iterations) { + sleep($INTERVAL - (time() - $timestamp)); + } } close OUT; Modified: trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in ============================================================================== --- trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in (original) +++ trunk/orca/data_gatherers/hp/orca-hp-stat.pl.in Mon Jul 12 22:02:34 2004 @@ -410,7 +410,9 @@ } print OUT $out_info, "\n"; - sleep $INTERVAL - (time() - $timestamp); + if ($iterations) { + sleep($INTERVAL - (time() - $timestamp)); + } } close OUT; From blair at orcaware.com Tue Jul 13 22:07:44 2004 From: blair at orcaware.com (Blair Zajac) Date: Tue, 13 Jul 2004 22:07:44 -0700 Subject: [Orca-checkins] r375 - in trunk/orca: . packages/version-0.39 packages/version-0.41 packages/version-0.41/lib packages/version-0.41/t Message-ID: <200407140507.i6E57ihG026110@orcaware.com> Author: blair Date: Tue Jul 13 21:59:56 2004 New Revision: 375 Added: trunk/orca/packages/version-0.41/ - copied from r373, trunk/orca/packages/version-0.39/ Removed: trunk/orca/packages/version-0.39/ Modified: trunk/orca/INSTALL trunk/orca/configure.in trunk/orca/packages/version-0.41/Changes trunk/orca/packages/version-0.41/META.yml trunk/orca/packages/version-0.41/Makefile.PL trunk/orca/packages/version-0.41/README trunk/orca/packages/version-0.41/lib/version.pm trunk/orca/packages/version-0.41/t/01base.t trunk/orca/packages/version-0.41/util.c trunk/orca/packages/version-0.41/version.xs Log: Upgrade the Perl version module from 0.39 to 0.41 and require the new module for Orca. * configure.in: Bump version's version number to 0.41. * INSTALL (Determine which Perl modules need compiling and installing): Update all references to version's version number from 0.39 to 0.41. * packages/version-0.41: Renamed from packages/version-0.39. Directory contents updated from version-0.41.tar.gz. Modified: trunk/orca/INSTALL ============================================================================== --- trunk/orca/INSTALL (original) +++ trunk/orca/INSTALL Tue Jul 13 21:59:56 2004 @@ -178,7 +178,7 @@ RRDs >= 1.000461 >= 1.0.46 1.0.46 Storable >= 2.13 >= 2.13 2.13 Time::HiRes Not required by Orca 1.59 - version >= 0.39 >= 0.39 0.39 + version >= 0.41 >= 0.41 0.41 All seven of these modules are included with the Orca distribution in the packages directory. When you configure Orca in step 3), @@ -290,10 +290,10 @@ version - http://www.perl.com/CPAN/authors/id/J/JP/JPEACOCK/version-0.39.tar.gz + http://www.perl.com/CPAN/authors/id/J/JP/JPEACOCK/version-0.41.tar.gz - % gunzip -c version-0.39.tar.gz | tar xvf - - % cd version-0.39 + % gunzip -c version-0.41.tar.gz | tar xvf - + % cd version-0.41 % perl Makefile.PL % make % make test Modified: trunk/orca/configure.in ============================================================================== --- trunk/orca/configure.in (original) +++ trunk/orca/configure.in Tue Jul 13 21:59:56 2004 @@ -43,8 +43,8 @@ STORABLE_VER=2.13 TIME_HIRES_DIR=Time-HiRes-1.59 TIME_HIRES_VER=1.59 -VERSION_DIR=version-0.39 -VERSION_VER=0.39 +VERSION_DIR=version-0.41 +VERSION_VER=0.41 AC_SUBST(COMPRESS_ZLIB_DIR) AC_SUBST(DATA_DUMPER_DIR) Modified: trunk/orca/packages/version-0.41/Changes ============================================================================== --- trunk/orca/packages/version-0.39/Changes (original) +++ trunk/orca/packages/version-0.41/Changes Tue Jul 13 21:59:56 2004 @@ -1,439 +1,434 @@ -2004-04-13 21:15:32 John Peacock - - M util.c - Change scan_vstring to treat alpha versions like numeric if - appropriate (only one decimal) - - M t/01base.t - Alter testing and add new tests for alpha version code - - M lib/version.pm - Continue to improve (hopefully) POD including new alpha version - behavior - - M README - Big red warnings about changing behavior - -2004-04-12 20:53:52 John Peacock - - New branch to fix alpha versions - -2004-04-11 10:44:55 John Peacock - - M MANIFEST - Forgot to delete the version::AlphaBeta files from packing list - -2004-04-11 10:43:34 John Peacock - - D lib/version - D t/02AlphaBeta.t - Delete these files and release independently on CPAN - - M util.c - new() of version object makes copy - - M t/01base.t - test new() on existing version object - - M lib/version.pm - M README - Document new() and elimination of version::AlphaBeta from this distro - - M version.xs - Only call vnumify() if a version object in UNIVERSAL::VERSION - -2004-04-09 23:58:31 John Peacock - - Brnach for new version - -2004-04-03 14:30:01 John Peacock - - * lib/version.pm - Change all uses of "new version" to "version->new()" - Check all examples against current code/behavior - Add doc warnings for edge cases - -2004-03-27 22:45:18 John Peacock - - * util.c - quoted versions, e.g qv() and v-string, always get at least 3 terms - change vstringify() to vnormal() - new vstringify() to display either vnumify() or vnormal() form - - * util.h - Add #define for SVf (SV format) only needed for Perl 5.005_03 - - * version.xs - new XS class function normal() - UNIVERSAL::VERSION warning displays both numify() and normal() forms, - also returns exclusively numify() form - - * lib/version.pm - Extensive POD rewrite to explain normal form and how stringify works - - * t/01base.t - Altered tests to correspond to new stringify behavior - - * README - Add warning about new stringify behavior - - * ppport.h - Copied from recent bleadperl build - -2004-03-23 21:07:08 John Peacock - - Create a new tag before changing anything - -2004-02-01 20:30:01 John Peacock - - * README - Include a short blurb on the qv() operator - - * lib/version.pm - Reformat the description of the qv() operator - Change the $VERSION for a release - - * version.xs - Support using qv() with v-strings in Perl 5.8.1+ - - * t/01base.t - Tests for qv() and v-strings - -2004-02-01 20:29:11 John Peacock - - Copy the files prior to updating to new version - -2004-01-29 22:35:40 John Peacock - - Tag for 0.35.0 release - -2004-01-29 21:46:15 John Peacock - - * lib/version.pm - Update the $VERSION prior to release - - * MANIFEST - Remove Changes as it is now autocreated - - * Makefile.PL - Autocreate Changes as part of 'dist' target - - * util.c - Correct handling of v-strings in new_version() - - * version.xs, util.c - Change use of SvPV_nolen() with SvPV() so that 5.005_03 works again - - * t/01base.t - Add tests for v-string creation (skipped on Perl < 5.8.0) - -2004-01-29 20:35:12 John Peacock - - * Create a branch from which to eventually release 0.35 - -2004-01-29 20:31:22 John Peacock - - * Belately create tag for version 0.34 - -2003-12-29 10:35:34 John Peacock - - * typemap - Stop automatically dereferencing input variable - * lib/version.pm - Update $VERSION for a change - * README - Include warning on memory leaks - * util.c - (new_version): use upg_version exclusively - (upg_version): move code from new_version here - * version.xs - Stop dereferencing input variables - Stop assuming that the PV has a value - -2003-12-28 23:39:08 John Peacock - - * t/01base.t - Replace postfix increment with prefix increment to prevent erroneous - "Attempt to free..." errors - Add test of CVS $Revision: $ style versions - - * util.c - Rewrite new_version to free temporary string variable - - * version.xs - Rewrite version->new() to eliminate temp string for CVS $Revision: $ - Rewrite version->qv() to use scan_version instead of new_version - -2003-12-21 13:00:05 John Peacock - - M version.xs - Go through code to ensure that there are no leaking scalars - Sadly, there are still leaks from version::VERSION of unknown origins - -2003-12-20 19:27:00 John Peacock - - M t/02AlphaBeta.t - M lib/version/AlphaBeta.pm - Implement an alternate object representation - Overload stringify() with custom function - -2003-10-25 21:17:52 John Peacock - - M t/02AlphaBeta.t - Add empty derived class and modify tests to run - M t/01base.t - Work around bug with postfix increment under all Perl < bleadperl - -2003-09-10 15:05:07 John Peacock - - Fix for Ticket #3764 - need to strip final term before chop() - Implement qv() function and document/test - - -2003-09-10 06:40:15 John Peacock - - Remove the changes file from the repository. - Generate it before release: - - svn log file:///var/svn/modules/version/trunk - - and eventually by 'release.pl --changes' - - -2003-09-10 06:36:49 John Peacock - - Finish backporting bleadperl changes - Special case test for 5.005_03 - Patch ppport.h to support IVSIZE for 5.005_03 - - -2003-09-10 05:13:09 John Peacock - - No, really delete the lines from MANIFEST - Last bit of clean up in the POD - -2003-09-10 04:59:31 John Peacock - - Delete version::Empty module and include in t/01base.t instead - Correct MANIFEST (delete missing files and add ppport.h) - Make version::stringify() return at least three subversions - -2003-09-09 15:20:40 John Peacock - - Integrate changes from bleadperl - Combine emptyclass.t test into 01base.t - Use ppport.h instead of homebrewed #define's - - -2003-09-07 09:13:53 John Peacock - - Extend version::new() to handle derived classes - Abstract t/01base.t into external file - Create and test empty derived class - - FIX: "attempt to free unreferenced scalar" during testing - -2003-07-09 10:11:57 John Peacock - - Merge changes made accidently on branch back to head - -2003-06-13 21:34:50 John Peacock - - Forgot to commit this before releasing. - -2003-06-13 15:02:11 John Peacock - - Correct the example code (again) to correct for CVS update problems - -2003-06-13 14:56:27 John Peacock - - Reformatted POD's from - -2003-06-13 12:51:14 John Peacock - - Change reference from "beta" to "alpha" to follow PAUSE convention - Add new function ->is_alpha() to test for alpha versions - Add docs for all logical operations on version objects - Fix example to have matching versions (old CVS issue) - -2003-06-13 12:48:05 John Peacock - - Implement version::AlphaBeta module - Copy repository history from CVS into subversion - -2003-06-13 12:48:02 John Peacock - - To prepare to load /home/jpeacock/tmp/version-0.28 into version/trunk, - perform 2 renames. - - * version/trunk/t/1.t: Renamed from version/trunk/t/version.t. - * version/trunk/lib/version.pm: Renamed from version/trunk/version.pm. - -2003-01-05 17:45:41 John Peacock - - Extract most recent log messages for main file - -2003-01-05 17:43:51 John Peacock - - Rewrite POD to call a v-string a v-string - Reformat POD to look nicer - -2003-01-05 17:42:16 John Peacock - - Make vnumify return an actual NV (instead of an SV which looks like one) - -2003-01-05 17:40:50 John Peacock - - Make warnings even more dire - -2003-01-05 17:37:32 John Peacock - - change comment message to more accurately reflect the test - -2002-12-27 10:15:29 John Peacock - - Rewrite to support new model of "Numeric Versions" and "String Versions" - -2002-12-17 21:28:48 John Peacock - - New version to cope with GSAR's vision of bare number versions - -2002-12-05 06:51:34 John Peacock - - Make -w clean tests - -2002-12-05 05:41:24 John Peacock - - Bring into sync with perl-current - -2002-11-18 05:35:54 John Peacock - - Bring current with repository version - -2002-11-18 05:33:23 John Peacock - - Fix compile errors under threaded Perl's - Supress {Unquoted string version} warnings - -2002-11-18 05:33:23 John Peacock - - - Fix compile errors under threaded Perls - -2002-11-18 05:24:17 John Peacock - - Fix compile errors under threaded Perl's - Supress {Unquoted string "version"} warnings - -2002-10-14 21:27:00 John Peacock - - Fix typos - Fix handling of null versions - -2002-10-10 20:41:54 John Peacock - - use Perl_croak from C code - -2002-10-08 20:51:20 John Peacock - - Recover gracefully to null versions (rather than core) - -2002-10-08 20:44:24 John Peacock - - Recover gracefully to null versions (rather than core) - -2002-10-04 22:57:00 John Peacock - - Document extended decimal version parsing - -2002-10-04 21:01:45 John Peacock - - Force all files to next major revision (so the version works) - -2002-10-04 20:53:33 John Peacock - - Add tests for 1.002003 => 1.2.3 - -2002-10-04 20:53:10 John Peacock - - Add support for 1.002003 => 1.2.3 - -2002-10-04 20:31:01 John Peacock - - Remove dependency on Exporter.pm - -2002-09-29 19:46:23 John Peacock - - Update with version from perl-current - -2002-09-29 19:44:47 John Peacock - - Change vstringify and vnumify - Reword main POD slightly - -2002-09-28 14:38:15 John Peacock - - Final changes to release to CPAN - Merged code into perl-current - -2002-09-28 06:21:16 John Peacock - - Ready to release to CPAN - -2002-09-28 06:15:34 John Peacock - - POD changes - -2002-09-28 06:15:16 John Peacock - - Cannot use SvPV_nolen in 5.005_03 - -2002-09-22 21:40:02 John Peacock - - Document the UNIVERSAL::VERSION replacement - -2002-09-22 21:23:01 John Peacock - - Successfully create and test my own UNIVERSAL::VERSION replacement - -2002-09-16 15:35:58 John Peacock - - Improve the testing of beta versions - -2002-09-16 08:12:49 John Peacock - - More POD changes - -2002-09-16 07:52:08 John Peacock - - Add additional testing - Add POD - -2002-09-16 06:17:41 John Peacock - - Finally works in 5.005_03, 5.6.1, and 5.8.0 - -2002-09-15 06:13:51 John Peacock - - Doesn't work any more? - -2002-09-14 16:08:23 John Peacock - - working AV objects in 5.6.x only - -2002-09-14 16:08:23 John Peacock - - *** empty log message *** - -2002-09-13 23:12:25 John Peacock - - Finished for the night - -2002-09-13 22:28:39 John Peacock - - almost working AV style version objects - -2002-09-13 21:59:09 John Peacock - - Initial revision - +------------------------------------------------------------------------ +r319 | jpeacock | 2004-07-12 23:07:10 -0400 (Mon, 12 Jul 2004) | 13 lines + +* util.c + Fix infinite loop for CVS-style versions of more than 3 decimal places + Thanks to Richard Evans + +* t/01base.t + Test to make sure above doesn't happen again + +* lib/version.pm + Increment the $VERSION again + +* README + Remember to update this before releasing (for a change) + +------------------------------------------------------------------------ +r316 | jpeacock | 2004-07-11 18:01:36 -0400 (Sun, 11 Jul 2004) | 8 lines + +* lib/version.pm + Increment $VERSION number; have to quote to get the tgz file named + correctly (isn't that what this module is supposed to fix?) + +* version.xs:UNIVERSAL_VERSION() + Check for null sv before attempting sv_derived_from() + Thanks to Marcus Holland-Moritz for finding this + +------------------------------------------------------------------------ +r248 | jpeacock | 2004-04-14 13:52:42 -0400 (Wed, 14 Apr 2004) | 2 lines + +Merge changes from version-0.39 back to trunk + +------------------------------------------------------------------------ +r218 | jpeacock | 2004-01-06 21:16:42 -0500 (Tue, 06 Jan 2004) | 15 lines + +* t/02AlphaBeta.t +* t/01base.t + Update tests to require newer version + Change test for CPAN-Style version behavior +* MANIFEST + Delete 'Changes' from repository since it will now be autogenerated +* lib/version.pm + Clean up POD to reflect actual behavior of code +* Makefile.PL + Add new target to automatically generate the 'Changes' file +* util.c + (Perl_scan_version): rewrite code to use AV * instead of SV * for + internal representation; trigger CPAN-style only for second term + + +------------------------------------------------------------------------ +r217 | jpeacock | 2004-01-03 22:16:15 -0500 (Sat, 03 Jan 2004) | 1 line + +Ignore MakeMaker-generated files in svn status +------------------------------------------------------------------------ +r216 | jpeacock | 2004-01-03 22:10:27 -0500 (Sat, 03 Jan 2004) | 1 line + +Ignore MakeMaker-generated files in svn status +------------------------------------------------------------------------ +r215 | jpeacock | 2004-01-03 22:09:44 -0500 (Sat, 03 Jan 2004) | 1 line + +Ignore MakeMaker-generated files in svn status +------------------------------------------------------------------------ +r214 | jpeacock | 2004-01-01 20:54:15 -0500 (Thu, 01 Jan 2004) | 7 lines + +* lib/version.pm + (POD): Initial documentation of CPAN-Style versions + +* util.c + (Perl_scan_version): Try and handle CPAN versions (two decimal + places) differently from Perl-style (three or more decimal places) + +------------------------------------------------------------------------ +r213 | jpeacock | 2003-12-29 10:35:34 -0500 (Mon, 29 Dec 2003) | 13 lines + +* typemap + Stop automatically dereferencing input variable +* lib/version.pm + Update $VERSION for a change +* README + Include warning on memory leaks +* util.c + (new_version): use upg_version exclusively + (upg_version): move code from new_version here +* version.xs + Stop dereferencing input variables + Stop assuming that the PV has a value + +------------------------------------------------------------------------ +r212 | jpeacock | 2003-12-28 23:39:08 -0500 (Sun, 28 Dec 2003) | 12 lines + +* t/01base.t + Replace postfix increment with prefix increment to prevent erroneous + "Attempt to free..." errors + Add test of CVS $Revision: $ style versions + +* util.c + Rewrite new_version to free temporary string variable + +* version.xs + Rewrite version->new() to eliminate temp string for CVS $Revision: $ + Rewrite version->qv() to use scan_version instead of new_version + +------------------------------------------------------------------------ +r209 | jpeacock | 2003-12-21 13:00:05 -0500 (Sun, 21 Dec 2003) | 4 lines + +M version.xs + Go through code to ensure that there are no leaking scalars + Sadly, there are still leaks from version::VERSION of unknown origins + +------------------------------------------------------------------------ +r208 | jpeacock | 2003-12-20 19:27:00 -0500 (Sat, 20 Dec 2003) | 5 lines + +M t/02AlphaBeta.t +M lib/version/AlphaBeta.pm + Implement an alternate object representation + Overload stringify() with custom function + +------------------------------------------------------------------------ +r195 | jpeacock | 2003-10-25 21:17:52 -0400 (Sat, 25 Oct 2003) | 5 lines + +M t/02AlphaBeta.t + Add empty derived class and modify tests to run +M t/01base.t + Work around bug with postfix increment under all Perl < bleadperl + +------------------------------------------------------------------------ +r168 | jpeacock | 2003-09-10 15:05:07 -0400 (Wed, 10 Sep 2003) | 4 lines + +Fix for Ticket #3764 - need to strip final term before chop() +Implement qv() function and document/test + + +------------------------------------------------------------------------ +r166 | jpeacock | 2003-09-10 06:40:15 -0400 (Wed, 10 Sep 2003) | 8 lines + +Remove the changes file from the repository. +Generate it before release: + + svn log file:///var/svn/modules/version/trunk + +and eventually by 'release.pl --changes' + + +------------------------------------------------------------------------ +r165 | jpeacock | 2003-09-10 06:36:49 -0400 (Wed, 10 Sep 2003) | 5 lines + +Finish backporting bleadperl changes +Special case test for 5.005_03 +Patch ppport.h to support IVSIZE for 5.005_03 + + +------------------------------------------------------------------------ +r164 | jpeacock | 2003-09-10 05:13:09 -0400 (Wed, 10 Sep 2003) | 3 lines + +No, really delete the lines from MANIFEST +Last bit of clean up in the POD + +------------------------------------------------------------------------ +r163 | jpeacock | 2003-09-10 04:59:31 -0400 (Wed, 10 Sep 2003) | 4 lines + +Delete version::Empty module and include in t/01base.t instead +Correct MANIFEST (delete missing files and add ppport.h) +Make version::stringify() return at least three subversions + +------------------------------------------------------------------------ +r162 | jpeacock | 2003-09-09 15:20:40 -0400 (Tue, 09 Sep 2003) | 5 lines + +Integrate changes from bleadperl +Combine emptyclass.t test into 01base.t +Use ppport.h instead of homebrewed #define's + + +------------------------------------------------------------------------ +r161 | jpeacock | 2003-09-07 09:13:53 -0400 (Sun, 07 Sep 2003) | 6 lines + +Extend version::new() to handle derived classes +Abstract t/01base.t into external file +Create and test empty derived class + +FIX: "attempt to free unreferenced scalar" during testing + +------------------------------------------------------------------------ +r133 | jpeacock | 2003-07-09 10:11:57 -0400 (Wed, 09 Jul 2003) | 2 lines + +Merge changes made accidently on branch back to head + +------------------------------------------------------------------------ +r123 | jpeacock | 2003-06-13 21:34:50 -0400 (Fri, 13 Jun 2003) | 2 lines + +Forgot to commit this before releasing. + +------------------------------------------------------------------------ +r119 | jpeacock | 2003-06-13 15:02:11 -0400 (Fri, 13 Jun 2003) | 2 lines + +Correct the example code (again) to correct for CVS update problems + +------------------------------------------------------------------------ +r118 | jpeacock | 2003-06-13 14:56:27 -0400 (Fri, 13 Jun 2003) | 2 lines + +Reformatted POD's from + +------------------------------------------------------------------------ +r117 | jpeacock | 2003-06-13 12:51:14 -0400 (Fri, 13 Jun 2003) | 5 lines + +Change reference from "beta" to "alpha" to follow PAUSE convention +Add new function ->is_alpha() to test for alpha versions +Add docs for all logical operations on version objects +Fix example to have matching versions (old CVS issue) + +------------------------------------------------------------------------ +r116 | jpeacock | 2003-06-13 12:48:05 -0400 (Fri, 13 Jun 2003) | 3 lines + +Implement version::AlphaBeta module +Copy repository history from CVS into subversion + +------------------------------------------------------------------------ +r115 | jpeacock | 2003-06-13 12:48:02 -0400 (Fri, 13 Jun 2003) | 6 lines + +To prepare to load /home/jpeacock/tmp/version-0.28 into version/trunk, +perform 2 renames. + +* version/trunk/t/1.t: Renamed from version/trunk/t/version.t. +* version/trunk/lib/version.pm: Renamed from version/trunk/version.pm. + +------------------------------------------------------------------------ +r90 | jpeacock | 2003-01-05 17:45:41 -0500 (Sun, 05 Jan 2003) | 2 lines + +Extract most recent log messages for main file + +------------------------------------------------------------------------ +r89 | jpeacock | 2003-01-05 17:43:51 -0500 (Sun, 05 Jan 2003) | 3 lines + +Rewrite POD to call a v-string a v-string +Reformat POD to look nicer + +------------------------------------------------------------------------ +r88 | jpeacock | 2003-01-05 17:42:16 -0500 (Sun, 05 Jan 2003) | 2 lines + +Make vnumify return an actual NV (instead of an SV which looks like one) + +------------------------------------------------------------------------ +r87 | jpeacock | 2003-01-05 17:40:50 -0500 (Sun, 05 Jan 2003) | 2 lines + +Make warnings even more dire + +------------------------------------------------------------------------ +r86 | jpeacock | 2003-01-05 17:37:32 -0500 (Sun, 05 Jan 2003) | 2 lines + +change comment message to more accurately reflect the test + +------------------------------------------------------------------------ +r85 | jpeacock | 2002-12-27 10:15:29 -0500 (Fri, 27 Dec 2002) | 2 lines + +Rewrite to support new model of "Numeric Versions" and "String Versions" + +------------------------------------------------------------------------ +r84 | jpeacock | 2002-12-17 21:28:48 -0500 (Tue, 17 Dec 2002) | 2 lines + +New version to cope with GSAR's vision of bare number versions + +------------------------------------------------------------------------ +r83 | jpeacock | 2002-12-05 06:51:34 -0500 (Thu, 05 Dec 2002) | 2 lines + +Make -w clean tests + +------------------------------------------------------------------------ +r82 | jpeacock | 2002-12-05 05:41:24 -0500 (Thu, 05 Dec 2002) | 2 lines + +Bring into sync with perl-current + +------------------------------------------------------------------------ +r81 | jpeacock | 2002-11-18 05:35:54 -0500 (Mon, 18 Nov 2002) | 2 lines + +Bring current with repository version + +------------------------------------------------------------------------ +r80 | jpeacock | 2002-11-18 05:33:23 -0500 (Mon, 18 Nov 2002) | 3 lines + +Fix compile errors under threaded Perl's +Supress {Unquoted string version} warnings + +------------------------------------------------------------------------ +r79 | jpeacock | 2002-11-18 05:33:23 -0500 (Mon, 18 Nov 2002) | 3 lines + + +Fix compile errors under threaded Perls + +------------------------------------------------------------------------ +r78 | jpeacock | 2002-11-18 05:24:17 -0500 (Mon, 18 Nov 2002) | 3 lines + +Fix compile errors under threaded Perl's +Supress {Unquoted string "version"} warnings + +------------------------------------------------------------------------ +r77 | jpeacock | 2002-10-14 21:27:00 -0400 (Mon, 14 Oct 2002) | 3 lines + +Fix typos +Fix handling of null versions + +------------------------------------------------------------------------ +r76 | jpeacock | 2002-10-10 20:41:54 -0400 (Thu, 10 Oct 2002) | 2 lines + +use Perl_croak from C code + +------------------------------------------------------------------------ +r75 | jpeacock | 2002-10-08 20:51:20 -0400 (Tue, 08 Oct 2002) | 2 lines + +Recover gracefully to null versions (rather than core) + +------------------------------------------------------------------------ +r74 | jpeacock | 2002-10-08 20:44:24 -0400 (Tue, 08 Oct 2002) | 2 lines + +Recover gracefully to null versions (rather than core) + +------------------------------------------------------------------------ +r73 | jpeacock | 2002-10-04 22:57:00 -0400 (Fri, 04 Oct 2002) | 2 lines + +Document extended decimal version parsing + +------------------------------------------------------------------------ +r72 | jpeacock | 2002-10-04 21:01:45 -0400 (Fri, 04 Oct 2002) | 2 lines + +Force all files to next major revision (so the version works) + +------------------------------------------------------------------------ +r71 | jpeacock | 2002-10-04 20:53:33 -0400 (Fri, 04 Oct 2002) | 2 lines + +Add tests for 1.002003 => 1.2.3 + +------------------------------------------------------------------------ +r70 | jpeacock | 2002-10-04 20:53:10 -0400 (Fri, 04 Oct 2002) | 2 lines + +Add support for 1.002003 => 1.2.3 + +------------------------------------------------------------------------ +r69 | jpeacock | 2002-10-04 20:31:01 -0400 (Fri, 04 Oct 2002) | 2 lines + +Remove dependency on Exporter.pm + +------------------------------------------------------------------------ +r68 | jpeacock | 2002-09-29 19:46:23 -0400 (Sun, 29 Sep 2002) | 2 lines + +Update with version from perl-current + +------------------------------------------------------------------------ +r67 | jpeacock | 2002-09-29 19:44:47 -0400 (Sun, 29 Sep 2002) | 3 lines + +Change vstringify and vnumify +Reword main POD slightly + +------------------------------------------------------------------------ +r66 | jpeacock | 2002-09-28 14:38:15 -0400 (Sat, 28 Sep 2002) | 3 lines + +Final changes to release to CPAN +Merged code into perl-current + +------------------------------------------------------------------------ +r65 | jpeacock | 2002-09-28 06:21:16 -0400 (Sat, 28 Sep 2002) | 2 lines + +Ready to release to CPAN + +------------------------------------------------------------------------ +r64 | jpeacock | 2002-09-28 06:15:34 -0400 (Sat, 28 Sep 2002) | 2 lines + +POD changes + +------------------------------------------------------------------------ +r63 | jpeacock | 2002-09-28 06:15:16 -0400 (Sat, 28 Sep 2002) | 2 lines + +Cannot use SvPV_nolen in 5.005_03 + +------------------------------------------------------------------------ +r62 | jpeacock | 2002-09-22 21:40:02 -0400 (Sun, 22 Sep 2002) | 2 lines + +Document the UNIVERSAL::VERSION replacement + +------------------------------------------------------------------------ +r61 | jpeacock | 2002-09-22 21:23:01 -0400 (Sun, 22 Sep 2002) | 2 lines + +Successfully create and test my own UNIVERSAL::VERSION replacement + +------------------------------------------------------------------------ +r60 | jpeacock | 2002-09-16 15:35:58 -0400 (Mon, 16 Sep 2002) | 2 lines + +Improve the testing of beta versions + +------------------------------------------------------------------------ +r59 | jpeacock | 2002-09-16 08:12:49 -0400 (Mon, 16 Sep 2002) | 2 lines + +More POD changes + +------------------------------------------------------------------------ +r58 | jpeacock | 2002-09-16 07:52:08 -0400 (Mon, 16 Sep 2002) | 3 lines + +Add additional testing +Add POD + +------------------------------------------------------------------------ +r57 | jpeacock | 2002-09-16 06:17:41 -0400 (Mon, 16 Sep 2002) | 2 lines + +Finally works in 5.005_03, 5.6.1, and 5.8.0 + +------------------------------------------------------------------------ +r56 | jpeacock | 2002-09-15 06:13:51 -0400 (Sun, 15 Sep 2002) | 2 lines + +Doesn't work any more? + +------------------------------------------------------------------------ +r55 | jpeacock | 2002-09-14 16:08:23 -0400 (Sat, 14 Sep 2002) | 2 lines + +working AV objects in 5.6.x only + +------------------------------------------------------------------------ +r54 | jpeacock | 2002-09-14 16:08:23 -0400 (Sat, 14 Sep 2002) | 2 lines + +*** empty log message *** + +------------------------------------------------------------------------ +r53 | jpeacock | 2002-09-13 23:12:25 -0400 (Fri, 13 Sep 2002) | 2 lines + +Finished for the night + +------------------------------------------------------------------------ +r52 | jpeacock | 2002-09-13 22:28:39 -0400 (Fri, 13 Sep 2002) | 2 lines + +almost working AV style version objects + +------------------------------------------------------------------------ +r51 | jpeacock | 2002-09-13 21:59:09 -0400 (Fri, 13 Sep 2002) | 2 lines + +Initial revision + +------------------------------------------------------------------------ Modified: trunk/orca/packages/version-0.41/META.yml ============================================================================== --- trunk/orca/packages/version-0.39/META.yml (original) +++ trunk/orca/packages/version-0.41/META.yml Tue Jul 13 21:59:56 2004 @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: version -version: 0.39 +version: 0.41 version_from: lib/version.pm installdirs: site requires: Modified: trunk/orca/packages/version-0.41/Makefile.PL ============================================================================== --- trunk/orca/packages/version-0.39/Makefile.PL (original) +++ trunk/orca/packages/version-0.41/Makefile.PL Tue Jul 13 21:59:56 2004 @@ -12,6 +12,6 @@ # Un-comment this if you add C files to link with later: 'OBJECT' => '$(O_FILES)', # link all the C files too dist => { - PREOP => 'svn log | gnuify-changelog.pl > ${DISTVNAME}/Changes', + PREOP => 'svn log > ${DISTVNAME}/Changes', }, ); Modified: trunk/orca/packages/version-0.41/README ============================================================================== --- trunk/orca/packages/version-0.39/README (original) +++ trunk/orca/packages/version-0.41/README Tue Jul 13 21:59:56 2004 @@ -1,4 +1,4 @@ -version 0.39 +version 0.41 ==================== Provides the same version objects as included in Perl v5.9.0 (and hopefully in Modified: trunk/orca/packages/version-0.41/lib/version.pm ============================================================================== --- trunk/orca/packages/version-0.39/lib/version.pm (original) +++ trunk/orca/packages/version-0.41/lib/version.pm Tue Jul 13 21:59:56 2004 @@ -12,7 +12,7 @@ @EXPORT = qw(qv); -$VERSION = 0.39; # stop using CVS and switch to subversion +$VERSION = 0.41; # stop using CVS and switch to subversion $CLASS = 'version'; Modified: trunk/orca/packages/version-0.41/t/01base.t ============================================================================== --- trunk/orca/packages/version-0.39/t/01base.t (original) +++ trunk/orca/packages/version-0.41/t/01base.t Tue Jul 13 21:59:56 2004 @@ -4,7 +4,7 @@ ######################### -use Test::More tests => 168; +use Test::More tests => 170; diag "Tests with base class" unless $ENV{PERL_CORE}; @@ -222,6 +222,8 @@ diag "testing CVS Revision" unless $ENV{PERL_CORE}; $version = new version qw$Revision: 1.2$; ok ( $version eq "1.2.0", 'qw$Revision: 1.2$ eq 1.2.0' ); + $version = new version qw$Revision: 1.2.3.4$; + ok ( $version eq "1.2.3.4", 'qw$Revision: 1.2.3.4$ eq 1.2.3.4' ); # test reformed UNIVERSAL::VERSION diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE}; Modified: trunk/orca/packages/version-0.41/util.c ============================================================================== --- trunk/orca/packages/version-0.39/util.c (original) +++ trunk/orca/packages/version-0.41/util.c Tue Jul 13 21:59:56 2004 @@ -117,7 +117,7 @@ } if ( qv ) { /* quoted versions always become full version objects */ I32 len = av_len((AV *)sv); - for ( len = 2 - len; len != 0; len-- ) + for ( len = 2 - len; len > 0; len-- ) av_push((AV *)sv, newSViv(0)); } return s; Modified: trunk/orca/packages/version-0.41/version.xs ============================================================================== --- trunk/orca/packages/version-0.39/version.xs (original) +++ trunk/orca/packages/version-0.41/version.xs Tue Jul 13 21:59:56 2004 @@ -228,7 +228,7 @@ vnumify(req),vnormal(req),vnumify(sv),vnormal(sv)); } - if ( sv_derived_from(sv, "version") ) + if ( SvOK(sv) && sv_derived_from(sv, "version") ) PUSHs(vnumify(sv)); else PUSHs(sv); From blair at orcaware.com Sun Jul 18 12:58:47 2004 From: blair at orcaware.com (Blair Zajac) Date: Sun, 18 Jul 2004 12:58:47 -0700 Subject: [Orca-checkins] r376 - trunk/orca/data_gatherers/orcallator Message-ID: <200407181958.i6IJwl3c013580@orcaware.com> Author: blair Date: Sun Jul 18 12:48:01 2004 New Revision: 376 Modified: trunk/orca/data_gatherers/orcallator/orcallator.se Log: * data_gatherers/orcallator/orcallator.se (orca_sleep_till) Fix a bug where if the current Unix epoch time in seconds is greater than the time to sleep to (because the scheduler puts orcallator.se to sleep for too long), the function would calculate a negative time to sleep which when cast to an unsigned long becomes a very large value. Change the variable holding the amount of time to sleep from an unsigned long to a signed long. Patch from John Garner . Modified: trunk/orca/data_gatherers/orcallator/orcallator.se ============================================================================== --- trunk/orca/data_gatherers/orcallator/orcallator.se (original) +++ trunk/orca/data_gatherers/orcallator/orcallator.se Sun Jul 18 12:48:01 2004 @@ -1204,7 +1204,7 @@ orca_sleep_till(long sleep_till) { timeval_t now[1]; - ulong time_to_sleep; + long time_to_sleep; gettimeofday(now, 0); time_to_sleep = sleep_till - now[0].tv_sec; From blair at orcaware.com Thu Jul 22 17:45:25 2004 From: blair at orcaware.com (Blair Zajac) Date: Thu, 22 Jul 2004 17:45:25 -0700 Subject: [Orca-checkins] r377 - trunk/orca/lib Message-ID: <200407230045.i6N0jPaD013992@orcaware.com> Author: blair Date: Thu Jul 22 17:40:35 2004 New Revision: 377 Modified: trunk/orca/lib/Makefile.in Log: * lib/Makefile.in: Instead of using hard coded paths to /opt/i386-linux/perl/bin/perl use @PERL at . Bug noticed by Jon Tankersley . Modified: trunk/orca/lib/Makefile.in ============================================================================== --- trunk/orca/lib/Makefile.in (original) +++ trunk/orca/lib/Makefile.in Thu Jul 22 17:40:35 2004 @@ -54,10 +54,10 @@ if test "$$current_rev" != "" && \ test "$$current_rev" != "exported"; then \ echo "Found good svnversion for `cd ..; pwd`: $$current_rev"; \ - echo /opt/i386-linux/perl/bin/perl -w -p -i \ + echo @PERL@ -w -p -i \ -e 's/^(\$$ORCA_VER_REVISION\s*=\s*).*/$${1}"'$$current_rev'";/' \ $(libdir)/Orca/Constants.pm; \ - /opt/i386-linux/perl/bin/perl -w -p -i \ + @PERL@ -w -p -i \ -e 's/^(\$$ORCA_VER_REVISION\s*=\s*).*/$${1}"'$$current_rev'";/' \ $(libdir)/Orca/Constants.pm; \ fi From blair at orcaware.com Thu Jul 22 18:11:34 2004 From: blair at orcaware.com (Blair Zajac) Date: Thu, 22 Jul 2004 18:11:34 -0700 Subject: [Orca-checkins] r378 - trunk/orca/lib Message-ID: <200407230111.i6N1BY9J016641@orcaware.com> Author: blair Date: Thu Jul 22 17:58:49 2004 New Revision: 378 Modified: trunk/orca/lib/Makefile.in Log: * lib/Makefile.in Instead of using @PERL@ throughout the file, set $(PERL) to @PERL@ and use $(PERL) instead so that $(PERL) can be changed once at the top of the Makefile. In the install rule, print the command line of svnversion being run, because it may take a while and the user should not have to wonder what it taking the make install to finish. Modified: trunk/orca/lib/Makefile.in ============================================================================== --- trunk/orca/lib/Makefile.in (original) +++ trunk/orca/lib/Makefile.in Thu Jul 22 17:58:49 2004 @@ -5,6 +5,7 @@ libdir = @libdir@ INSTALL = @INSTALL@ MKDIR = @MKDIR@ +PERL = @PERL@ all: Makefile \ orca_logo.gif.hex \ @@ -14,17 +15,17 @@ # Create a hex file representation of orca_logo.gif that can be stored # inside orca.pl. orca_logo.gif.hex: orca_logo.gif - perl -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ + $(PERL) -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ # Create a hex file representation of rrdtool_logo.gif that can be # stored inside orca.pl. rrdtool_logo.gif.hex: rrdtool_logo.gif - perl -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ + $(PERL) -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ # Create a hex file representation of rothschild_image_logo.png that # can be stored inside orca.pl. rothschild_image_logo.png.hex: rothschild_image_logo.png - perl -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ + $(PERL) -e 'while (sysread(STDIN, $$b, 35)){print unpack("h*", $$b),"\n"}' < $< > $@ install: all $(MKDIR) $(libdir)/Orca @@ -50,14 +51,15 @@ $(INSTALL) -m 0644 $$f $(libdir)/$$d; \ done \ done + @echo 'cd ..; svnversion . 2>/dev/null' @current_rev="`cd ..; svnversion . 2>/dev/null`"; \ if test "$$current_rev" != "" && \ test "$$current_rev" != "exported"; then \ echo "Found good svnversion for `cd ..; pwd`: $$current_rev"; \ - echo @PERL@ -w -p -i \ + echo $(PERL) -w -p -i \ -e 's/^(\$$ORCA_VER_REVISION\s*=\s*).*/$${1}"'$$current_rev'";/' \ $(libdir)/Orca/Constants.pm; \ - @PERL@ -w -p -i \ + $(PERL) -w -p -i \ -e 's/^(\$$ORCA_VER_REVISION\s*=\s*).*/$${1}"'$$current_rev'";/' \ $(libdir)/Orca/Constants.pm; \ fi From blair at orcaware.com Wed Jul 28 22:48:41 2004 From: blair at orcaware.com (Blair Zajac) Date: Wed, 28 Jul 2004 22:48:41 -0700 Subject: [Orca-checkins] r379 - in trunk/orca/data_gatherers: aix hp orca_services orcallator procallator winallator Message-ID: <200407290548.i6T5mfW7020539@gw.orcaware.com> Author: blair Date: Wed Jul 28 22:46:43 2004 New Revision: 379 Modified: trunk/orca/data_gatherers/aix/Makefile.in trunk/orca/data_gatherers/hp/Makefile.in trunk/orca/data_gatherers/orca_services/Makefile.in trunk/orca/data_gatherers/orcallator/Makefile.in trunk/orca/data_gatherers/procallator/Makefile.in trunk/orca/data_gatherers/winallator/Makefile.in Log: Some shells invoked by make cannot handle the case when there are no elements in a for loop, i.e. for f in; do. Bug noted by Jon Tankersley . * data_gatherers/aix/Makefile.in (install), * data_gatherers/hp/Makefile.in (install), * data_gatherers/orcallator/Makefile.in (install), * data_gatherers/orca_services/Makefile.in (install), * data_gatherers/procallator/Makefile.in (install), * data_gatherers/winallator/Makefile.in (install): Before using a make variable in a for loop, test that it has non-zero length. Modified: trunk/orca/data_gatherers/aix/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/aix/Makefile.in (original) +++ trunk/orca/data_gatherers/aix/Makefile.in Wed Jul 28 22:46:43 2004 @@ -35,10 +35,12 @@ install: all $(MKDIR) $(bindir) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi clean: $(RM) $(TARGETS) Modified: trunk/orca/data_gatherers/hp/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/hp/Makefile.in (original) +++ trunk/orca/data_gatherers/hp/Makefile.in Wed Jul 28 22:46:43 2004 @@ -35,10 +35,12 @@ install: all $(MKDIR) $(bindir) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi clean: $(RM) $(TARGETS) Modified: trunk/orca/data_gatherers/orca_services/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/orca_services/Makefile.in (original) +++ trunk/orca/data_gatherers/orca_services/Makefile.in Wed Jul 28 22:46:43 2004 @@ -47,14 +47,18 @@ $(MKDIR) $(sysconfdir) $(MKDIR) $(RAW_ORCA_SERVICES_DIR) $(MKDIR) $(RRD_ORCA_SERVICES_DIR) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done - @for file in $(LIBEXEC_TARGETS); do \ - echo $(INSTALL) $$file $(libexecdir); \ - $(INSTALL) $$file $(libexecdir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi + @if test "$(LIBEXEC_TARGETS)"; then \ + for file in $(LIBEXEC_TARGETS); do \ + echo $(INSTALL) $$file $(libexecdir); \ + $(INSTALL) $$file $(libexecdir); \ + done; \ + fi @if test -r $(sysconfdir)/orca_services.cfg; then \ date="`date +%Y-%m-%d-%H:%M:%S`"; \ echo $(INSTALL) -m 0644 orca_services.cfg $(sysconfdir)/orca_services.cfg.$$date; \ Modified: trunk/orca/data_gatherers/orcallator/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/orcallator/Makefile.in (original) +++ trunk/orca/data_gatherers/orcallator/Makefile.in Wed Jul 28 22:46:43 2004 @@ -48,10 +48,12 @@ $(MKDIR) $(sysconfdir) $(MKDIR) $(RAW_ORCALLATOR_DIR) $(MKDIR) $(RRD_ORCALLATOR_DIR) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi $(INSTALL) -m 0644 orcallator.se $(libdir) @if test -r $(sysconfdir)/orcallator.cfg; then \ date="`date +%Y-%m-%d-%H:%M:%S`"; \ Modified: trunk/orca/data_gatherers/procallator/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/procallator/Makefile.in (original) +++ trunk/orca/data_gatherers/procallator/Makefile.in Wed Jul 28 22:46:43 2004 @@ -44,10 +44,12 @@ $(MKDIR) $(bindir) $(MKDIR) $(RAW_PROCALLATOR_DIR) $(MKDIR) $(RRD_PROCALLATOR_DIR) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi @if test -r $(sysconfdir)/procallator.cfg; then \ date="`date +%Y-%m-%d-%H:%M:%S`"; \ echo $(INSTALL) -m 0644 procallator.cfg $(sysconfdir)/procallator.cfg.$$date; \ Modified: trunk/orca/data_gatherers/winallator/Makefile.in ============================================================================== --- trunk/orca/data_gatherers/winallator/Makefile.in (original) +++ trunk/orca/data_gatherers/winallator/Makefile.in Wed Jul 28 22:46:43 2004 @@ -42,10 +42,12 @@ $(MKDIR) $(sysconfdir) $(MKDIR) $(RAW_WINALLATOR_DIR) $(MKDIR) $(RRD_WINALLATOR_DIR) - @for file in $(BIN_TARGETS); do \ - echo $(INSTALL) $$file $(bindir); \ - $(INSTALL) $$file $(bindir); \ - done + @if test "$(BIN_TARGETS)"; then \ + for file in $(BIN_TARGETS); do \ + echo $(INSTALL) $$file $(bindir); \ + $(INSTALL) $$file $(bindir); \ + done; \ + fi @if test -r $(sysconfdir)/winallator.cfg; then \ date="`date +%Y-%m-%d-%H:%M:%S`"; \ echo $(INSTALL) -m 0644 winallator.cfg $(sysconfdir)/winallator.cfg.$$date; \