Learning Perl Challenge: rhich

This is the first of a set of novice challenges that I’ll present on this blog. I’ll give you some problem which you should be able to solve with just the stuff we present in Learning Perl. A week or so later, I’ll post a solution.

For your first problem, consider the which command-line tool, which given a name, tells you the where in your PATH it finds that program. With just a name, it tells you the first path it finds:

% which perl
/Users/brian/bin/perls/perl

With the -a switch, it shows all the paths:

% which -a perl
/Users/brian/bin/perls/perl
/usr/local/bin/perl
/usr/bin/perl

This command takes an exact name. What if you don’t quite remember what the name is? This is your challenge.

Write a tool, called rhich, which takes a pattern and searches through your PATH looking for any program name that matches that pattern. Print all matching paths.

Since we don’t cover PATH in Learning Perl, I’ll give you some hints.

PATH is a set of directory names that the shell uses to search for a command to run. On Unix-like shells, the components are separated by colons. On DOS-like shells, it’s separated by a semicolon. You don’t need to do much work for that because perl already knows what the separator is. The Config module provides a %Config hash with the things that perl knows based on its compilation:

use Config;

my $separator = $Config{path_sep};

With that, get to it. You don’t have to post your solution, but you can if you like.

You can see a list of all Challenges and my summaries as well as the programs that I created and put in the Learning Perl Challenges GitHub repository.

13 thoughts on “Learning Perl Challenge: rhich”

I’m not sure if posting solutions here is appreciated, but I hope mine is at least ok:

#!/usr/bin/env perl

use feature 'say';
use Config;
use strict;
use utf8;
use warnings;

die 'Usage: rhich RE' if @ARGV != 1;

my $separator = $Config{path_sep};
my @paths = split /$separator/, $ENV{PATH};

foreach my $path (@paths) {
  if (opendir my $dh, $path) {
    foreach my $file (readdir $dh) {
      if ($file =~ m/\Q$ARGV[0]\E/) {
        say STDOUT "$path/$file" if -x "$path/$file" and not -d _;
      }
    }
    closedir $dh;
  } else {
    say STDERR "Can't open $path: $!";
  }
}

I don’t do much with Perl scripting that works with the shell so I had to look some stuff up. I did add the die line that the first poster added only because it was obvious I should have it.

#!/usr/bin/perl
use strict;
use warnings;
use Config;
die 'Usage: rhich [filename]' if @ARGV != 1;

my $search = $ARGV[0];
my $s = $Config{path_sep};
my @paths = split(/$s/, $ENV{PATH});

foreach my $path (@paths)
{
  opendir(DIR,$path);
  my @files = readdir(DIR);
  closedir(DIR);
  foreach(@files){
    if($_ =~ m/$search/)
    {
      print $path."/".$_,"\n";  #Prints out the FILENAME and PATH
    }
  }

This solution may be a bit of overkill, but it gracefully allows for multiple arguments along with an “-a” option:

use strict;
use warnings;
use Config;
use File::Util;
use Array::Utils qw(unique);
use Getopt::Long qw(:config pass_through);

my $all=0;

GetOptions('a'=>\$all);

my $dir_sep=File::Util->SL; #Either "\" or "/".
my $path_sep=$Config{path_sep}; #Either ";" or ":".

die "No PATH found" unless $ENV{PATH};

unless(@ARGV)
{
    print "Usage: perl rhich.pl [-a] pattern1 [pattern2 ...]\n";
    exit 0;
}

#No sense in looking for patterns twice.
@ARGV=unique(@ARGV);

my @path=split(/$path_sep/,$ENV{PATH});

#In case directories are listed more than once...
@path=unique(@path);

my %output;
$output{$_}=[] foreach(@ARGV);

#We want to keep track of the original patterns (when we print the output)
#but this array will allow us to remove patterns in case -a isn't enabled.

my @patterns_to_check=@ARGV; 

foreach my $dir (@path)
{
    my $dh;
    
    unless(opendir($dh,$dir))
    {
        warn "Could not open directory $dir.\n";
        next;
    }
    
    my @files=readdir($dh);
    
    closedir($dh);
    foreach my $file (@files)
    {
        foreach my $pattern (@patterns_to_check)
        {
            if($file=~/$pattern/)
            {
                push @{$output{$pattern}},$dir . $dir_sep . $file;
                unless($all)
                {
                    @patterns_to_check=grep{$_ ne $pattern}@patterns_to_check;
                }
            }
        }
    }
}

#Printing out files in:
#a) the order of patterns given and
#b) the order found within each pattern (if -a is enabled)
foreach my $pattern (@ARGV)
{
    foreach my $file (@{$output{$pattern}})
    {
        print "$file\n";
    }
}

Joel Berger says:

February 24, 2012 at 03:02

@Jack, good for you for being the first to use a platform-correct file dir separator.

@Jack: Your solution might be a bit of overkill but very instructive. 🙂

@Joel: Thank you for pointing out the platform-correct file dir separator. 🙂

I’ve changed my solution and here is the diff:

diff --git a/perl/learning_perl/blog/challenge/rhich b/perl/learning_perl/blog/challenge/rhich
index 1772695..c08a26d 100755
--- a/perl/learning_perl/blog/challenge/rhich
+++ b/perl/learning_perl/blog/challenge/rhich
@@ -48,6 +48,7 @@
 # if you like.
 
 use feature 'say';
+use File::Spec;
 use Config;
 use strict;
 use utf8;
@@ -62,7 +63,8 @@ foreach my $path (@paths) {
   if (opendir my $dh, $path) {
     foreach my $file (readdir $dh) {
       if ($file =~ m/\Q$ARGV[0]\E/) {
-        say STDOUT "$path/$file" if -x "$path/$file" and not -d _;
+        my $name = File::Spec->catfile($path, $file);
+        say STDOUT $name if -x $name and not -d _;
       }
     }
     closedir $dh;

#!/usr/bin/perl
use Config;
use strict;
my $fl = shift;
die "\n\tUsage:\t$0 name-or-part-of-it\n\n" unless $fl;
my $separator = $Config{path_sep};
my $path = $ENV{PATH};
my @arpath = split($separator,$path);
foreach my $d (@arpath)
{
	$d = "." unless $d;
	foreach my $i (glob "$d/*")
	{
		print "$i\n" if ( $i =~ /${fl}/i );
	} 
}

@Meir – or trimming a bit…

#!/usr/bin/perl
use Config;
use strict;
my $fl = shift;
die "Usage: $0 name-or-part-of-it\n" unless $fl;
foreach my $d (split($Config{path_sep},$ENV{PATH})) {
  $d = "." unless $d;
  foreach (glob "$d/*") {
    print "$_\n" if (/${fl}/i);
  }
}

I wonder how comes that nobody came with a map/grep version for this. Here’s Meir’s version rewritten in such a way:

#!/usr/bin/perl
use Config;
use strict;
use warnings;
use feature qw( say );

my $fl = shift;
die "\n\tUsage:\t$0 name-or-part-of-it\n\n" unless $fl;

$_ =~ /${fl}/i and print("$_\n") foreach ( map { glob( "$_/*" or '.' ) } split( $Config{path_sep},$ENV{PATH} ) ) ;

The usage line is modified from some of the previous postings.

#!/usr/bin/perl
use warnings; use strict; use utf8;

die "USAGE: rhich [regex]\n" unless @ARGV == 1;
my $pattern = \$ARGV[0];

foreach my $dir (split /:/, $ENV{PATH}) { 
	chdir $dir;
	foreach my $file (glob '*') {
		if ($file =~ /$$pattern/) {
			print "$dir/$file\n"
		}
	}
}

Pingback: Learning Perl Challenge: rhich (Answer) | Learning Perl

#!C:\Perl\bin\perl.exe
#  $Id$  $Revision$  $HeadURL$  $Date$
# todo: make this run from a menu entry...
# code reuse from: MP3_Player_v1_07.pl qw/search_regex, wanted/
use strict;
use warnings;
use Tk;
use File::Find;
use Config;
our $VERSION=1.0;

my $separator = $Config{path_sep};

my (@dirs_in_path,$m);
get_dirs_in_path();

my $mw=MainWindow->new(-title=>'rwhich.pl');

my $font = $mw->fontCreate(qw/F1  -family helvetica -size 20 -weight bold/);
my $font2 = $mw->fontCreate(qw/F2 -family helvetica -size 12 -weight bold/);

my $regex = $mw->Entry(-font => $font2,-background => 'lightblue', -width => 20)->pack(-side => 'top');
$regex->bind('' => \&search_regex);

my $listbox = $mw->Scrolled(qw/
	Listbox
	-width  80
        -background lightblue
	-height 12
	-scrollbars e
	-setgrid 1
	-font $font/)->pack(-side => 'top', -fill => 'both', -expand => 'yes');

MainLoop;

sub get_dirs_in_path
  {
  my $path=$ENV{'PATH'};
  my @paths=split /$separator/smx, $path;
  my %dirs;
  foreach (@paths)
    {
    next if /Windows/smx;
    $dirs{$_}++;
    }
  foreach(keys %dirs)
    {
    push @dirs_in_path,$_;
    }
  return;
  }

sub search_regex
  {
  my $string= $regex->get();
  $m=qr/$string/ismx;
  $listbox->delete(0,'end');  # clear the listbox
  $listbox->insert('end', "searching for anything that matches $string");
  $listbox->itemconfigure(0,-background => 'lightgreen');
  find(\&wanted,@dirs_in_path);
  $listbox->insert('end', 'DONE SEARCHING');
  $listbox->itemconfigure($listbox->index('end') - 1,-background => 'red');
  return;
  }
sub wanted
  {
  my $file = $File::Find::name;
  my $fullname=$file;
  $file =~ s/.*\///smx; # several ways come to mind to limit the regex to the
  $file =~ s/.*\\//smx; #   file part.  File::Basename might be better than 
#                           s///'ing but i get both / and \ in my fullname...
  if (-f $file && -x $file && $file =~ /$m/ismx)
    {
    $listbox->insert('end',$fullname);
    }
  $mw->update();
  return;
  }

This is my version of rhich

#!/usr/bin/perl

use strict;
use warnings;

use Config;
my $separator = $Config{path_sep};
die "require exactly one parameter\n" if @ARGV != 1;

foreach my $path (split $separator, $ENV{PATH}) {
    opendir DH, $path or die "Cannot open $path: $!";
    foreach my $file (readdir DH) {
        if($file =~ /$ARGV[0]/) {
            print $path, "\n";
            last;
        }
    }
}

Well after some consideration, I think it might be best to dip back to CPAN:

#!/usr/bin/env perl

use strict;
use warnings;
use v5.10;
use Env qw/@PATH/;

my $r = shift;
say for grep { /$r/ } map { glob "$_/*" } @PATH

In fact, its simple enough that it makes an effective one-liner

perl -MEnv=@PATH -E '$r=shift; say for grep { /$r/ } map {  glob "$_/*" } @PATH'

Comments are closed.