182 lines
4.4 KiB
Perl
182 lines
4.4 KiB
Perl
#!/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
|
|
|