From: asherman@laser.fmrco.com (Aaron Sherman)
Subject: Re: Filename expansion ("~user")
Reply-To: asherman@fmrco.COM
Organization: I-Kinetics, 19 Bishop-Allen Dr., Cambridge, MA
	<MERLYN.92Aug21092257@romulus.reed.edu>
Distribution: usa
Date: Sun, 23 Aug 1992 00:30:46 GMT


This is a library based on my "apath" program, which allows you to
resolve path names in various ways. To see what it is capable of, look
at the get_options subroutine, or try the following calls:

	require 'apathlib.pl';
	print &apath('t','~root'),"\n";
	print &apath('ve','/usr/bin/${PAGER}'),"\n";
	print join("\n",&apath('sl','/bin','/etc/route')),"\n";
	print &apath('tsa','~bin/bin'),"\n";

To sum up:

	&apath(OPTIONS,LIST)

	where OPTIONS is one of: a, n, l, u, t, v or s.
	and LIST is a list of paths to resolve.

TODO:

	o Allow setting of options ONCE to increase speed for later
	  calls.

	o Add support for Domain/OS style paths (i.e. //foo, where foo
	  is a machine name).

	o Always have to make it just a LITTLE faster...

-------------CUT HERE-----------------
# Apathlib: a library for Analyzing and simplifying path-names.
# Copyright (C) 1992  Aaron Sherman
#
#	This program is free software; you can redistribute it to your
#	heart's content, just don't claim that you wrote it, and leave
#	this copyright section alone.
#
#	If you make changes, note this in the code.

#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

# You can contact the author via electronic-mail as:
#
#	asherman@fmrco.com
#

package apath;

$version = '$Id: apathlib.pl,v 1.3 1992/08/22 23:14:17 asherman Exp $';

package main;

sub apath
{
    package apath;

    local($options,@list) = @_;
    local(*_,%done,$file,$line,@return);

    &get_options($options);

    foreach(@list)
    {
	# I don't increment $done{$_} here, since it is done below.
    
	&expand_name($_) if ($tilde || $variable);

	next if ($unique && $done{$_});
    
	if ($validate && ! -e $_)
	{
	    push(@return,undef);
	    next;
	}
	($file,$line) = &follow($_);

	unless(($unique && $done{$file}++) || ($delete && $_ eq $file))
	{
	    push(@return,$line);
	}
    }

    @return;
}


package apath;

sub get_options
{
    local($opt) = @_;

    $long		= 0;
    $abbrv		= 0;
    $delete		= 0;
    $unique		= 0;
    $validate		= 0;
    $links		= 0;
    $variable		= 0;
    $tilde		= 0;

    foreach(split(//,$opt))
    {
	if ($_ eq 'a')		# Abbreviated long-output
	{
	    $long = 1;
	    $abbrv = 1;
	}
	elsif ($_ eq 'n')		# Delete paths that are not simplified.
	{
	    $delete = 1;
	}
	elsif ($_ eq 'e')		# Validate that files exist
	{
	    $validate = 1;
	}
	elsif ($_ eq 'l')		# Long output
	{
	    $long = 1;
	    $abbrv = 0;
	}
	elsif ($_ eq 'u')		# Uniquify output
	{
	    $unique = 1;
	}
	elsif ($_ eq 't')		# Tilde (~) expansion
	{
	    $tilde = 1;
	}
	elsif ($_ eq 'v')		# Variable (/foo/${BAR}) expansion
	{
	    $variable = 1;
	}
	elsif ($_ eq 's')		# Resolve symlinks
	{
	    $links = 1;
	}
    }
}

# This subroutine resolves ~ and variable abbreviations

sub expand_name
{
    local($file) = @_;

    if ($tilde && $file =~ /^\~/)
    {
	$file =~ s%^\~([^/]*)%%;
	$tname = $1;
	if ($tname eq '')
	{
	    $tname = getlogin;
	}
	@pwd = getpwnam($tname);
	if (@pwd)
	{
	    $file = $pwd[7] . $file;
	}
    }

    while ($variable && $file =~ /\$\{(\w+)\}/)
    {
	local($var) = $ENV{$1};
	$file =~ s/\$\{\w+\}/$var/;
    }
    $_[0] = $file;
}

# This subroutine follows a file-path, element by element, and determines what
# it's hard path is (i.e. the path without any symbolic links, and no .'s or
# ..'s, except at the beginnings of relative-paths).
#
# It's return is a two-element list of the hard path, and the line to print.
# The format of the line to print is dependant on the values of $long and
# $abbrv.
#
# No globals are modified.
sub follow
{
    local($exist,$_) = ((-e $_[0]), @_);
    local($line,$abs,$tmp,$link,@path_stack);

    if ($long)
    {
	$line = "$_:";
	$line .= "\n" unless ($abbrv);
    }

    # Split up the path, and initialize the stack.
    if (/^\/+$/)
    {
	push(@path_stack,'');
    }
    else
    {
	@path_stack = split(m./+.,$_);
    }

    # Pop each element off of the stack, pushing elements on, when a
    # symbolic-link is encountered. As elements are poped off, they
    # are added to the end of $abs, which is the file's "hard path-name"
    while(defined($elem = shift(@path_stack)))
    {
	# $elem eq '' means a null path-element. Could be ''/'foo'
	if ($elem eq '' || $elem eq '.')
	{
	    $abs = '/' if ($elem eq '' && $abs eq '');
	    next;
	}

	# Resolve .. in path-names.
	if ($abs && $elem eq '..')
	{
	    if ($abs =~ m%^\.\.(/\.\.)*$%)
	    {
		$abs .= '/..';
	    }
	    elsif ($abs ne '/')
	    {
	    	$abs =~ s%[^/]+$%%;
	    	$abs = '.' if $abs eq '';
	    	$abs =~ s%/+$%% unless $abs eq '/';
	    }
	    next;
	}

	# Don't add a / if nothing there yet.
	$tmp = $abs . (($abs eq '' || $abs =~ m%/$%)?'':'/') . $elem;

	# Check for symbolic-links.
	if ($exist && $links && defined($link = readlink($tmp)))
	{
	    $line .= "\t\t$tmp -> $link\n" if ($long && !$abbrv);
	    $abs = '' if substr($link,0,1) eq '/';
	    unshift(@path_stack,split(m./+.,$link));
	}
	else
	{
	    $abs = $tmp;
	}
    }
    $abs = '.' if $abs eq '';
    $line .= "\t" if ($long && !$abbrv);
    $line .= $abs;
    ($abs,$line);
}

1;
-----------------CUT HERE-----------
--
--------
Disclaimer: I am solely responsible for the content of this message.
The views expressed here may not be the views of I-Kinetics, Fidelity,
any of the Fidelity-owned corporations or my mother.
Newsgroups: comp.lang.perl