I created this function.
When I print my variable my $bios_current, it shows $VAR1 = '200';
But my condition if ( $bios_current->responseCode() ne 200) considers that it is not 200.
Could you help me ? Is it a type problem ?
sub check_thermalshutdown_settings {
my $host = shift;
if ($host->get_property('summary.hardware.model') eq "ProLiant DL360 Gen9") {
my $error="";
my $bios="";
try {
my $ilo = get_ilo_address($host->name);
my $client = REST::Client->new();
$client->setHost("https://$ilo");
$client->addHeader("Authorization", "Basic blabla==");
eval {
local $SIG{ALRM} = sub { };
alarm 3;
#$client->GET("/redfish/v1/Systems/1/Bios/");
my $bios_current = $client->GET("/redfish/v1/Systems/1/Bios/");
print Dumper $bios_current->responseCode;
alarm 0;
};
if ( $bios_current->responseCode() ne 200) {
$bios = "none";
$error = "Redfish API returned code ".$client->responseCode();
print Dumper $client->responseCode();
} else {
my $json = decode_json($client->responseContent());
#print Dumper $client->responseContent();
#$bios = $json->{'Bios'}->{'Settings'}->{'ThermalShutdown'};
$bios = $json->{'ThermalShutdown'};
#print Dumper $bios;
print Dumper $json->{'ThermalShutdown'};
print "API call is ok\n";
print Dumper $client->setHost("https://$ilo");
}
} catch {
$bios = "none";
$error=$_;
};
You problem has nothing to do with type.
The first thing every Perl coder should learn is the following two statements should appear at the top of every script.
use strict;
use warnings;
These two statements catch a multitude of errors one of which is the cause of your problem.
If you take a look at your eval block
eval {
local $SIG{ALRM} = sub { };
alarm 3;
#$client->GET("/redfish/v1/Systems/1/Bios/");
my $bios_current = $client->GET("/redfish/v1/Systems/1/Bios/");
print Dumper $bios_current->responseCode;
alarm 0;
};
You will see that the variable $bios_current is introduced with the my modifier this restricts the lifetime of the variable to the current scope, in this case the eval block.
So by the time your if statement is run the variable no longer exists and Perl helpfully creates a new empty one for you, Perl then tries to call responseCode() on the empty variable, this fails and normally would terminate the program, however you are inside a try() block at this point so instead of displaying the error the code jumps to the catch bloc instead.
Is it possible in Perl to use a function's return value as the expression in an "if" statement? For example; in C I can write
if (!myFunction()){
printf("myFunction returned false.\n");
} else {
printf("myFunction returned true\n");
}
But in perl I find I must go through the pain of ..
$ret = myFunction();
if (!$ret){
print "myFunction returned false.\n";
}
I know as soon as I post this someone will redirect me to several other posts of this question. But, obviously, I could not find what I'm looking for or I would not write this!
So spare me the "have you tried searching for ...." messages!
Here is what myFunction() looks like.
sub myFunction
{
my ($run, $runTime) = #_;
my ($code);
eval {
$SIG{ALRM} = sub {die "Operation Timed Out";};
alarm($run_time);
$EXIT_STR = `$run`; # Execute $run and save output in EXIT_STR
$code = $?; # Save cmd exit code.
$EXIT_CODE = $code; # Set a global value (EXIT_CODE)
alarm(0);
return($code);
};
if ($#) {
if ($# =~ /Operation Timed Out/) {
print "Time out\n";
return(10);
}
}
}
After everyone's feedback I went back to the books to learn more about eval. After a bit of reading it was clearer that "eval" "returned" a value to the function it was part of. It was then up to me to decide what to do with the eval results. With that in mind I made some changes and the function works as I had hoped. Thanks to all!
Yup.
Wait. I can't give such a short answer...
Yes. If a function is inside an if statement, Perl will take the return value of the function as a boolean value. If the return value is zero, a blank string, a null value, a null string, or an undef, the if statement will be considered false. Otherwise, the if statement will be considered true.
Here's an easy to understand example:
if ( not is_odd( $number ) ) {
print "$number is divisible by two\n";
}
sub is_odd {
my $number = shift;
return $number % 2; # Modulo arithmetic
}
In the above $number % 2 will return zero on even numbers and one on odd numbers.
It's a good question. The best thing to do is to write a small script to try it out. Play around with it a bit:
For example. Let's add a second function we can use:
sub is_even {
my $number = shift;
return not is_odd( $number );
}
What does this return? How does this work in an if statement?
This will work fine.
The only caveat is that using it in an if-statement will provide scalar context to the return value so if something non-scalar is returned, it will get scalarized before the if condition is evaluated.
You may need to explicitly return a false value in cases where you don't want the function to return True. Remember that perl functions will return the last evaluated statement in the absence of a real return value. So, take this example:
#!/usr/bin/perl
use warnings;
use strict;
my $x = 4;
my $y = 1;
if ( ! myFunction($x,$y) ) {
print "myFunction returned false\n";
} else {
print "myFunction returned true\n";
}
sub myFunction {
my ($x,$y) = #_;
my $response;
if ( $x + $y == 2 ) {
$response = "fun";
} else {
$response = "no fun";
}
}
This will always print 'myFunction returned true' since either branch of the conditional is technically a true response. However, if you add a return value to the negative branch of the conditional, it will now work:
#!/usr/bin/perl
use warnings;
use strict;
my $x = 4;
my $y = 1;
if ( ! myFunction($x,$y) ) {
print "myFunction returned false\n";
} else {
print "myFunction returned true\n";
}
sub myFunction {
my ($x,$y) = #_;
my $response;
if ( $x + $y == 2 ) {
$response = "fun";
return 1; # technically not really needed
} else {
$response = "no fun";
return 0;
}
}
$ perl test_funct.pl
myFunction returned false
You're attempting to call return for your subroutine from inside an eval. This will not perform as you expect as explained in the docs for return:
return EXPR
return
Returns from a subroutine, eval, or do FILE with the value given in EXPR. ...
The bug you're facing can be demonstrated in the following example:
sub myFunction {
eval {
return "inside eval";
};
return "outside eval";
}
print myFunction();
Outputs:
outside eval
To fix your subroutine, assign your return value inside the eval, but actually return it from outside. Also, be sure to localize your alarm signal handler.
sub myFunction {
my ($run, $runTime) = #_;
my $code;
eval {
local $SIG{ALRM} = sub {die "Operation Timed Out";};
alarm($run_time);
$EXIT_STR = `$run`; # Execute $run and save output in EXIT_STR
alarm(0);
$code = $?; # Save cmd exit code.
};
if ($#) {
if ($# =~ /Operation Timed Out/) {
print "Time out\n";
$code = 10;
}
}
return $code;
}
Is there a way to determine all the dependencies of an .m file and any of the dependencies of the files it calls using a command in a script (command-line)?
There was a question like this before and it was really good because it suggested using the depfun function. BUT the issue with this was that it is outputting the MATLAB related files that it depends on as well.
EXAMPLE:
testing.m
disp('TESTING!!');
The output of depfun('testing')
'C:\testing.m'
'C:\MATLAB\R2008a\toolbox\matlab\datatypes\#opaque\char.m'
'C:\MATLAB\R2008a\toolbox\matlab\datatypes\#opaque\double.m'
'C:\MATLAB\R2008a\toolbox\matlab\datatypes\#opaque\toChar.m'
'C:\MATLAB\R2008a\toolbox\matlab\elfun\log10.m'
'C:\MATLAB\R2008a\toolbox\matlab\elmat\ans.m'
etc.
The list is a little bit longer.
The point here is that I was hoping there would be some similar function or a flag that would remove these unwanted dependencies.
Here are a couple of links I found helpful when I wrote up a simple function to create a table of contents for an m-file:
A thread discussing the undocumented function MLINTMEX
FDEP by Urs Schwarz on the MathWorks File Exchange
FARG by Urs Schwarz on the MathWorks File Exchange
EDIT: Since this problem piqued my curiosity, I started trying out a few ways I might approach it. Finding the dependencies on non-toolbox .m and .mex files was relatively trivial (I did this in MATLAB version 7.1.0.246):
fcnName = 'myfile.m';
fcnList = depfun(fcnName,'-quiet');
listIndex = strmatch('C:\Program Files\MATLAB71\toolbox',fcnList);
fcnList = fcnList(setdiff(1:numel(fcnList),listIndex));
Here, I just used DEPFUN to get the dependencies, then I removed any files that began with 'C:\Program Files\MATLAB71\toolbox', where the MATLAB toolboxes are located on my machine. Note that this assumes you aren't placing any of your own code in these MATLAB directories (which you shouldn't do anyway).
To get dependencies on .mat and .txt files, I took another approach. For each of the files you get from the above code, you could load the text of the file into MATLAB and parse it with a regular expression to find strings that end in a '.mat' or '.txt':
fid = fopen(fcnName,'rt');
fcnText = fscanf(fid,'%c');
fclose(fid);
expr = '[^\'']\''([^\''\n\r]+(?:\w\.(?:mat|txt)){1})\''[^\'']';
dataFiles = regexp(fcnText,expr,'tokens');
dataFiles = unique([dataFiles{:}]).';
There are a few limitations to the regular expression I used:
If you have a string like 'help.txt' that appears in a comment (such as the help comment block of a function), it will still be detected by the regular expression. I tried to get around this with a lookaround operator, but that took too long to run.
If you build a string from variables (like "fileString = [someString '.mat']"), it will not be detected by the regular expression.
The returned strings of file names will be relative path strings. In other words, if you have the strings 'help.txt' or 'C:\temp\junk.mat' in the function, the regular expression matching will return 'help.txt' or 'C:\temp\junk.mat', exactly as they appear in the function. To find the full path, you can use the WHICH function on each data file (assuming the files reside somewhere on the MATLAB path).
Hope you find these useful! =)
Try DepSubFun from TMW FileExchange.
Another way is just to exclude folders you don't need:
localdep = depfunresult(cellfun(#isempty,regexp(a,'toolbox')));
You can use any regexp pattern there.
Thank you for the responses so far.
I do not think that these are quite what I am looking to accomplish.
I was hoping there was already something that would determine local functions called within the main m-file, add them to the list, and proceed to look in each one until there are none left. It doesn't seem that any of these solutions do this
I have come up with a scheme that I will try to implement. It may be a bit brute force and the design might change as I work on it, but here is the concept.
There are quite a few assumptions made in this initial design but since it is mostly for me and a few others I don't think it will be a big issue for my general solution.
Files types to look for: .m .mat .mex* .txt (will be updated as needed)
Determine matlabpath and weed out toolbox paths (this is where it is an assumption your working directories are not called toolbox or that you don't have any special m-files you added to the other toolboxes)
hopefully leaving you only with directories you use and can call functions from. (also assumes you don't hardcode some type of [run 'C:\random\myscript.m']
brute force part:
look for the file types you are interested in and make a list of the ones in your working directory (pwd) and the remaining matlab paths
remove filenames that match one in the working directory.
iterate through searching the main m-file for each filename, if found add it to the array of dependent files. remove dependent files from the original list. search dependent files list with the "new" original list, repeat until no files left or no matches at all.
So far this is just the concept I have, I will also be searching a little more as well.
I got this script finally running today, it is a windows matlab based one as it makes a '!findstr "something" file.txt' call. (I would have preferred a grep but didn't know matlab equivalent.
I am going to ask my boss if I am allowed to post it on the matlab file exchange to share with others so hopefully I will update this soon with the link.
gnovice:
I don't have enough rep to comment on gnovice's comment of my description I wrote prior to writing the code.
But basically to determine which what it does is takes the filename of all files (broken into category of filetype), strips off the fullpathname and the extension, uses the above mentioned !findstr command to search it in the .m file that you are building the dependency for and outputs that to a temp.txt file (this is because I couldn't figure out a way to get a 1 or 0 or isempty return on the output of the command)
here is a breakdown of what I personally search for to determine if each file is used:
.m : 'filename ' or 'filename(' % covers the 'filename (' case
.mex* : same as above
.mat : was doing same as above but am going to change to some sort of load and the 'filename.mat' working on this probably tomorrow
.txt : simply searches for 'filename.txt'
With this method you may end up with a few extra text files or .m files but the key here is you should at least have all the files you need.
It also recursively calls itself on all the dependent files so that their dependencies are taken into account too.
-TaRDy
I wrote code a long time ago to do this for octave. I use it mainly to generate .dot files for graphviz to visualize the dependencies, but I also use it in makefiles for wrapping up dependencies when compiling code. it is perl code, unfortunately, but you can run it from a script by calling it via shell. it is fully recursive.
to run it, you'll have to change the OCT_BASE to point to the root directory of your code. (sorry, it is not matlab's path-variable aware). then I would probably run it as perl octavedepgrapher.pl -l
#! /bin/sh
exec perl -x -S $0 ${1+"$#"} # -*-perl-*-
#!perl
#
# octavedepgrapher.pl
# find the dependancy graph of octave file(s). prints a
# dot file suitable for graphviz
# Author: steven e. pav
# Created: 2006.07.16
# SVN: $Id$
#
# * Thu Aug 30 2007 Steven Pav
# - expanding to recognize matlabs pragma of %#function funcname
# version 0.3 2007.04.17
# add raw output mode.
# version 0.2 2007.03.05
# add media selection
# version 0.1 2006.08.24
# fixed multiple functions within file.
# added multiple edgeout capability.
# adding clusters for files.
# version 0.0 2006.07.16
# created.
#
#
########################################################################
########################################
# change only this
########################################
##OCT_BASE = qw(/home/spav/sys/octave/m/ ./ $ENV{OCTAVE});
#OCT_BASE = qw(/home/spav/sys/octave/m/ ./);
########################################################################
$VERSION = "octavedepgrapher version 0.02 2006.08.23\n";
########################################################################
use Getopt::Long;
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
%OPT_MEANINGS = (
'H' => 'show Help.',
'l' => 'list the dependencies to standard out. do not make a dot file.',
'p' => 'give full path names.',
'm' => 'multi-edge. one for each function call.',
'g' => 'map connections from functions to global variables.',
'G' => 'map connections between functions which share global variables.',
'C' => 'do not cluster files.',
'D' => 'Debug.',
'd=s' => 'dependency mode for makefiles. sets -p and -l, and but outputs in makefile suitable format. the string is the extension (with dot) to substitute for .m',
'r=s' => 'aspect ratio (can be fill, auto, compact (default))',
'B=s' => 'base directory. if given, all directories are assumed relative to this one.',
'L=s' => 'colon separated list of base directories of libraries (_overrides_ OCT_BASE). should probably include ./',
'l=s' => 'colon separated list of base directories of libraries (in addition to OCT_BASE).',
'X=s' => 'colon separated list of base directories to exclude in the search.',
'M=s' => 'media selection',
);
$OPTS = join('',(map { substr($_,0,1); } keys(%OPT_MEANINGS)));
&GetOptions(keys %OPT_MEANINGS);
$opt_H && &die_usage; #done
$opt_L && (#OCT_BASE = split(/\s*:\s*/,$opt_L));
$opt_l && (push(#OCT_BASE,split(/\s*:\s*/,$opt_l)));
$opt_X && (#OCT_BASE = #{&rm_dirs(\#OCT_BASE,$opt_X)});
if (not $opt_M)
{ $size="25,20";
} else {
($opt_M =~ m/^legal/i) and $size = '8.5,14';
($opt_M =~ m/^letter/i) and $size = '8.5,11';
($opt_M =~ m/^A0$/i) and $size = '33.1,46.8';
($opt_M =~ m/^A1$/i) and $size = '23.4,33.1';
($opt_M =~ m/^A2$/i) and $size = '16.5,23.4';
($opt_M =~ m/^A3$/i) and $size = '11.7,16.5';
($opt_M =~ m/^A4$/i) and $size = '8.3,11.7';
($opt_M =~ m/^A4dj$/i) and $size = '8.3,11.7';
($opt_M =~ m/^A5$/i) and $size = '5.8,8.3';
}
#if (not $opt_r) { $ratio = 'fill'; } else { $ratio = $opt_r; }
$ratio = $opt_r || 'fill';
if ($opt_d)
{
$opt_l = $opt_p = 1;
}
#make sure it has a tailing slash.
if ($opt_B)
{
($opt_B !~ m{/$}) && ($opt_B .= q[/]);
}
########################################################################
$| = 1;
if (! #ARGV)
{
&die_usage;
} else
{
%mfhash = &map_name_to_filename(#ARGV);
}
if ($opt_d)
{
#myargv = #ARGV;
print join(' ',map { s/\.m/$opt_d/e;$_; } #ARGV),qq[ : ];
}
if ($opt_l) {
%bdhash = &find_base_libs(#OCT_BASE);
$alldepref = &find_all_deps(\%mfhash,\%bdhash,0);
print join(' ',#{$alldepref}),qq[\n];
} else {
&print_head();
%bdhash = &find_base_libs(#OCT_BASE);
&find_all_deps(\%mfhash,\%bdhash,1);
&print_tail();
}
$opt_X && (#OCT_BASE = #{&rm_dirs(\#OCT_BASE,$opt_X)});
########################################################################
sub
rm_dirs
#remove directories from OCT_BASE
{
my $ob_ref = shift(#_);
my $oX = shift(#_);
my #excludeus = split(/\s*:\s*/,$oX);
#FIX!
}
########################################################################
sub
make_relative
#just for the sake of opt_B#FOLDUP
{
my $fullname = shift(#_);
if ($opt_B)
{
$fullname =~ s{\Q$opt_B\E}{};
}
return $fullname;
}#UNFOLD
########################################################################
sub
map_name_to_filename#FOLDUP
{
my $mfile;
my %mfiles;
my $mfstub;
while ($mfile = shift(#_))
{
$mfstub = $mfile;
$mfstub =~ s/^\s*(.*\/)?([^\/]+)\.m\s*$/$2/;
$mfiles{$mfstub} = $mfile;
}
return %mfiles;
}#UNFOLD
########################################################################
sub
find_base_libs#FOLDUP
{
my $based;
my %bdhash;
my ($mfile,$mfstub);
my #mfiles;
while ($based = shift(#_))
{
# print "|$based|\n";
#mfiles = split(/\n/,qx(cd $based && find . -name '*.m'));
while ($mfile = shift(#mfiles))
{
$mfstub = $mfile;
$mfstub =~ s/.+\/([^\/]+)\.m/$1/;
$mfile =~ s/^\s*\.\//$based/;
$bdhash{$mfstub} = $mfile;
#print STDERR "|$mfstub| -> |$mfile| |$based|\n";
}
}
return %bdhash;
}#UNFOLD
########################################################################
#returns array of all the dependencies as filename strings.
sub
find_all_deps#FOLDUP
{
my $mfhashref = shift(#_);
my $bdhashref = shift(#_);
my $doprint = shift(#_); #if 0, do not print anything out.
my #mfhashlist = %{$mfhashref};
my %bdhash = %{$bdhashref};
my $output = [];
my %globals;
my $gname;
my %doneok;
my ($mfname,$mfloc);
my ($aline,$acommand,$copyline);
my %eegraph; #store as node::node in this hash set.
#prevents edges from being written multiple times?
my %dangling = {}; #any command which has yet to be found.
#store vals a list of things which want to point in.
my $pointsin;
my $foundnewfunc;
my $foundFuncPragma; #for looking for % #function fname stuff
#my #myDependencies; #every function that I call;
my $edgestr = '';
while ($mfname = shift(#mfhashlist))#FOLDUP
{
$mfloc = shift(#mfhashlist);
$mf_alias = ($opt_p)? &make_relative($mfloc) : $mfname; #full names or not
#prevent node -> self edges.
$eegraph{qq(${mfname}::${mfname})} = 1;
if ((! $opt_C) && $doprint)
{
print qq(subgraph cluster_$mfname {\n);
print qq(rank=min\n);
print qq(ordering=out\n);
}
#node
$doprint &&
print qq{$mfname [label="$mf_alias" shape=plaintext fontsize=44]\n};
push (#{$output},$mf_alias);
$doneok{$mfname} = 1;
#open a file#FOLDUP
open (FH,"$mfloc") || die "no open $mfloc, $!";
while (! eof(FH))
{
$aline = ;
chomp($aline);
$foundFuncPragma = 0;
if ($aline =~ /^[^%]*end\s*%?\s*function/) { $mfname = ''; }
if ($mfname) #inside a function
{
if ($opt_g || $opt_G) #look for globals#FOLDUP
{
if ($aline =~ /global/)
{
$copyline = $aline;
while ($copyline =~ s/(global\s+)([^;\s]+)(\s*;)/$1$3/)
{
$gname = $2;
if (exists $globals{$gname})
{
push(#{$globals{$gname}},$mfname);
} else {
$globals{$gname} = [$mfname];
}
}
}
}#UNFOLD
#look for #function pragma
$foundFuncPragma = ($aline =~ s/%\s*#function\s+(.+)$//);
if ($foundFuncPragma)
{
$opt_D && (print STDERR "found a function pragma! |$1|\n");
#what a bummer that we can't just use this: the
#problem is that we don't really know when a function
#ends in .m code, b/c endfunction is not required. bummer.
#push (#myDependencies,split(/\s+/,$1));
#
#that is, what we would really like to do is just push onto a list
#every time we saw a command, then puke at the end of the function,
#but we do not know really when a function ends in matlab. oops.
foreach $acommand (split(/\s+/,$1))
{
$opt_D && (print STDERR "found a command! |$acommand|\n");
#push (#myDependencies,$acommand);
if (exists($bdhash{$acommand}))
{
$opt_D && (print STDERR "exists in bdhash (prolly means is a file to itself)\n");
if (! $eegraph{qq(${mfname}::${acommand})})
{
if ($opt_C) { $doprint && print "$mfname -> $acommand\n";
} else { $edgestr .= "$mfname -> $acommand\n"; }
if (! $opt_m) { $eegraph{qq(${mfname}::${acommand})} = 1; }
}
if (! $doneok{$acommand})
{
$doneok{$acommand} = 1;
push(#mfhashlist,$acommand,$bdhash{$acommand});
}
} else
{
if (exists($dangling{$acommand}))
{ push(#{$dangling{$acommand}},$mfname);
} else { $dangling{$acommand} = [$mfname]; }
}
}
}
while ($aline =~ /([a-zA-Z0-9_]+)\s*\(/)#FOLDUP
{
$aline =~ s/([a-zA-Z0-9_]+)\s*\(//;
$acommand = $1;
$opt_D && (print STDERR "found a command! |$acommand|\n");
#push (#myDependencies,$acommand);
if (exists($bdhash{$acommand}))
{
$opt_D && (print STDERR "exists in bdhash (prolly means is a file to itself)\n");
if (! $eegraph{qq(${mfname}::${acommand})})
{
if ($opt_C) { $doprint && print "$mfname -> $acommand\n";
} else { $edgestr .= "$mfname -> $acommand\n"; }
if (! $opt_m) { $eegraph{qq(${mfname}::${acommand})} = 1; }
}
if (! $doneok{$acommand})
{
$doneok{$acommand} = 1;
push(#mfhashlist,$acommand,$bdhash{$acommand});
}
} else
{
if (exists($dangling{$acommand}))
{ push(#{$dangling{$acommand}},$mfname);
} else { $dangling{$acommand} = [$mfname]; }
}
}#UNFOLD
} else #not yet inside a function.
{
$foundnewfunc = 0;
if ($aline =~ /^[^%]*function\s+[^=]*=\s*([a-zA-Z0-9_]+)\s*(\(|;|%|$)/)
{
$mfname = $1;$foundnewfunc = 1;
} elsif ($aline =~ /^[^%]*function\s+([a-zA-Z0-9_]+)\s*(\(|;|%|$)/)
{
$mfname = $1;$foundnewfunc = 1;
}
if ($foundnewfunc)
{
##myDependencies = ();
$opt_D && (print STDERR "now looking at function |$mfname|\n");
$eegraph{qq(${mfname}::${mfname})} = 1;
#subnode
$doprint && print "$mfname [shape=box]\n";
$doneok{$mfname} = 1;
$bdhash{$mfname} = 1; #innocent enough since doneok is set too.
if (exists($dangling{$mfname}))
{
while ($pointsin = shift(#{$dangling{$mfname}}))
{
$doprint && print "$pointsin -> $mfname\n";
}
}
}
}
}
close FH;#UNFOLD
if (! $opt_C)
{
$doprint && print qq(}\n);
$doprint && print $edgestr;
$edgestr = '';
}
}#UNFOLD
if ($doprint)
{
if ($opt_g)
{
foreach $key (keys(%globals))
{
print qq{$key [style=dotted label="$key" color=red shape=plaintext fontsize=44]\n};
foreach $f (#{$globals{$key}})
{
print qq{$f -> $key [color=red]\n};
}
}
} elsif ($opt_G)
{
foreach $key (keys(%globals))
{
while (defined($g = shift(#{$globals{$key}})))
{
# foreach $f (#{$globals{$key}}) { print qq{$g -- $f [color=red]\n}; }
foreach $f (#{$globals{$key}}) { print qq{$g -> $f [style=dotted label="$key" fontsize=30 fontcolor=red color=red]\n}; }
}
}
}
}
return $output;
}#UNFOLD
########################################################################
sub
print_head#FOLDUP
{
if (! $opt_m)
{
print qq[strict ];
}
# if ($opt_G) { print qq[octavedep {\n]; } else { print qq[digraph octavedep {\n]; }
print qq[digraph octavedep {\n];
print qq[nslimit=15.0\n];
print qq[mclimit=1.0\n];
print qq[ratio="$ratio"\n];
print qq[size="$size"\n];
}#UNFOLD
sub
print_tail#FOLDUP
{
print "}\n";
}#UNFOLD
########################################################################
sub
die_usage#FOLDUP
{
# print STDERR "usage: perl $0 [-$OPTS] [-$VALOPTS val] octfiles\n\n";
print STDERR "usage: perl $0 [-$OPTS] octfiles\n\n";
if ($opt_H)
{
%OPT_MEANINGS =
map {($a=$_)=~s/(.)+?[=:!]?[ifs]?/$1/;$a=>$OPT_MEANINGS{$_};}
keys %OPT_MEANINGS;
#OPTS = split(//,$OPTS);
while ($OP = shift(#OPTS)) {
print STDERR " $OP $OPT_MEANINGS{$OP}\n";
}
print STDERR "\n";
}
exit;
}#UNFOLD
########################################################################
__END__
works for me...
Though depfun doesn't provide an 'ignore-builtins' option, it does give us a '-toponly' option that we can use within our own recursive function that does exculde built-ins and runs much faster. Below is my solution:
function new_file_list = fastdepfun(paths)
% new_file_list = fastdepfun(paths)
% paths = same input as you use with depfun
[file_list] = depfun(paths,'-toponly','-quiet');
% Remove builtins (implement this part however you like)
mroot = matlabroot;
file_list = file_list(~strncmp(file_list,mroot,length(mroot)));
% Remove files already inspected (otherwise we get stuck in an infinite loop)
new_file_list = setdiff(file_list,paths);
if ~isempty(new_file_list)
new_file_list = fastdepfun(new_file_list);
end
new_file_list = unique([file_list; new_file_list]);
I'm using the File::Find module to traverse a directory tree. Once I find a specific file, I want to stop searching. How can I do that?
find (\$processFile, $mydir);
sub processFile() {
if ($_ =~ /target/) {
# How can I return from find here?
}
}
Seems like you will have to die:
eval {
find (\$processFile, $mydir);
};
if ( $# ) {
if ( $# =~ m/^found it/ ) {
# be happy
}
else ( $# ) {
die $#;
}
}
else {
# be sad
}
sub processFile() {
if ($_ =~ /target/) {
die 'found it';
}
}
In addition to what everyone else said, you may wish to take a look at File-Find-Object, which is both iterative (and as such capable of being interrupted in the middle) and capable of instantiation (so you can initiate and use several at once, or instantiate an F-F-O object based while performing another scan, etc.)
The downside for it is that it isn't core, but it only has Class::Accessor as a dependency, and is pure-Perl so it shouldn't be hard to install.
I should warn you that I am its maintainer, so I may be a bit biased.
Can you throw custom exceptions in Perl?
You could use named blocks and jump to it if you find your result (with next, last, it depends from what you need).
I found this link:
http://www.perlmonks.org/index.pl?node_id=171367
I copied one of the scripts in that list of posts, and this seems to work:
#! /usr/bin/perl -w
use strict;
use File::Find;
my #hits = ();
my $hit_lim = shift || 20;
find(
sub {
if( scalar #hits >= $hit_lim ) {
$File::Find::prune = 1;
return;
}
elsif( -d $_ ) {
return;
}
push #hits, $File::Find::name;
},
shift || '.'
);
$, = "\n";
print #hits, "\n";
It appears that is actually causing find to not traverse any more by using $File::Find::prune.
The function processFile() should return true if it finds the file, and false otherwise. So, every time that processFile calls himself should check this return value. If it is true, some recursive call has found the file, so there's no need to call himself again, and it must also return true. If it's false, the file hasn't been found yet, and it should continue the search.
I want to check the results of an operation in the Net::FTP Perl module rather than die.
Typically you would do:
$ftp->put($my_file)
or die "Couldn't upload file";
But I want to do something else instead of just dying in this script so I tried:
$ftp->put($my_file)
or {
log("Couldn't upload $my_file");
return(-1);
}
log("$my_file uploaded");
But Perl complains of compilation errors saying:
syntax error at toto.pl line nnn, near "log"
which is the second log in my code fragment.
Any suggestions greatly appreciated.
cheers,
do is what you're looking for:
$ftp->put($my_file)
or do {
log("Couldn't upload $my_file");
return(-1);
};
log("$my_file uploaded");
But this is probably better style:
unless( $ftp->put( $my_file )) { # OR if ( !$ftp->put...
log("Couldn't upload $my_file");
return(-1);
}
If you just want to return an error condition, then you can die and use eval in the calling func.
use English qw<$EVAL_ERROR>; # Thus, $# <-> $EVAL_ERROR
eval {
put_a_file( $ftp, $file_name );
handle_file_put();
};
if ( $EVAL_ERROR ) {
log( $EVAL_ERROR );
handle_file_not_put();
}
and then call
sub put_a_file {
my ( $ftp, $my_file ) = #_;
$ftp->put( $my_file ) or die "Couldn't upload $my_file!";
log( "$my_file uploaded" );
}
or do{}; always makes my head hurt. Is there a good reason to use "or" syntax (which I admit using a lot for one liners) vs "if" (which I prefer for multi liners)?
So, is there a reason to use or not use one of these methods in preference of the other?
foo()
or do {
log($error);
return($error);
};
log($success);
if (!foo()) {
log($error);
return($error);
}
log($success);
use do.
here is small code snippet:
sub test {
my $val = shift;
if($val != 2) {
return undef;
}
return 1;
}
test(3) || do {
print "another value was sent";
};
I'm having a hard time understanding why this needs to be wrapped up in a do. Is there a reason that this isn't sufficient?
my $ftp_ok = $ftp->put( $my_file )
or log("Couldn't upload $my_file" ) and return -1;
log("$my_file uploaded") if $ftp_ok;
This assumes that the put function doesn't always return undef on success.