package File::Spec::Link;

use strict;
use warnings;

require File::Spec;
push our @ISA, qw(File::Spec);

our $VERSION = 0.080;

# over-ridden class method - just a debugging wrapper
#
sub canonpath {
    my ( $spec, $path ) = @_;
    return $spec->SUPER::canonpath($path) if $path;
    require Carp;
    Carp::cluck( "canonpath: ",
        defined $path ? "empty path" : "path undefined" );
    return $path;
}

sub catdir {
    my $spec = shift;
    return @_ ? $spec->SUPER::catdir(@_) : $spec->curdir;
}

# new class methods - implemented via objects
#
sub linked {
    my $self = shift->new(@_);
    return unless $self->follow;
    return $self->path;
}

sub resolve {
    my $self = shift->new(@_);
    return unless $self->resolved;
    return $self->path;
}

sub resolve_all {
    my $self = shift->new(@_);
    return unless $self->resolvedir;
    return $self->path;
}

sub relative_to_file {
    my ( $spec, $path ) = splice @_, 0, 2;
    my $self = $spec->new(@_);
    return unless $self->relative($path);
    return $self->path;
}

sub chopfile {
    my $self = shift->new(@_);
    return $self->path if length( $self->chop );
    return;
}

# other new class methods - implemented via Cwd
#
sub full_resolve {
    my ( $spec, $file ) = @_;
    my $path = $spec->resolve_path($file);
    return defined $path ? $path : $spec->resolve_all($file);
}

sub resolve_path {
    my ( $spec, $file ) = @_;
    my $path = do {
        local $SIG{__WARN__} = sub {
            if (    $_[0] =~ /^opendir\b/
                and $_[0] =~ /\bNot\s+a\s+directory\b/
                and $Cwd::VERSION < 2.18
                and not -d $file )
            {
                warn <<WARN;
Cwd::abs_path() only works on directories, not: $file
Use Cwd v2.18 or later
WARN
            }
            else {
                warn $_[0];
            }
        };
        eval { require Cwd } && Cwd::abs_path($file);
    };
    return unless $path;
    return $spec->file_name_is_absolute($file) ? $path : $spec->abs2rel($path);
}

# old class method - not needed
#
sub splitlast {
    my $self      = shift->new(@_);
    my $last_path = $self->chop;
    return ( $self->path, $last_path );
}

# object methods:
# 	constructor methods	new
# 	access methods		path, canonical, vol, dir
# 	updating methods	add, pop, push, split, chop
# 				relative, follow, resolved, resolvedir

sub new {
    my $self = bless {}, shift;
    $self->split(shift) if @_;
    return $self;
}

sub path {
    my $self = shift;
    return $self->catpath( $self->vol, $self->dir, q{} );
}
sub canonical { my $self = shift; return $self->canonpath( $self->path ); }
sub vol       { my $vol  = shift->{vol};  return defined $vol ? $vol : q{} }
sub dir       { my $self = shift;         return $self->catdir( $self->dirs ); }
sub dirs      { my $dirs = shift->{dirs}; return $dirs ? @{$dirs} : () }

sub add {
    my ( $self, $file ) = @_;
    if    ( $file eq $self->curdir ) { }
    elsif ( $file eq $self->updir )  { $self->pop }
    else                             { $self->push($file); }
    return;
}

sub pop {
    my $self = shift;
    my @dirs = $self->dirs;
    if ( not @dirs or $dirs[-1] eq $self->updir ) {
        push @{ $self->{dirs} }, $self->updir;
    }
    elsif ( length $dirs[-1] and $dirs[-1] ne $self->curdir ) {
        CORE::pop @{ $self->{dirs} };
    }
    else {
        require Carp;
        Carp::cluck( "Can't go up from ",
            length $dirs[-1] ? $dirs[-1] : "empty dir" );
    }
    return;
}

sub push {
    my $self = shift;
    my $file = shift;
    CORE::push @{ $self->{dirs} }, $file if length $file;
    return;
}

sub split {
    my ( $self, $path ) = @_;
    my ( $vol, $dir, $file ) = $self->splitpath( $path, 1 );
    $self->{vol}  = $vol;
    $self->{dirs} = [ $self->splitdir($dir) ];
    $self->push($file);
    return;
}

sub chop {
    my $self = shift;
    my $dirs = $self->{dirs};
    my $file = '';
    while (@$dirs) {
        last if @$dirs == 1 and not length $dirs->[0];    # path = '/'
        last if length( $file = CORE::pop @$dirs );
    }
    return $file;
}

sub follow {
    my $self = shift;
    my $path = $self->path;
    my $link = readlink $self->path;
    return $self->relative($link) if defined $link;
    require Carp;
    Carp::confess(
        "Can't readlink ",
        $self->path, " : ", 
        ( -l $self->path ? "but it is" : "not" ),
        " a link"
    );
}

sub relative {
    my ( $self, $path ) = @_;
    unless ( $self->file_name_is_absolute($path) ) {
        return unless length( $self->chop );
        $path = $self->catdir( $self->path, $path );
    }

    # what we want to do here is just set $self->{path}
    # to be read by $self->path; but would need to
    # unset $self->{path} whenever it becomes invalid
    $self->split($path);
    return 1;
}

sub resolved {
    my $self = shift;
    my $seen = @_ ? shift : {};
    while ( -l $self->path ) {
        return if $seen->{ $self->canonical }++;
        return unless $self->follow;
    }
    return 1;
}

sub resolvedir {
    my $self = shift;
    my $seen = @_ ? shift : {};
    my @path;
    while (1) {
        return unless $self->resolved($seen);
        my $last = $self->chop;
        last unless length $last;
        unshift @path, $last;
    }
    $self->add($_) for @path;
    return 1;
}

1;

__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

File::Spec::Link - Perl extension for reading and resolving symbolic links

=head1 SYNOPSIS

    use File::Spec::Link;
    my $file = File::Spec::Link->linked($link); 
    my $file = File::Spec::Link->resolve($link); 
    my $dirname = File::Spec::Link->chopfile($file);
    my $newname = File::Spec::Link->relative_to_file($path, $link);
  
    my $realname = File::Spec::Link->full_resolve($file);
    my $realname = File::Spec::Link->resolve_path($file);
    my $realname = File::Spec::Link->resolve_all($file);

=head1 DESCRIPTION

C<File::Spec::Link> is an extension to C<File::Spec>, adding methods for
resolving symbolic links; it was created to implement C<File::Copy::Link>.

=over

=item C<< linked($link) >>

Returns the filename linked to by C<$link>: by C<readlink>ing C<$link>,
and resolving that path relative to the directory of C<$link>. 

=item C<< resolve($link) >>

Returns the non-link ultimately linked to by C<$link>, by repeatedly
calling C<linked>.  Returns C<undef> if the link can not be resolved.

=item C<< chopfile($file) >>

Returns the directory of C<$file>, by splitting the path of C<$file>
and returning (the volumne and) directory parts.

=item C<< relative_to_file($path, $file) >>

Returns the path of C<$path> relative to the directory of file
C<$file>.  If C<$path> is absolute, just returns C<$path>.

=item C<< resolve_all($file) >>

Returns the filename of C<$file> with all links in the path resolved,
wihout using C<Cwd>.

=item C<< full_resolve($file) >>

Returns the filename of C<$file> with all links in the path resolved.

This sub tries to use C<Cwd::abs_path> via C<< ->resolve_path >>.

=item C<< resolve_path($file) >>

Returns the filename of C<$file> with all links in the path resolved.

This sub uses C<Cwd::abs_path> and is independent of the rest of
C<File::Spec::Link>. 

=back
 
=head2 Object methods 

=over 4

=item C<< new([$path]) >>

create new path object: stores path as a list

=item C<< path >>

returns path as a string, using catpath

=item C<< canonical >>

returns canonical path, using canonpath

=item C<< vol >>

returns volume element of path, see File::Spec->splitpath

=item C<< dir >>

returns directory element of path, as a string, see File::Spec->splitpath

=item C<< dirs >>

return list of directory components in path, see File::Spec->splitdir
	
=item C<< pop >>

remove last component of the path 

=item C<< push($file) >>

add a file component to the path, ignoring empty strings

=item C<< add($file) >>

add a component to the path:
treating C<updir> as C<pop>,
and ignoring C<curdir> and empty strings

=item C<< split($path) >>

populate a path object, using splitpath

=item C<< chop >>

remove and return a file component from path, 
an empty string returns means this was root dir.
    
=item C<< relative($path) >>

replace the path object with the supplied path,
where the new path is relative to the path object

=item C<< follow >>

follow the link, where the path object is a link 

=item C<< resolved >>

resolve the path object, by repeatedly following links
 
=item C<< resolvedir >>

resolve the links at all component levels  within the path object

=back

=head2 Other class methods

=over 4

=item C<< canonpath($path) >>

Wrapper round File::Spec::canonpath, fatal if empty input

=item C<< catdir(@dirs) >>

Wrapper round File::Spec::catdir, returns C<curdir> from empty list

=item C<< splitlast($path) >>

Get component from C<$path> (using C<chop>)
and returns remaining path and compenent, as strings.
[Not used]

=back

=head2 EXPORT

None - all subs are methods for C<File::Spec::Link>.

=head1 SEE ALSO

File::Spec(3) File::Copy::Link(3)

=head1 AUTHOR

Robin Barker, <RMBarker@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2003, 2005, 2006, 2007, 2011, 2014, 2024 by Robin Barker

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

$Id$