view release on metacpan or  search on metacpan

Recursive.pm  view on Meta::CPAN

    #while loop is needed to make it start over after each
    #match (as it will need to go back for parts of the
    #regex).  It's probably possible to write a regex to do it
    #without the while loop, but I don't think that making it
    #less readable is a good idea.  :)

    while ( $remote_pwd =~ s#(?:^|/)\.(?:/|$)#/# ) {}
    while ( $remote_pwd =~ s#(?:/[^/]+)?/\.\.(?:/|$)#/# ){}

    #the %linkMap will store as keys the absolute paths
    #to the links and the values will be the "real"
    #absolute paths to those locations (to take care of
    #../-type links

    $filename =~ s#/$##;
    $remote_pwd =~ s#/$##;

    $pwd =~ s#(?<!/)$#/#; #make sure there's a / on the end
    $linkMap{$pwd . $filename} = $remote_pwd;

    $remote_pwd; #return the result
}

=begin comment

  This subroutine takes two absolute paths and basically
  'links' them together.  The idea is that all of the paths
  that are created for the symlinks should be relative
  paths.  This is the sub that does that.

  There are essentially 6 cases:

    -Different root hierarchy:
    /tmp/testdata/blah -> /usr/local/bin/blah
    -Current directory:
    /tmp/testdata/blah -> /tmp/testdata
    -A file in the current directory:
    /tmp/testdata/blah -> /tmp/testdata/otherblah
    -Lower in same hierarchy:
    /tmp/testdata/blah -> /tmp/testdata/dir/otherblah
    -A higher directory along the same path (part of link abs path) :
    /tmp/testdata/dir/dir2/otherblah -> /tmp/testdata/dir
    -In same hierarchy, somewhere else:
    /tmp/testdata/dir/dir2/otherblah -> /tmp/testdata/dir/file

  The last two cases are very similar, the only difference
  will be that it will create '../' for the first rather
  than the possible '../../dir'.  The last case will indeed
  get the '../file'.

=end comment

=cut

sub convert_to_relative{
    my($link_loc, $realfile) = (shift, shift);
    my $i;
    my $result;
    my($new_realfile, $new_link, @realfile_parts, @link_parts);

    @realfile_parts = split m#/#, $realfile;
    @link_parts = split m#/#, $link_loc;

    for ( $i = 0; $i < @realfile_parts; $i++ ) {
        last unless $realfile_parts[$i] eq $link_parts[$i];
    }

    $new_realfile = join '/', @realfile_parts[$i..$#realfile_parts];
    $new_link = join '/', @link_parts[$i..$#link_parts];

    if( $i == 1 ){
        $result = $realfile;
    }
    elsif ( $i > $#realfile_parts and $i == $#link_parts  ) {
        $result = '.';
    }
    elsif ( $i == $#realfile_parts and $i == $#link_parts ) {
        $result = $realfile_parts[$i];
    }
    elsif ( $i >= $#link_parts  ) {
        $result = join '/', @realfile_parts[$i..$#realfile_parts];
    }
    else {
        $result = '../' x ($#link_parts - $i);
        $result .= join '/', @realfile_parts[$i..$#realfile_parts]
          if $#link_parts - $i > 0;
    }

    return $result;
}


package Net::FTP::Recursive::File;

use vars qw/@ISA/;
use Carp;

@ISA = ();

sub new{
    my $pkg = shift;

    my $self = { plainfile => 0,
                 directory => 0,
                 'symlink' => 0,
                 @_
               };

    croak 'Must set a filename when creating a File object!'
      unless defined $self->{filename};

    if( $self->{'symlink'} and not $self->{linkname} ){
        croak 'Must set a linkname when creating a File object for a symlink!';
    }

    bless $self, $pkg;
}

sub linkname{
    return $_[0]->{linkname};
}