Perl : version->parse with invalid input - perl

I have an array of version numbers that I have read in from the output of a terminal command,
unfortunately a few of them are not valid (5.2.5_076_06-beta) to be used with version::parse, I have the output "Invalid version format (version required) at get_version.pl line 8." this corresponds to the line containing version->parse($test); and the entire script terminates. How do I work around this?
use version;
my $cmd = "ls -l /nfs/install/ | awk '{print \$9}'";
my #vers = `$cmd`;
foreach my $test ( #vers ) {
try {
version->parse($test);
}
catch
{
my $index = 0;
$index++ until $vers[$index] eq $test;
print $vers[$index];
splice(#vers, $index, 1);
}
}
my #sorted_vers = sort { version->parse( $a ) <=> version->parse( $b ) } #vers;
foreach my $version (#sorted_vers)
{
print $version;
}

The version module is for parsing Perl module versions, which have a very specific format. For your task of sorting arbitrary non-Perl versions, try Sort::Versions.
use Sort::Versions;
my #sorted_vers = sort versioncmp #vers;

Related

How to take maximum name from the files with any .txt extension and remove the other contents expect maximum one using perl?

In the below code I tried to filter the maximum name from any files in my path and remove the minimum digit contents from the file using Perl.
Content inside all .txt files in my direcctory:
sv1 12.70% 12.70%
sv2 49.21% 49.21%
sv3 88.89% 88.89%
sv4 92.06% 92.06%
Expectation:
sv4 92.06% 92.06%
code:
use File::Path qw(remove_file);
my $path_output = $output_dir;
find2($path_output);
sub find2{
my ($s1) = #_;
my (#dirs1) = grep { -f && /\.txt$/ } glob $s1.'/*';
print #dirs1;
my ($link1) = sort{
my ($m1)=$a1=~m/\/(sv\d+)$/; my ($n1)=$b1=~/\/(sv\d+)$/; $n1 cmp $m1
} grep{/\/sv\d+$/} #dirs1;
foreach (#dirs1)
{
($_=~m/sv(\d+)$/ && $_ ne $link1)? remove_file($_) : find2($_);
}
}
Error:
"remove_file" is not exported by the File::Path module
print #dirs1 is not printing the matching files.
Edited code:
my $path_output1 = $output_dir;
#print $path_output1;
find2($path_output1);
sub find2{
my ($s1) = #_;
print $s1;
my (#dirs1) = grep { -f && /\.txt$/} glob $s1.'/**/*/*';
#print #dirs1 ;
my ($link1) = sort{
my ($m1)=my $a1=~m/\/(sv\d+)$/; my ($n1)=my $b1=~/\/(sv\d+)$/; $n1 cmp $m1
} grep{/\/sv\d+$/} #dirs1;
#print "****$link1***";
foreach my $file (#dirs1)
{
($file=~m/sv(\d+)$/ && $_ ne $link1)? unlink($file) : find2($file);
#print $file;
}
}
still i had struck with my query.
The module File::Path does not have a function remove_file. Looking at the Changes document, it never had. But Perl has a built-in to delete files: unlink.
Get rid of the use File::Path, you don't need it. Then use unlink in your loop.
foreach my $file (#dirs1)
{
( $file =~ m/sv(\d+)$/ && $_ ne $link1 ) ? unlink($file) : find2($file);
}

How NOT to get a new line in the assignment with a call to a shell utility

Situation
I am absolutely new to Perl and have to modify a subroutine in an existing script. The starting point is:
sub example {
my $program = $ENV{'FC'};
unless ( $variable ) {
foreach ( 'gfortran', 'g95' ) {
$compiler = $_;
my $path = `which $program`;
last if $path;
}
}
return $program;
}
Issue
This works perfectly when FC=gfortran and returns gfortran. In my case, however, the same environment variable has to be FC=\opt\gcc\bin\gfortran
Research
I have tried to change the second line
my $program = $ENV{'FC'}; # original
into
my $program = `basename $ENV{'FC'}`; # with a call to a shell utility
which works out as desired to an extent, since the function output contains an annoying extra new line:
'gfortran
'
that spoils the functioning of the code father down. The assignment should be a plain gfortran.
Question
How can I suppress that automatic new line?
You could remove it
chomp($program);
Better yet, use
use File::Basename qw( basename );
sub example {
if ( my $program = $ENV{FC} ) {
return basename($program);
}
for my $program (qw( gfortran g95 )) {
return $program if `which $program`;
}
return undef;
}

Text file to hash table

I want to create a hash table for the data in my file.
The file contains a bunch of commands that are written as
===|showcommand|
Every time I see this delimiter I want to create a hash key and store the data below it as an array in the value until it sees the next delimiter.
The next delimiter will do the same thing which is to create a hash key with the delimiter name and store the data on the next lines following it into an array as a value.
my %commands;
my $name;
my $body;
while (<>) {
if (my ($new_name) = /===\|([^|]*)\|/) {
$commands{$name} = $body if defined($name);
$name = $new_name;
$body = '';
} else {
$body .= $_;
}
}
$commands{$name} = $body if defined($name);
Assumes the body of the command starts on the line after the header, and stop on the line before the one with the next header.
You probably have it already working, but adding a small comment still, regarding the question on how to return the hash from a function.
Here's an example:
Input -file (used the following, which, I think contains similar structure as your input -file.
===|showcommand|
cmd1
cmd2
cmd3
cmd4
===|testcommand|
command1
command2
command3
===|anothercommand|
another1
another2
another3
another4
Perl -script:
use strict;
# Calling ReadCommandFile to build hash.
my %commands = ReadCommandFile("./commands.txt");
# ReadCommandFile - reads commands.txt and builds
# a hash.
sub ReadCommandFile()
{
my $file = shift;
my %hash = ();
my $name;
open(FILE, "<$file");
while(<FILE>)
{
if($_ =~ /===\|(.*)\|/)
{
$name = $1;
$hash{$name} = [];
}
else
{
my $line = $_;
$line =~ s/\n$//;
push(#{$hash{$name}}, $line);
}
}
close(FILE);
return %hash;
}
As a result, you should get the following hash (output from Data::Dumper):
$VAR1 = 'anothercommand';
$VAR2 = [
'another1',
'another2',
'another3',
'another4'
];
$VAR3 = 'showcommand';
$VAR4 = [
'cmd1',
'cmd2',
'cmd3',
'cmd4'
];
$VAR5 = 'testcommand';
$VAR6 = [
'command1',
'command2',
'command3'
];
You can then access individual elements like this:
Get the third command from "showcommand":
print "\nCommand #3: " . $commands{'showcommand'}[2];
Output: cmd3
The data from the file is copied to a hash and the commands are added as an array under the respective keywords.
Thanks!

Perls File::VirusScan using Daemon::ClamAV::Clamd says did not get PING response from clamd

First let me state, clamd has been proven to respond correctly:
$ echo PING | nc -U /var/run/clamav/clamd.sock
PONG
the scanner was setup as follows:
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
and the whole script works fine on a Solaris 11 box. I'm running this on a Linux CentOS 5.3 (Final) I did have a problem installing File::VirusScan from CPAN, the latest version 0.102 won't compile and CPAN testers seems to confirm this as 435 fails out of 437. So I downloaded the prev 0.101 version from CPAN, the version I'm also running in Solaris and manually installed apparently ok
perl -v
This is perl, v5.8.8 built for x86_64-linux-thread-multi
sub scanner {
$|++; # buffer disabled
(my $path, my $logClean) = #_;
my $recurse = 5;
print color "yellow";
print "[i] Building file scan queue - recurse deepth $recurse \n";
print color "green";
print "SCAN QUEUE:0";
#Get list of files
if( $rootPath){
use File::Find::Rule;
my $finder = File::Find::Rule->maxdepth($recurse)->file->relative->start("$$path");
while( my $file = $finder->match() ){
$|++;
#$file = substr($file,length($rootPath)); #remove path bloat
push(#scanList,"/$file");
print "\rSCAN QUEUE:" .scalar(#scanList); #update screen
}
}else{
push(#scanList,"$$path");
}
print "\rSCANING:0";
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
#scan each file
my $scanning = 0;
my $complete = -1;
foreach $scanFile (#scanList){
$scanning++;
##################################################
#scan this file
$results = $scanner->scan($rootPath.$scanFile);
##################################################
#array of hashes
my $centDone = int(($scanning/scalar(#scanList))*100);
if($centDone > $complete){
$complete = $centDone;
}
if($centDone < 100){
#\r to clear/update line
$format = "%-9s %-60s %-15s %-5s";
printf $format, ("\rSCANING:", substr($scanFile,-50), "$scanning/".scalar(#scanList), "$centDone%");
}else{
print "\rSCAN COMPLETE ";
}
# array ref
foreach $result (#$results) {
#array of pointers to hashes
#print 'data:'
#print 'state:'
if($$result{state} ne "clean"){
if($$result{data} =~ /^Clamd returned error: 2/){
$$result{data} = "File too big to scan";
}
push(#scanResults,[$scanFile,$$result{state},$$result{data}]); # results
}elsif($$logClean){
push(#scanResults,[$scanFile,$$result{state},$$result{data}]);
}
unless($$result{state} eq "clean"){
print color "red";
print "\r$scanFile,$$result{state},$$result{data}\n";
print color "green";
print "\rSCANING: $scanning/".scalar(#scanList)." : $centDone%";
if($$result{state} eq "virus"){
push(#scanVirus,scalar(#scanResults)-1); #scanResuts index of virus
}elsif($$result{state} eq "error"){
push(#scanError,scalar(#scanResults)-1); #scanResuts index of Error
}
}
}
} print "\n";
}
Looking at the source code for the Clamd package the following script should approximate the call it is attempting and will hopefully give you a better idea of how it's failing. Try saving it to a separate file (like test.pl) and run it using "perl test.pl":
use IO::Socket::UNIX;
use IO::Select;
my $socket_name = '/var/run/clamav/clamd.sock';
my $sock = IO::Socket::UNIX->new(Peer => $socket_name);
if(!defined($sock)) {
die("Couldn't create socket for path $socket_name");
}
my $s = IO::Select->new($sock);
if(!$s->can_write(5)) {
$sock->close;
die("Timeout waiting to write PING to clamd daemon at $socket_name");
}
if(!$sock->print("SESSION\nPING\n")) {
$sock->close;
die('Could not ping clamd');
}
if(!$sock->flush) {
$sock->close;
die('Could not flush clamd socket');
}
if(!$s->can_read($self->{5})) {
$sock->close;
die("Timeout reading from clamd daemon at $socket_name");
}
my $ping_response;
if(!$sock->sysread($ping_response, 256)) {
$sock->close;
die('Did not get ping response from clamd');
}
if(!defined $ping_response || $ping_response ne "PONG\n") {
$sock->close;
die("Unexpected response from clamd: $ping_response");
}
It looks like the various antivirus engines need to be installed separately from the File::VirusScan base library. Does the following return an error?
perl -mFile::VirusScan::Engine::Daemon::ClamAV::Clamd -e ''
If it displays an error that it can't locate Clamd.pm, you need to install that engine module.
If it doesn't display an error, you'll need to post more details, such as the code you're actually using to perform the scan and/or the error output (if any).

MATLAB: determine dependencies from 'command line' excluding built in dependencies

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]);