>>>>> "J" == Jorge <> writes:
J> #!/usr/bin/perl -l
J> use strict;
J> use warnings;
good
J> &scripts_dir('/some/dir/that/holds/scripts');
don't call subs with & as it isn't needed with () and it is perl4
style. there are other subtle issues that can bite you.
J> sub scripts_dir {
J> # set some vars
J> my $dir = shift;
J> my(@paths, $paths, @scripts, $scripts, $string);
J> my($lines, $leaf, $header, $header2);
don't declare vars before you need them. in many cases you can declare
then when first used.
J> local($_);
why? actually i recommend against using $_ as much as possible (it does
have its places) so you can used named vars which are easier to read and
make the code better
J> # check dir can be opened for read
J> unless (opendir(DIR, $dir)) {
use a lexical handle
unless (opendir(my $dirh, $dir)) {
J> die "can't open $dir $!\n";
J> closedir(DIR);
why close the handle if it never opened?
J> return;
you can just exit here instead.
J> }
better yet, use File::Slurp's read_dir.
J> #
J> # read dir, skip over system files and bak files
J> # build array of script names
J> # build array of full-path script names
J> #
J> foreach (readdir(DIR)) {
J> next if $_ eq '.' || $_ eq '..' || $_ =~ /\.bak$/;
read_dir skips . and .. for you.
J> push(@scripts, $_);
J> $paths = $dir."/".$_;
J> push(@paths, $paths);
J> }
J> closedir(DIR);
that can all be done so much simpler like this (untested):
my @paths = map "$dir/$_", grep !/\.bak$/, read_dir $dir ;
J> # open ouput file, format and print headers
J> open OUT, ">output" or die "cannot open output for writing $!
J> ...
ditto for lexical handles
J> \n";
J> $header = sprintf("%-25s%-25s%s", "SCRIPT NAME", "FOUND IN",
J> "USAGE");
J> $header2 = sprintf("%-25s%-25s%s", "===========", "========",
J> "=====");
you use the same sprintf format three times. put that into a variable
above so you can change it in one place.
J> print OUT $header;
J> print OUT $header2;
no need for two print calls.
print OUT $header, $header2 ;
J> # loop through each script name
J> foreach $scripts(@scripts){
foreach my $scripts (@scripts) {
that is how you can declare vars locally. and use more horizontal
whitespace. others need to read your code so think about them when you
write it. and YOU are an other too!
i noticed this below but the point is true here. don't use plural names
for singular things. $scripts has a single script name
J> # loop through each script in directory
J> foreach my $paths(@paths){
you used my there. why not in the previous loop?
J> # get last leaf of script being searched --
J> # if it matches itself; skip
J> $leaf = get_leaf($paths);
J> if($scripts eq $leaf) { next;}
slightly faster as you don't need a block entry on next. also a better
style for simple flow control like this.
next if $scripts eq $leaf ;
J> # open each script for searching
J> open F, "$paths" or die "cannot open $paths for reading
don't quote scalar vars as it can lead to subtle bugs. it is not needed here.
J> $! ...\n";
J> while(my $lines = <F>) {
$lines is a single line so make that singular. using a plural name
implies an array or array ref
J> # -l switch in place
that only affects one liners using -p or -n. no effect on regular code
J> chomp($lines);
J> # search for matches to the commonly-used command
J> syntax
J> if($lines =~ /\$\($scripts / || $lines =~ /\`
J> $scripts /){
this doesn't make sense. are you checking if the current script refers
to itself??
J> # format to line up with headers
J> $string = sprintf("%-25s%-25s%s", $scripts, $leaf,
J> $lines);
J> # print to file
J> print OUT $string;
since you just print the string, you can use printf directly.
J> }
J> }
J> }
J> }
J> # close I/O streams
J> close(F);
J> close(OUT);
J> }
J> #======================
J> # subroutine get_leaf
J> #======================
J> sub get_leaf
J> {
J> # get arg(s)
J> my($pathname) = @_;
J> # split on leafs
J> my @split_pathname = split( /[\\\/]/, $pathname);
gack!!
File::Basename does this for you and simpler.
J> # grab last leaf
J> my $leaf = pop( @split_pathname );
you could just return the popped value directly. hell, you can do that
in the split line too:
return( (split( /[\\\/]/, $pathname)[-1] );
as for speedups, i can't help much since i don't have your input
data. nothing seems oddly slow looking but your core loops are deep and
can be done better. slurping in the entire file (File::Slurp) and
scanning for those lines in one regex would be noticeably faster. and
your core logic is suspect as it doesn't seem to check for calling other
scripts from a given one.
uri
--
Uri Guttman ------
--------
http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ----
http://bestfriendscocoa.com ---------