Skip to content

Commit

Permalink
zap string-evals
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2
mohawk2 committed Mar 27, 2024
1 parent e7586ff commit 6b6a916
Show file tree
Hide file tree
Showing 6 changed files with 54 additions and 55 deletions.
20 changes: 10 additions & 10 deletions lib/PDL/Graphics/Simple.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -278,7 +278,9 @@ our $global_plot = undef;
# Attempt to load some default modules

for my $submod(qw/ PGPLOT Gnuplot PLplot Prima /) {
eval "use PDL::Graphics::Simple::$submod;";
my $module = "PDL::Graphics::Simple::$submod";
(my $file = $module) =~ s/::/\//g;
eval { require "$file.pm"; $module->import; };
}

=head2 show
Expand Down Expand Up @@ -416,9 +418,8 @@ sub new {

attempt: for my $engine( @try ) {
print "Trying $engine ($mods->{$engine}->{engine})...";
my $a;
my $s;
eval "\$a = $mods->{$engine}->{module}::check()";
my $a = eval { $mods->{$engine}{module}->can('check')->() };
if($@) {
chomp $@;
$s = "$@";
Expand Down Expand Up @@ -484,7 +485,7 @@ sub new {

my $submod= $mods->{$engine}->{module};
my $params = { size=>$size, type=>$type, output=>$output, multi=>$opt->{multi} };
my $obj = eval "$mods->{$engine}->{module}->new(\$params)";
my $obj = $mods->{$engine}->{module}->new($params);
my $me = { engine=>$engine, params=>$params, obj=>$obj };
return bless($me,$pkg);
}
Expand Down Expand Up @@ -1381,14 +1382,13 @@ same as C<$PDL::Graphics::Simple::VERSION>.
sub register {
my $module = shift;

my $modname = "\$${module}::mod";
barf "PDL::Graphics::Simple::register: tried to register $module \n\t...but $modname wasn't defined.\n"
unless (eval qq{defined($modname) and ref($modname) eq 'HASH';});

my $mod = eval $modname;
no strict 'refs';
my $mod = ${"${module}::mod"};
barf "PDL::Graphics::Simple::register: tried to register $module\n\t...but $module\::mod wasn't defined.\n"
unless defined($mod) and ref($mod) eq 'HASH';;

for(qw/shortname module engine synopsis pgs_version/) {
barf "PDL::Graphics::Simple::register: $modname looks fishy; I give up\n"
barf "PDL::Graphics::Simple::register: $module\::mod looks fishy; I give up\n"
unless( defined($mod->{$_}));
}

Expand Down
7 changes: 3 additions & 4 deletions lib/PDL/Graphics/Simple/Gnuplot.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,8 +58,8 @@ sub check {
# Eval PDL::Graphics::Gnuplot. Require relatively recent version.
# We don't specify the version in the 'use', so we can issue a
# warning on an older version.
eval 'use PDL::Graphics::Gnuplot;';
if($@) {
eval { require PDL::Graphics::Gnuplot; PDL::Graphics::Gnuplot->import; };
if ($@) {
$mod->{ok} = 0;
$mod->{msg} = $@;
return 0;
Expand All @@ -73,8 +73,7 @@ sub check {
return 0;
}

my $gpw;
eval '$gpw = gpwin();';
my $gpw = eval { gpwin() };
if($@) {
$mod->{ok} = 0;
$mod->{msg} = $@;
Expand Down
4 changes: 2 additions & 2 deletions lib/PDL/Graphics/Simple/PGPLOT.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ sub check {
my $force = shift;
$force = 0 unless(defined($force));
return $mod->{ok} unless( $force or !defined($mod->{ok}) );
eval 'use PDL::Graphics::PGPLOT::Window;';
eval { require PDL::Graphics::PGPLOT::Window; PDL::Graphics::PGPLOT::Window->import; };
if ($@) {
$mod->{ok} = 0;
$mod->{msg} = $@;
Expand Down Expand Up @@ -372,7 +372,7 @@ sub DESTROY {
$me->{obj}->release;

if($me->{type} =~ m/^f/i) {
eval q{ $me->{obj}->close; };
eval { $me->{obj}->close; };

my $file = ( ($me->{conv_fn}) ? $me->{conv_fn} : $me->{output} );
if($me->{conv_fn}) {
Expand Down
4 changes: 1 addition & 3 deletions lib/PDL/Graphics/Simple/PLplot.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,6 @@ use Time::HiRes qw/usleep/;
use PDL::Options q/iparse/;
use PDL;

eval 'use PDL::Graphics::PLplot';

our $mod = {
shortname => 'plplot',
module=>'PDL::Graphics::Simple::PLplot',
Expand Down Expand Up @@ -50,7 +48,7 @@ sub check {

return $mod->{ok} unless( $force or !defined($mod->{ok}) );

eval 'use PDL::Graphics::PLplot';
eval { require PDL::Graphics::PLplot; PDL::Graphics::PLplot->import };
if($@) {
$mod->{ok} = 0;
$mod->{msg} = $@;
Expand Down
52 changes: 27 additions & 25 deletions lib/PDL/Graphics/Simple/Prima.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,8 @@ our $mod = {
eval { require PDL::Graphics::Prima; 1 } and
PDL::Graphics::Simple::register('PDL::Graphics::Simple::Prima');

our (@colors, @patterns);

##########
# PDL::Graphics::Simple::Prima::check
# Checker
Expand Down Expand Up @@ -81,13 +83,23 @@ sub check {
require Prima::Buttons;
require Prima::Utils;
require Prima::Edit;
require Prima::Const;
};
if($@){
$mod->{msg} = "Couldn't load auxiliary Prima modules: ".$@;
undef $@;
return 0;
}

@colors = (
cl::Black(), cl::Red(), cl::Green(), cl::Blue(), cl::Cyan(),
cl::Magenta(), cl::Yellow(), cl::Brown(),
cl::LightRed(), cl::LightGreen(), cl::LightBlue(), cl::Gray(),
);
@patterns = (
lp::Solid(), lp::Dash(), lp::LongDash(), lp::ShortDash(), lp::DotDot(),
lp::DashDot(), lp::DashDotDot(),
);

$mod->{ok} =1;
return 1;
}
Expand Down Expand Up @@ -154,7 +166,7 @@ sub DESTROY {
# Save plot to file

if($me->{widgets}->[0]) {
eval q{$me->{widgets}->[0]->save_to_file($me->{output})};
eval {$me->{widgets}->[0]->save_to_file($me->{output})};
if($@) {
print $@;
undef $@;
Expand Down Expand Up @@ -196,7 +208,7 @@ sub DESTROY {
my $tile;

if($widget_dex < @{$me->{widgets}}) {
eval q{ $me->{widgets}->[$widget_dex++]->save_to_file($tmpfile) };
eval { $me->{widgets}->[$widget_dex++]->save_to_file($tmpfile) };
last ROW if($@);
$tile = rim($tmpfile);
$ztile = zeroes($tile)+255;
Expand Down Expand Up @@ -229,20 +241,10 @@ sub DESTROY {
}
}



$me->{obj}->hide;
$me->{obj}->destroy;
}


our @colors =qw/
cl::Black cl::Red cl::Green cl::Blue cl::Cyan cl::Magenta cl::Yellow cl::Brown cl::LighttRed cl::LightGreen cl::LightBlue cl::Gray/;

our @patterns = qw/
lp::Solid lp::Dash lp::LongDash lp::ShortDash lp::DotDot lp::DashDot lp::DashDotDot/;


##############################
# Fake-o apply method makes sepiatone values for input data.
# We have to mock up an object method to match the style of PDL::Graphics::Prima::Palette,
Expand Down Expand Up @@ -278,7 +280,7 @@ sub PDL::Graphics::Simple::Prima::Sepia_Palette::apply {
our $types = {
lines => q{ppair::Lines},

points => [ map { 'ppair::'.$_ } qw/Blobs Triangles Squares Crosses Xs Asterisks/ ],
points => [ map { ppair->can($_)->() } qw/Blobs Triangles Squares Crosses Xs Asterisks/ ],

bins => sub {
my ($me, $plot, $block, $cprops) = @_;
Expand All @@ -291,7 +293,7 @@ our $types = {
my $newy = $y->dummy(0,2)->clump(2)->sever;

$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } =
ds::Pair($newx,$newy,plotType=>eval q{ppair::Lines}, @$cprops);
ds::Pair($newx,$newy,plotType=>ppair::Lines(), @$cprops);
},


Expand Down Expand Up @@ -336,7 +338,7 @@ our $types = {
my $dx = ($data->[0]->flat->dummy(0,1) + $dr->dummy(0,1)*$cstash->{c})->flat;
my $dy = ($data->[1]->flat->dummy(0,1) + $dr->dummy(0,1)*$cstash->{s})->flat;
$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } =
ds::Pair( $dx, $dy, plotType=>eval q{ppair::Lines}, @$cprops);
ds::Pair( $dx, $dy, plotType=>ppair::Lines(), @$cprops);
},


Expand Down Expand Up @@ -365,7 +367,7 @@ our $types = {

$plot->dataSets()->{1+keys(%{$plot->dataSets()})} =
ds::Note(
map { eval q{pnote::Text($labels[$_],x=>$x->slice("($_)"),y=>$y->slice("($_)"))}; } (0..$#labels)
map { pnote::Text($labels[$_],x=>$x->slice("($_)"),y=>$y->slice("($_)")); } (0..$#labels)
);
}
};
Expand All @@ -389,9 +391,9 @@ $types->{limitbars} = sub {
my $xdraw = pdl($xlo,$xhi,$x, $x, $xlo,$xhi,$nan)->mv(1,0)->flat;
my $ydraw = pdl($ylo,$ylo,$ylo,$yhi,$yhi,$yhi,$nan)->mv(1,0)->flat;
$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } =
ds::Pair($xdraw,$ydraw,plotType=>eval q{ppair::Lines}, @$cprops);
ds::Pair($xdraw,$ydraw,plotType=>ppair::Lines(), @$cprops);
$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } =
ds::Pair($x,$y,plotType=>eval ($types->{points}->[ ($me->{curvestyle}-1) %(0+@{$types->{points}}) ]), @$cprops);
ds::Pair($x,$y,plotType=>$types->{points}->[ ($me->{curvestyle}-1) %(0+@{$types->{points}}) ], @$cprops);
};


Expand Down Expand Up @@ -469,8 +471,8 @@ sub plot {
$plot->x->label( $ipo->{xlabel} ) if(defined($ipo->{xlabel}));
$plot->y->label( $ipo->{ylabel} ) if(defined($ipo->{ylabel}));

$plot->x->scaling(eval q{sc::Log}) if($ipo->{logaxis}=~ m/x/i);
$plot->y->scaling(eval q{sc::Log}) if($ipo->{logaxis}=~ m/y/i);
$plot->x->scaling(sc::Log()) if($ipo->{logaxis}=~ m/x/i);
$plot->y->scaling(sc::Log()) if($ipo->{logaxis}=~ m/y/i);

$plot->x->min($ipo->{xrange}->[0]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}->[0]));
$plot->x->max($ipo->{xrange}->[1]) if(defined($ipo->{xrange}) and defined($ipo->{xrange}->[1]));
Expand Down Expand Up @@ -529,8 +531,8 @@ sub plot {
}

my $cprops = [
color => eval $colors[ ($me->{curvestyle}-1) % @colors ],
linePattern => eval $patterns[ ($me->{curvestyle}-1) % @patterns ],
color => $colors[ ($me->{curvestyle}-1) % @colors ],
linePattern => $patterns[ ($me->{curvestyle}-1) % @patterns ],
lineWidth => $co->{width} || 1
];

Expand All @@ -540,11 +542,11 @@ sub plot {
} else {
my $pt;
if(ref($type) eq 'ARRAY') {
$pt = eval sprintf("%s",$type->[ ($me->{curvestyle}-1) % (0+@{$type}) ] );
$pt = $type->[ ($me->{curvestyle}-1) % (0+@{$type}) ];
} elsif(!defined($type)) {
die "$co->{with} is not yet implemented in PDL::Graphics::Simple for Prima.\n";
} else {
$pt = eval qq{$type};
$pt = eval $type;
}

$plot->dataSets()->{ 1+keys(%{$plot->dataSets()}) } = ds::Pair(@$block, plotType => $pt, @$cprops);
Expand Down
22 changes: 11 additions & 11 deletions t/simple.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,18 +21,18 @@ sub ask_yn {
##############################
# Try the simple engine and convenience interfaces...

eval q: $a = xvals(50); lines $a sin($a/3) :;
eval { $a = xvals(50); lines $a sin($a/3) };
plan skip_all => 'No plotting engines installed' if $@ =~ /Sorry, all known/;
is($@, '', "simple lines plot succeeded");
ok( defined($PDL::Graphics::Simple::global_object), "Global convenience object got spontaneously set" );
ask_yn q{ test> $a = xvals(50); lines $a sin($a/3);
You should see a sine wave...}, "convenience plot OK";

eval q: erase :;
eval { erase };
is($@, '', 'erase worked');
ok(!defined($PDL::Graphics::Simple::global_object), 'erase erased the global object');

eval "PDL::Graphics::Simple::show();";
eval { PDL::Graphics::Simple::show() };
is($@, '');

my $mods = do { no warnings 'once'; $PDL::Graphics::Simple::mods };
Expand All @@ -44,17 +44,17 @@ for my $engine (@engines) {
my $w;

my $module;
next if !$mods->{$engine}; # if didn't register, skip
diag("skipping $engine"), next if !$mods->{$engine}; # if didn't register
ok( ( ref($mods->{$engine}) eq 'HASH' and ($module = $mods->{$engine}->{module}) ),
"there is a modules entry for $engine ($module)" );

SKIP: {
my($check_ok);
eval qq{\$check_ok = ${module}::check(1)};
my $check_ok = eval {${module}->can('check')->(1)};
is($@, '', "${module}::check() ran OK");

unless($check_ok) {
eval qq{diag "Skipping $module: \$${module}::mod->{msg}"};
no strict 'refs';
diag qq{Skipping $module: ${"${module}::mod"}->{msg}};
skip "Skipping tests for engine $engine (not working)", $tests_per_engine - 2;
}
$pgplot_ran ||= $engine eq 'pgplot';
Expand Down Expand Up @@ -159,28 +159,28 @@ panels should have colorbar wedges to the right of the image.}, "multiplot OK";
# Test imag
my $im = 1000 * sin(rvals(100,100)/3) / (rvals(100,100)+30);

eval q{ imag $im };
eval { imag $im };
is($@, '', "imag worked with no additional arguments" );
ask_yn q{ test> $im = 1000 * sin(rvals(100,100)/3) / (rvals(100,100)+30);
test> imag $im;
You should see a bullseye pattern with a brighter inner ring.}, "bullseye OK";

eval q{ imag $im, {wedge=>1, title=>"Bullseye!"} };
eval { imag $im, {wedge=>1, title=>"Bullseye!"} };
is($@, '', "imag worked with plot options");
ask_yn q{ test> imag $im, {wedge=>1, title=>"Bullseye!", j=>1};
You should see the same image, but with a colorbar wedge on the right; a title
up top; and a justified aspect ratio (circular rings). The color scale may be
slightly less contrasty than the last frame, because some engines extend the
colorbar wedge to round numbers.}, "justified bullseye and wedge OK";

eval q{ imag $im, 0, 30, {wedge=>1, j=>1} };
eval { imag $im, 0, 30, {wedge=>1, j=>1} };
is($@, '', "imag worked with bounds");
ask_yn q{ test> imag $im, 0, 30, {wedge=>1, j=>1};
You should see the same image, but with no title and with a tighter
dynamic range that cuts off the low values (black rings instead of
the fainter parts of the bullseye).}, "crange shortcut is OK";

eval q{ erase };
eval { erase };
is($@, '', "erase executed");
my $extra = $pgplot_ran ? ' (for PGPLOT on X you need to close the X window to continue)' : '';
ask_yn qq{ test> erase
Expand Down

0 comments on commit 6b6a916

Please sign in to comment.