Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Following symlinks manually (historical code)

by shmem (Chancellor)
on Jan 16, 2007 at 00:09 UTC ( #594829=note: print w/replies, xml ) Need Help??


in reply to Following symlinks manually

This post is of little use and contains bad (style) obsolete code.

Nearly 13 years ago, I had to find orphaned and looped symlinks in our cad lab network at the university, a heavily NFS infested environment with cross mounts between workstations and servers.

I concocted the following, based on an example from the first Camel Book (the pink one; the example code must have been either merlyn's or Tom Christiansen's). It's perl4.

Must be one of my very first perl scripts, I didn't bother to rewrite it, it has worked ever since. I keep it like that ol' rusty tool you just don't want to drop, despite of the current screwdrivers being shinier.

If you find a bug in it, you may keep it ;-)

#!/usr/bin/perl 'di '; 'ig00 '; # sl - follows symbolic links sub exitus { die "Usage: sl -d[rs] [directory]\n sl filenames\n"; } &exitus unless @ARGV; # Preliminaries $| = 1; while ($ARGV[0] =~ /^-/) { $_ = shift; if (/^-[drs]{1,2}/) { $dir = $ARGV[0]; if ($dir) { chdir $dir || die "Can't cd to directory $dir: $!\n"; } $dir = `pwd`; chop $dir; print "\nDirectory: $dir\n"; if (/d/) { # All links in directory requested. opendir(DIR,$dir) || die "Can't open $dir: $!\n"; @ARGV = grep(-l,readdir(DIR)); } if (/r/) { # Recursive request. @ARGV = `find . -type l -print`; $pfad = join(' ',@ARGV); $pfad =~ s!\./! !g; @ARGV = split(/ /,$pfad); chop @ARGV; } if (/s/) { $s = 1; } next; } die "I don't recognize this switch: $_\n"; } chop($cwd = `pwd`) || die "Can't find current directory: $!\n" if @ARGV > 1; print "\n"; foreach $name (@ARGV) { if ($name ne '') { @indents = (); @test = (); $loop = 0; $raus = 0; $dir = `pwd`; chop $dir; if ($dir ne '/') { $out = "$dir/$name:\n"; } else { $out = "/$name:\n"; } @path = split(m;/;, $name); # Make an absolute path relative to /. if (@path && $path[0] eq '') { chdir '/'; shift @path; $out = $out."/"; $indent = 1; } # Now follow subdirectories and links. while (@path) { $elem = shift @path; $new = readlink($elem); if (defined $new) { # A symbolic link. $out = $out."$elem -> $new\n"; $new =~ s!^\./!!; # field separator: ! # Prepend symbolic link to rest of path. unshift(@path,split(m;/;,$new)); # Test for looped links. $tmp = join('',@path); push(@test,$tmp); for (@test) { if ($_ ne '') { $this = $_; $num = 0; for (@test) { if ($this eq $_) { $num++; } if ($num > 1) { print $out if $s; $loop =1; print "\n*** LOOPED LINK ***\n\n"; last; } } } last if $loop; } last if $loop; # Deal with special cases. if (@path && $path[0] eq '') { # Absolute path starts over. chdir '/'; shift @path; $out = $out."/"; $indent = 1; @indents = (); next; } # Back up the tree as necessary. while (@indents && $path[0] eq '..') { $indent = pop(@indents); chdir '..' || warn "\n\nCan't cd to ..: $!\n"; shift @path; } $out = $out.("\t" x ($indent / 8), ' ' x ($indent % 8) +); } else { # An ordinary director +y. $out = $out.$elem; push(@indents,$indent); $indent += length($elem) + 1; if (@path) { $out = $out."/"; chdir $elem || &complain; last if $raus; } } } next if $raus; $out = $out."\n"; if (! $s) { print $out if ! $raus; } $raus = 0; if (! -e $elem) { # Check if file exists +. if (! $loop) { print $out if $s; print "\n$elem: No such file or directory.\n"; print "\n" if $s; } } print "\n" if ! $s; $indent = 0; chdir $cwd || die "Can't cd back: $!\n" if $cwd ne ''; } } sub complain { print $out; warn "\n\nCan`t cd to $elem: $!\n\n"; chdir $cwd; $raus = 1; } ############################################################# # The next few lines are legal in both perl and nroff. .00; 'di \" finish diversion - previous line must be blank .nr % 0 \" start at page 1 .nr nl 0-1 \" fake up transition to first page again ';__END__ #### From here on it's a standard manual page #### .de EX \"Begin example .ne 5 .if n .sp 1 .if t .sp .5 .nf .in +.5i .. .de EE \"End example .fi .in -.5i .if n .sp 1 .if t .sp .5 .. .TH sl 8 "15 February 1994" "LAB ADMIN TOOLS" .SH NAME sl \- follow symbolic links .SH SYNOPSIS /usr/local/igp/bin/sl .SH SYNTAX .B sl\fP [-drs] [\fIdirectory\fP] .PP .B sl\fP \fIfilenames\fP .SH DESCRIPTION \fIsl\fP follows symbolic links and returns each link it finds. It rep +orts looped links and non-existing files and directories. .EX hekate [shmem] /usr/local >sl tex /tmp_mnt/usr/local/tex: tex -> /apps/share/tex /apps -> /tmp_mnt/apps /tmp_mnt/apps/share/tex .EE In this example, tex is linked to /apps/share/tex; /apps is itself lin +ked upon /tmp_mnt/apps, so the complete path is /tmp_mnt/apps/share/t +ex. .SH OPTIONS .TP .B \-d Search for links specified in .I directory and follow each of them. In absence of .I directory the current working directory is searched. .TP .B \-r From the given .I directory recursively descend the path and report upon each link found. In absen +ce of .I directory the current working directory is searched. .TP .B \-s Work silently. Don't report but looped links, or links pointing to now +here. .TP .B filenames report upon each filename given. .PP .SH BUGS .I sl should optionally unlink looped links and links pointing to nowhere. .SH AUTOR Just another perl hacker - or someone else. I added the recursive feat +ure.

This was before pod - the script is it's own nroff manual page, done with wrapman - again, from the first camel book. Just nroff -man sl | less; nroff spits some warnings but renders it fine otherways.

I guess I program better since, so please don't correct this script - critics would be 12 years too late anyways...;-)

Sorry for posting my old cruft. For some obscure reason, it had to be done (?).

update: added links

--shmem

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://594829]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (3)
As of 2022-05-20 20:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (76 votes). Check out past polls.

    Notices?