diff --git a/sbin/classLoadTest.pl b/sbin/classLoadTest.pl new file mode 100644 index 000000000..53d9ff9f7 --- /dev/null +++ b/sbin/classLoadTest.pl @@ -0,0 +1,182 @@ +#!/usr/bin/env perl + +#------------------------------------------------------------------- +# WebGUI is Copyright 2001-2009 Plain Black Corporation. +#------------------------------------------------------------------- +# Please read the legal notices (docs/legal.txt) and the license +# (docs/license.txt) that came with this distribution before using +# this software. +#------------------------------------------------------------------- +# http://www.plainblack.com info@plainblack.com +#------------------------------------------------------------------- +use strict; +use File::Basename (); +use File::Spec; + +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); +} + +$|++; # disable output buffering + +our ($configFile, $help, $man, $class); +use Pod::Usage; +use Getopt::Long; +use WebGUI::Session; + +# Get parameters here, including $help +GetOptions( + 'configFile=s' => \$configFile, + 'help' => \$help, + 'man' => \$man, + 'class=s' => \$class, +); + +pod2usage( verbose => 1 ) if $help; +pod2usage( verbose => 2 ) if $man; +pod2usage( msg => "Must specify a config file!" ) unless $configFile; + +foreach my $libDir ( readLines( "preload.custom" ) ) { + if ( !-d $libDir ) { + warn "WARNING: Not adding lib directory '$libDir' from preload.custom: Directory does not exist.\n"; + next; + } + unshift @INC, $libDir; +} + +my $session = start( $webguiRoot, $configFile ); + +open(my $null, ">:utf8","/dev/null"); +$session->output->setHandle($null); + +printf "%22s\t\%18s\t%12s\t%s\n", 'Asset ID', 'Instanciate Time', 'Render Time','URL'; + +my $count = 0; +my $sth = $session->db->read("select assetId from asset where className=? and state='published'",[$class]); +while (my ($id) = $sth->array) { + $count++; + print $id; + + # check instanciation time + my $t = [Time::HiRes::gettimeofday]; + my $asset = eval { WebGUI::Asset->new($session, $id, $class)}; + if (!defined $asset || $@) { + my $url = $session->db->quickScalar("select url from assetData where assetId=? order by revisionDate desc",[$id]); + print "\tbad asset: $@ \t url: $url \n"; + next; + } + my $instanciation = Time::HiRes::tv_interval($t); + + # set the default asset for those things that need it + $session->asset($asset); + + # check render time + $t = [Time::HiRes::gettimeofday]; + eval {my $junk = $asset->www_view}; + my $rendering = Time::HiRes::tv_interval($t); + if ($@) { + $rendering = $@; + } + + # get the url + my $url = $asset->getValue("url"); + + # output the results + printf "\t%18.4f\t%12.4f\t%s\n", $instanciation, $rendering ,$url; +} + +close($null); + +print "Total assets: $count\n"; + + +finish($session); + + +#---------------------------------------------------------------------------- +sub start { + my $webguiRoot = shift; + my $configFile = shift; + my $session = WebGUI::Session->open($webguiRoot,$configFile); + $session->user({userId=>3}); + + return $session; +} + +#---------------------------------------------------------------------------- +sub finish { + my $session = shift; + + $session->var->end; + $session->close; +} + +#------------------------------------------------- +sub readLines { + my $file = shift; + my @lines; + if (open(my $fh, '<', $file)) { + while (my $line = <$fh>) { + $line =~ s/#.*//; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + next if !$line; + push @lines, $line; + } + close $fh; + } + return @lines; +} + +__END__ + +=head1 NAME + +classLoadTest.pl -- Test a single class performance + +=head1 SYNOPSIS + + classLoadTest.pl --configFile config.conf --class=<> + + classLoadTest.pl --help + +=head1 DESCRIPTION + +This script will test the time it takes to instanciate and view all the +assets of a particular class from the given site. + +=head1 OPTIONS + +=over + +=item B<--configFile config.conf> + +The WebGUI config file to use. Only the file name needs to be specified, +since it will be looked up inside WebGUI's configuration directory. +This parameter is required. + +=item B<--class> + +The full class name of the asset to test. Something like WebGUI::Asset::Wobject::Layout +or WebGUI::Asset::Wobject::Navigation. + +=item B<--help> + +Shows a short summary and usage + +=item B<--man> + +Shows this document + +=back + +=head1 AUTHOR + +Copyright 2001-2009 Plain Black Corporation. + +=cut + +#vim:ft=perl +