File Coverage

blib/lib/P4/C4/Path.pm

Criterion	Covered	Total	%
statement	40	43	93.0
branch	9	12	75.0
condition			n/a
subroutine	6	7	85.7
pod	3	3	100.0
total	58	65	89.2

# $Revision: 709 $$Date: 2005-05-03 17:32:07 -0400 (Tue, 03 May 2005) $$Author: wsnyder $
# Author: Wilson Snyder
######################################################################
#
# Copyright 2002-2005 by Wilson Snyder.  This program is free software;
# you can redistribute it and/or modify it under the terms of either the GNU
# General Public License or the Perl Artistic License.
#
# 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.  See the
# GNU General Public License for more details.
#
######################################################################

package P4::C4::Path;
use File::Spec;
use File::Spec::Functions;
use Cwd qw(getcwd);
use strict;

require Exporter;
our @ISA = ('Exporter');
our @EXPORT = qw( fileNoLinks );
our $VERSION = '2.041';

######################################################################

sub isDepotFilename {
    my $filename = shift;
    return ($filename =~ m%^//%);
}

sub fileDePerforce {
    my $filename = shift;
    # Strip perforce specifics
    $filename =~ s/\.\.\.$//;
    $filename =~ s![/\\]$!!;
    # On Windows, Repositories always use / but filenames want backslashes
    # We'll take either, then make them native
    my @dirs = split /[\\\/]/, $filename;
    return fileNoLinks(catfile(@dirs));
}

sub fileNoLinks {
    my $filename = shift;
    # Remove any symlinks in the filename
    # Perforce doesn't allow "cd ~/sim/project" where project is a symlink!
    # Modified example from the web

    #print "FNLinp: $filename\n";
    $filename = File::Spec->rel2abs($filename);
    my @right = File::Spec->splitdir($filename);
    my @left;

    while (@right) {
	#print "PARSE: ",catfile(@left),"  --- ",catfile(@right),"\n";
	my $item = shift @right;
	next if $item eq ".";
	if ($item eq "") {
	    push @left, $item;
	    next;
	}
	elsif ($item eq "..") {
	    pop @left if @left > 1;
	    next;
	}

	my $link = readlink (catfile(@left, $item));

	if (defined $link) {
	    if (file_name_is_absolute($link)) {
		@left = File::Spec->splitdir($link);
	    } else {
		unshift @right, File::Spec->splitdir($link);
	    }
	    # Start search over, as we might have more links to resolve
	    unshift @right, @left;
	    @left = ();
	    next;
	} else {
	    push @left, $item;
	    next;
	}
    }
    my $out = catfile(@left);
    #print "FNLabs: $out\n";
    return $out;
}

######################################################################
### Package return
1;
__END__