Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#!/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;
use Devel::Gladiator qw( walk_arena arena_table );
use Devel::Size qw( total_size );
# 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 %18s %12s %8s %8s %s'."\n", 'Asset ID', 'Instanciate Time', 'Render Time', "M Inst", "M View", 'URL';
my $count = 0;
my @assetIds = $session->db->buildArray("select assetId from asset where className=? and state='published'",[$class]);
close($null);
finish( $session );
my $memory_used_inst = 0;
my $memory_used_view = 0;
#my $memory_size = total_size( walk_arena );
for my $id ( @assetIds ) {
# Fork to preserve memory usage of parent process
if ( fork ) { wait } else {
my $session = start( $webguiRoot, $configFile );
open(my $null, ">:utf8","/dev/null");
$session->output->setHandle($null);
#my $memory_used_begin = $memory_size;
$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);
#$memory_size = total_size( walk_arena );
$memory_used_inst = total_size( $session ) + total_size( $asset );
# 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 = $@;
}
#$memory_size = total_size( walk_arena );
$memory_used_view = total_size( $session ) + total_size( $asset );
# get the url
my $url = $asset->getValue("url");
# output the results
printf " %18.4f %12.4f %8i %8i %s\n", $instanciation, $rendering , $memory_used_inst, $memory_used_view, $url;
close($null);
finish($session);
exit;
}
}
print arena_table;
#----------------------------------------------------------------------------
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.