=head1 NAME

CFX5::FileOps - Functions for manipulating files

=head1 SYNOPSIS

This module provides a set of functions for manipulating files in
an architecture-independent way.

=cut

package CFX5::FileOps;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
@ISA=qw(Exporter);
@EXPORT_OK=qw(copy_file move_file move_file_to_backup copy_file_for_read link_files
              create_empty_file concatenate_files create_directory
              get_file_contents set_file_contents append_to_file
              glob_suffix
              find_executable select_execarch
              safe_set_file_contents unique_file_rename get_file_extension
              find_files_by_extension grant_write_to_read_only make_writable
             );

#%EXPORT_TAGS=(
#              std => [qw(getconf setconf)]
#             );

use File::Copy;

# for the compiler; this is needed by File::Copy, but it's done
# dynamically.  Also we make sure we don't pick up the definitions of
# dirname and basename from File::Basename.
BEGIN {
  require File::Basename;
  *File::Copy::basename = \&File::Basename::basename;
  *File::Copy::dirname = \&File::Basename::dirname;
}

use CFX5::Config qw(%Config);
use CFX5::Commands qw(do_cmd parse_rv);

use CFX5::PathManip qw(join_file split_file relative_path dirname basename fullpath);

use CFX5::Output ':all';
use CFX5::FileTests;

use CFX5::Arch;

use CFX5::FileStat;

use CFX5::PkgLoader qw(cfx5_require);

=head1 LINKING AND COPYING

There are many different ways to make one file a "duplicate" of another, and
many different reasons; for example, you might want to save disk space by having
the same name point to two different files in a test deck, or you might want to
be able to update a file by one name and read it by another. These functions
allow you to easily do the "best thing" that is allowed by your OS to satisfy
your requirements.

Some of these functions are just calls to existing Perl functions (see L<File::Copy>)
provided here for consistency. Where possible, we use the standard OS commands
which do these jobs, as they are probably faster, unless the environment variable
C<CFX_AVOID_SHELL_COMMANDS> is set to a non-zero value.

=head2 can_symlink

  CFX5::FileOps::can_symlink() or die "Need to be able to symlink";

Tests whether this version of Perl supports the C<symlink> call, and returns
success or failure. This function cannot be exported.

=cut

use vars qw($CanSymlink $CanHardlink);
$CanSymlink=undef;
$CanHardlink=undef;
sub can_symlink {
  return '' if $Config{CFX5_DISABLE_SYMLINKS};
  return $CanSymlink if defined $CanSymlink;
  $CanSymlink = eval { symlink("",""); 1; };
  return $CanSymlink;
}

=head2 can_hardlink

  CFX5::FileOps::can_hardlink() or die "Need to be able to hardlink";

Tests whether this version of Perl supports the C<link> call, and returns
success or failure. This function cannot be exported.

=cut

sub can_hardlink {
  return '' if $Config{CFX5_DISABLE_HARDLINKS};
  return $CanHardlink if defined $CanHardlink;
  $CanHardlink = eval { link("",""); 1; };
  return $CanHardlink;
}

=head2 copy_file

  copy_file("$file.res", "$file.res.bak");

Make a totally independent copy of a file. ("cp")

=cut

sub copy_file {
  return copy(@_);
}

=head2 move_file

  move_file("$file.res", "$file.res.bak");

Move the data in a file from one name to another. ("mv")

=cut

sub move_file {
  return move(@_);
}

=head2 move_file_to_backup

  move_file("$file.res", "$file.res.bak");

This function is just like C<move_file>, but it ensures that the destination
file is removed before doing the rename, making it ideal for backing up files.

=cut

sub move_file_to_backup {
  my $from=shift;
  my $to=shift;

  if (test_e $to) {
    unlink($to) or return 0;
  }
  return move_file($from, $to);
}

=head2 copy_file_for_read

  copy_file_for_read("$testroot/data/$file.ses", "$file.ses");

Make a copy of the first argument accessible by the name in the second
argument, saving on disc space by linking the two together somehow if
possible. ("ln -s" on UNIX; usually a copy on NT).  If the destination
file exists, this will cause an error.

=cut

sub copy_file_for_read {
  my $from=shift;
  my $to=shift;

  if (can_symlink()) {
    my $dest=relative_path($to, $from);
    if (!(my $rv=symlink($dest, $to))) {
      _debug("Failed to symlink with error \"$!\", trying to copy");
      # we thought we could symlink, but apparently we were wrong.
      # Maybe (eg, on SAMBA) we can still copy?  The only case I know
      # of which gives this is Linux SAMBA mounts, when $! eq
      # 'Operation not permitted', so we'll only retry then.
      if ($! =~ m!operation not permitted!i) {
        local $!; # if this fails too, preserve the original error message
        return copy_file($from, $to);
      }
      # otherwise, just as normal.
      return $rv;
    } else {
      # success
      return 1;
    }
  } else {
    return copy_file($from, $to);
  }
}

=head2 link_files

  link_files($from,$to);

  link_files("$problem.out","$rundir/out") or die "Error creating symlinK";

Link the two files such that updates in one file automatically appear
under the other name.

Under UNIX, this always creates a symbolic link C<$to> pointing to
C<$from>.  It is not always possible under Windows NT, so you should
be sure to check the return value.  Note that it can also fail
"legitimately" on some UNIX systems, for example SAMBA mounts under
Linux.

=cut

sub link_files {
  my $from=shift;
  my $to=shift;

  if (can_symlink()) {
    my $dest=relative_path($to, $from);
    _debug "Will create symlink $to to $from as $dest";
    return symlink($dest, $to);
  } elsif (can_hardlink()) {
    return link($from, $to);
  } elsif (-e join_file($Config{CFX5EXECDIR}, "ln.exe")) {
    # there's a version shipped with CFX-5
    my $rv=parse_rv(do_cmd(join_file($Config{CFX5EXECDIR},"ln.exe"),$from,$to));
    return $rv->{success};
  } else {
    # we're almost certainly on NT, but the NT resource kit provides a "ln"
    # command which does hard-links on NTFS. So let's see if we can find
    # that.
    my $rv=parse_rv(do_cmd("ln","$from","$to"));
    if ($rv->{run}) {
      # well, we got something. Any luck?
      if ($rv->{success}) {
        return 1;
      } else {
        return 0;
      }
    } else {
      # we don't use the CFX output functions here, we want this to appear
      # so people know what went wrong. I think.
      _warn("ANSYS CFX was unable to create a hard-link between\n",
            "two files. If you are using Windows NT, please\n",
            "ensure that a version of \"ln.exe\" (for example,\n",
            "the one which comes with the Windows NT Resource\n",
            "kit) is available on your PATH.\n\n");
    }
    return 0;
  }
}

=head2 concatenate_files

  concatenate_files("$problem.def", "$problem.ini" => "$rundir/def");

Creates the file in the last argument from the files in the other
arguments by concatenating them.  Return value is TRUE on success or
FALSE on failure.

=cut

sub concatenate_files {
  my $dest=pop;
  my @cmd;
  my $status;

  if ($Config{windows_nt} and !$Config{CFX_AVOID_SHELL_COMMANDS}) {
    # copy /b <file1> + <file2> <destfile>
    my $f;
    my @cmd=("copy","/b");
    for $f (@_) {
      push @cmd, $f, "+";
    }
    pop @cmd;
    push @cmd, $dest;
    my $rv=system(@cmd);
    my $rh=parse_rv($rv);
    return $rh->{success};
  } else {
    # using cat would be easier, but this way we avoid having to use
    # shell metacharacters. This code is based on code in File::Copy.

    my $f;
    open TOFILE, ">$dest" or goto fail_open1;
    binmode TOFILE or goto fail_open2;

    for $f (@_) {
      open FROMFILE, $f or goto fail_open2;
      binmode FROMFILE or goto fail_inner;

      # what size buffer to use? Try to use the same size as the file,
      # but limit it to 2Mb
      my $size=-s $f;
      $size=2*1024*1024 if ($size > 2*1024*1024);

      my $buf;

      # now do the copy
      $!=0;
      for (;;) {
        my ($r, $w, $t);
        defined($r = sysread(FROMFILE, $buf, $size)) or goto fail_inner;
        last unless $r;

        for ($w = 0; $w < $r; $w += $t) {
         $t = syswrite(TOFILE, $buf, $r - $w, $w) or goto fail_inner;
        }
      }

      # close this filehandle, ready for the next
      close FROMFILE or goto fail_open2;
    }

    close TOFILE or goto fail_open1;

    return 1;

    # preserve $! and close all filehandles before returning
   fail_inner:
    $status = $!;
    $! = 0;
    close FROMFILE;
    $! = $status unless $!;
   fail_open2:
    $status = $!;
    $! = 0;
    close TOFILE;
    $! = $status unless $!;
   fail_open1:
    return 0;
  }

  # we should never get here
}

=head1 FILE CREATION

=head2 create_empty_file

  create_empty_file("out");

Creates an empty file with the given name, or returns an error if the named
file already exists.

This translates into a call to C<sysopen> with C<O_CREAT>, and so on a
local filesystem it is atomic and could safely be used for creating lock
files. Unfortunately, this is not true over NFS, so if the locking is
important I suggest you try something else.

=cut

sub create_empty_file {
  local *FH;

  cfx5_require('POSIX');
  my $fileperms = POSIX::O_WRONLY() | POSIX::O_EXCL() | POSIX::O_CREAT();

  # sysopen was used in the FAQ, but is not documented anywhere? This whole
  # stanza, in fact, is based on code from the FAQ.
  sysopen(FH, $_[0], $fileperms)
    or goto open_fail;
  print FH "" or goto close_fail;
  close FH    or goto close_fail;

  return 1;

  my $status;
 close_fail:
  $status=$!;
  close FH;
  $!=$status;
 open_fail:
  return 0;
}

=head2 create_directory

  create_directory("C:\\TEMP\\CFX\\5.3dev");

Creates a directory with read/write permissions as per the user's umask (on UNIX), creating all subdirectories if required.

=cut '

sub create_directory {
  my $dir=shift;

  my @comps=split_file(fullpath($dir));
  my @root;
  _debug(join(", ", map { qq("$_") } @comps));
  # got a drive letter?
  if ( $comps[0] =~ m/^\w:/ ) {
    push @root, shift @comps;
  }
  # or a UNC share?  After we split the filenames, a UNC share
  # (\\server\share\whatever) will retain a single slash in the first
  # directory entry.  Because testing whether \\server is a directory
  # will always fail, we need to snarf two pathname components here
  # before we start trying.
  elsif ( $comps[0] eq '' and @comps > 1 and $comps[1] =~ m!^[\\/]! ) {
    push @root, shift @comps;
    push @root, shift @comps;
  }
  my $root = join_file(@root);
  for my $d (@comps) {
    # we never try to make "/", but hey ...
    $root=join_file($root,$d);
    _debug("Testing $root ...");
    unless (-d $root) {
      _debug("  ... trying to make");
      unless (mkdir($root, 0777)) {
        _debug("  ... Ooops.");
        return 0;
      }
    }
  }
  return 1;
}

=head1 FILE EDITING

=head2 get_file_contents

  $text=get_file_contents($file);

A shortcut to reading a file, simply slurps it all into memory at
once, and then returns it.  Return value is undef if the read fails.

=cut

sub get_file_contents {
  my $file=shift;
  local *FILE;
  open FILE, "<$file" or return undef;
  my $cont;
  {
    local $/=undef;
    $cont=<FILE>;
  }
  close FILE;
  return $cont;
}

=head2 set_file_contents

  set_file_contents($file,@text);

Writes the text to the named file.  The file need not exist.  This is
the same as C<append_to_file> except it will overwrite any existing
data.

=cut

sub set_file_contents {
  my $file=shift;
  local *FILE;
  open FILE, ">$file" or return 0;
  foreach (@_) { print FILE $_; };
  close FILE or return 0;
  1;
}

=head2 append_to_file

  append_to_file($file,@text);

Appends the text to the named file.  The file need not exist.

=cut

sub append_to_file {
  my $file=shift;
  local *FILE;
  open FILE, ">>$file" or return 0;
  foreach (@_) { print FILE $_; };
  close FILE or return 0;
  1;
}

=head1 DIRECTORY LISTING and GLOBBING

The functions in this section portably expand shell globs of various sorts,
as well as some non-shell globs.

Suggested use is to always use C<glob_suffix> or C<glob_regexp> for globs
from the script, and C<glob_native> if you want to expand a glob from user input.

=head2 glob_suffix

  @cfiles=glob_suffix("$srcdir/.c");

This is (probably) the fastest of the glob functions, and just looks
for files in the named directory with the given suffix. The list
returned includes the directory name passed to the function. If called
in a scalar context, returns the number of files which matched. If the
suffix is empty (ie, the path ends with a directory separator
character), all files are returned.

If an error occurs reading the directory, the return value in a list context
is a list with one member, C<undef>, or in a scalar context just C<undef>.
If no files match the pattern, returns an empty list, or 0 in a scalar context.

If the second argument is TRUE, matching is case-sensitive; if FALSE, it is
case-insensitive. If there is no second argument, the default depends on the
operating system.

=cut

sub glob_suffix {
  my $glob=shift;

  internal_error("Missing argument") unless defined $glob;

  my $ignore_case=shift;
  $ignore_case=(defined $ignore_case ? $ignore_case : $Config{windows_nt});

  my $dir=dirname($glob);
  my $suff=basename($glob);
  $suff='' unless defined $suff;

  my @files;

  # make sure this is our own copy of the GLOBDIR handle
  local *GLOBDIR;
  opendir GLOBDIR, $dir
    or return (wantarray ? (undef) : undef);

  my $slen=length($suff);

  $suff=lc($suff) if ($ignore_case);

  # read this into an array so we can modify the values later
  @files=readdir(GLOBDIR);
  closedir GLOBDIR;

  _debug("Files are", join(", ",@files));

  # this line does the glob!
  @files=map { join_file($dir,$_) } (grep { lc(substr($_,-$slen)) eq $suff } @files)
    if (length($suff) > 0);

  _debug("Filtered files are", join(", ",@files));

  return @files;
}

=head1 OPTIMISED FILE LOCATION

The routine(s) in this section are designed to find and select
optimised executables, which may be in different directories and so
on.  See the L<IPRODUCT.MULTARCH.DESIGN.5.4> document for more
details.

=head2 find_executable

  calc_executable(CFX_SOLVER_EXEC => 'solver.exe', "ANSYS CFX Solver Executable");

This call implements the algorithm as set out in
L<IPRODUCT.MULTARCH.DESIGN.5.4> for determining which executable to
use for a given component.  As arguments, it takes the configuration
variable corresponding to the executable, and the filename of the
executable.  To find the correct architecture:

=over

=item 1.

If the configuration variable is already set, that's the answer.

=item 2.

If the configuration record I<whatever>C<_ARCH> is set (eg,
C<CFX_SOLVER_EXEC_ARCH> for the call above), then that provides the
architecture.

=item 3.

If the config record C<CFX5ARCH> is set, that overrides any automatic
selection, and is used.

=item 4.

Otherwise, we do the automatic selection based on the architecture
name (see C<select_execarch>).

=back

This information is then combined with the current arch type, from
config record I<whatever>C<_TYPE> (eg C<CFX_SOLVER_EXEC_TYPE> if set),
or C<CFX5_ARCH_TYPE>, and the current bin directory C<CFX5BINDIR>, to
get the final result.

The executable name is then recorded in the named configuration
record, and returned.  If we have an architecture -- cases 2, 3 and 4
-- that is recorded in the I<whatever>C<_ARCH> variable which would
have been read in case 2.

If problems are encountered, the third parameter is a descriptive
string used in the error messages, which are signalled via C<_error>.

For regression testing purposes, if it is desired to force the use of
non-optimsed architectures, the C<CFX5ARCH> variable may be set to
the value of C<CFX5OS>.

=cut '

sub find_executable {
  my $confrec=shift;
  my $exec=shift;
  my $desc=shift || "$exec Executable";

  # even if we're called from another get_conf, it's
  # recursion-protected.
  if (defined $Config{$confrec}) {
    return $Config{$confrec};
  }

  # which attributes are we using in the search?
  my $type;
  if (defined $Config{$confrec.'_TYPE'}) {
    $type=$Config{$confrec.'_TYPE'};
  } else {
    $type=$Config{CFX5_ARCH_TYPE};
  }

  # here we do want to remove default attributes (cf select_execarch),
  # as the whole function is local-host-specific
  cfx5_require('CFX5::Attr');
  $type = CFX5::Attr->MakeType($type);

  # find the arch
  my $arch;
  if (defined $Config{$confrec.'_ARCH'}) {
    $arch=$Config{$confrec.'_ARCH'};
  } elsif (defined $Config{'CFX5ARCH'}) {
    $arch=$Config{'CFX5ARCH'};
  }
  if (defined $arch) {
    # users shouldn't usually do this.
    _note("Using explicitly-supplied architecture $arch for $desc");
    1;
  } else {
    $arch=select_execarch($exec,
                          $Config{CFX5BINDIR},
                          $Config{CFX5_HOST_ARCH},
                          $type,
                          );
  }

  if (!defined $arch) {
    _error("Unable to locate a usable ", ($type ? "$type " : ()), "$desc for $Config{CFX5_HOST_ARCH}.  Please ensure that ANSYS CFX is correctly installed for this architecture.");
    return undef;
  }

  # record the arch
  $Config{$confrec.'_ARCH'}=$arch;

  # OK, got it; now what's the executable?
  my $res=join_file($Config{CFX5BINDIR},
                    $arch,
                    (defined $type and $type ne '' ? $type : ()),
                    $exec);
  unless (CFX5::FileTests::execfile($res, "$desc $res")) {
    # erm ... oops.  We've located one which doesn't exist.  Die.
    return undef;
  }

  # set the config record
  $Config{$confrec} = $res;

  # and return it
  $res;
}

=head2 select_execarch

  my $arch=select_execarch('solver.exe',
                           $Config{CFX5BINDIR},
                           $Config{CFX5_HOST_ARCH},
                           $Config{CFX5_ARCH_TYPE}
                          );

Given the criteria used to select an executable, looks in the given
directory to find one.  The parameters are, in order:

=over

=item executable

The name of the executable to look for.

=item rootdir

The directory at which the tree is based.

=item hostarch

The architecture string for the host we are running on, or for the
host on which we want to run this executable.

=item attrs

The attributes we are looking for.  If this parameter is C<undef> (or
just missing), or the empty string, we are looking for a standard
executable.  Otherwise, it names a subdirectory of the arch
directories to look in for the executable.

Any default attributes will I<not> be removed -- if they were, this
function would be unusable for platforms with different defaults.  See
C<CFX5::Attrs::MakeType>.

=back

If called in a scalar context, returns the architecture of the "best"
executable to run.  In a list context, it returns the list of all
architectures which match the criteria (where one criterion is the
existance of the executable!).  If no executables can be found,
returns an empty list or undef.

=cut

sub select_execarch {
  my $exec=shift;
  my $base=shift;
  my $harch=shift;
  my $subdir=shift;

  my $hostarch=new CFX5::Arch($harch);

  unless (CFX5::FileTests::datadir($base)) {
    return wantarray ? () : undef;
  }

  # First of all, we look through all directories in the base
  # directory, looking for ones which match the hostarch.
  _debug("Searching for matches with $harch in $base");
  my @totry;
  local *DIR;
  opendir DIR, $base
    or _abort "Error selecting version of $exec from $base: Cannot list directory: $!";
  while (defined (my $dir=readdir DIR)) {
    next if substr($dir,0,1) eq '.';
    next unless -d join_file($base,$dir);
    next unless CFX5::Arch->is_valid_arch($dir);
    if ($hostarch->run_code_for(new CFX5::Arch($dir))) {
      _debug("Will try $dir");
      push @totry, $dir;
    }
  }
  closedir DIR;

  if (!@totry) {
    _debug("No matching directories at all");
    return wantarray ? () : undef;
  }

  # now, we need to see which of these contain the executable we're
  # interested in.  First, though, we sort them, so if we're in scalar
  # context we need fewer stats.
  @totry = sort {
    (new CFX5::Arch($b))->compare_codes(new CFX5::Arch($a))
  } @totry;

  my @subd=(defined $subdir && $subdir ne '') ? $subdir : ();

  _debug("Looking for", @subd, "$exec in", @totry);

  my @res;
  for my $dir (@totry) {
    my $posse=join_file($base,$dir,@subd,$exec);
    if (-e $posse) {
      # it's there.  If it's bad, we want to signal an error anyway,
      # even if we then succeed later.  I think.
      if (CFX5::FileTests::execfile($posse)) {
        unless(wantarray) {
          # only need one!
          return $dir;
        }
        push @res, $dir;
      }
    }
  }

  if (!@res) {
    # failed
    _debug("Failed");
    return wantarray ? () : undef;
  }

  # success, and we know we want a list, as we handled the scalar above
  @res;
}


=head2 safe_set_file_contents

  safe_set_file_contents($file,@text);

Writes the text to the named file.  The file need not exist.
If file does exist it will be re-named, hence no data will be over written.

=cut

sub safe_set_file_contents{
    my $FileName = shift;
    my @Data = @_;

    chomp($FileName);
    #if file exists then rename it with a unique name
    if (test_e $FileName){
       unless (unique_file_rename($FileName)) {
          _error("It was not possible to re-name file $FileName : $!");
          return 0;
       }
    }

    unless (set_file_contents($FileName, @Data)) {
        _error("Failed writing data to file $FileName : $!");
        return 0;
    }
    return 1;
}

=head2 unique_file_rename

  unique_file_rename($OriginalFile);

Re-names file to a unique file name (in the current directory).

=cut

sub unique_file_rename{
    my $OriginalFile = shift;
    my $StartNumber = 1;
    my $EndNumber = 1000;
    my $FileNameIncrement = $StartNumber;
    my $FileExtension = get_file_extension($OriginalFile);

    # remove file extension & create new name
    $OriginalFile =~ s!$FileExtension$!!;
    my $NewFileName = $OriginalFile.$FileNameIncrement.$FileExtension;

    # check if file exists & if true perform incremental re-name
    while (test_e $NewFileName){
        $FileNameIncrement++;
        $NewFileName = $OriginalFile.$FileNameIncrement.$FileExtension;
        if($FileNameIncrement > $EndNumber){
            _error("All files $OriginalFile$StartNumber$FileExtension to $OriginalFile$EndNumber$FileExtension exist, delete some of them : $!");
            return 0;
        }
    }

    unless(rename (($OriginalFile.$FileExtension), $NewFileName)){
        _error("Could not Re-Name File \"$OriginalFile$FileExtension\" to \"$NewFileName\ : $!");
        return 0;
    }
    _debug("File \"$OriginalFile$FileExtension\" re-named to \"$NewFileName\" \n");
    return 1;
}


=head2 get_file_extension

    get_file_extension($FileName);

Returns the extension the file past into the routine.
Returns nothing if the file has no extension.

=cut

sub get_file_extension{
  my $FileName=shift;
  chomp($FileName);

  if($FileName =~ m!(\.[^\.]+)$!){
      return $1;
  }else{
      _debug("File \"$FileName\" has no extension \n");
      return("");
  }
}


=head2 find_files_by_extension

   find_files_by_extension($files, $current_dir, $file_extension, $recursive)

$files is a refernce to hash that found files will be added to.
scans the dir ($current_dir) passed to the function for two things.

(1) files with file extension equal to $file_extension.
(2) directories

If a file with the correct extension is found then it is added to a hash of files.
If a directory then this function is called recusively with the $current_dir set to
this directory.

NB the dot part of an extension is optional

returns the reference to the hash of files found

=cut

sub find_files_by_extension{
   my $files = shift;
   my $current_dir = shift;
   my $file_extension = shift;
   my $recursive = shift;
   my $num_of_chars = length $file_extension;

   return 0 unless (-e $current_dir);
   return 0 unless (opendir (DIR, $current_dir));
   return 0 unless (my @names = readdir(DIR));
   return 0 unless closedir(DIR);

   foreach my $name (@names){
      next if ($name =~ m!^\.!);
      $name = $current_dir."/".$name;

      if (-d $name){

         if ($recursive){
            find_files_by_extension($files, $name, $file_extension, 1);
         }
         next;
      }

      if (substr($name, -$num_of_chars) eq $file_extension) {
         $files->{$name}++;
         _debug("\n$name");
      }
   }

   return 1;
}

=head2 make_writable

  make_writable($file);

Give user write permissions to a file.

=cut

sub make_writable {
  my $name=shift;
  my $mode = (stat($name))[2];

  unless ($mode & 0200) {
    my $output = sprintf "$name mode = %04o chmod = %04o", ($mode & 07777), (($mode | 0200) & 07777);
    _debug($output);
    unless (chmod ((($mode | 0200) & 07777), $name)) {
      _debug(" - failed: $!");
      return undef;
    }
  }

  1;
}


=head2 grant_write_to_read_only

   grant_write_to_read_only($current_dir, $recursive, $follow_sym_links)

scans the dir ($current_dir) passed to the function for two things

(1) files without write permission
(2) directories

If a file without write permission is found then a chmod u+w is attempted on it.
If a directory is found and $recursive then this function is called with the $current_dir
set to the 'found' directory.
if $follow_sym_links the symbolic links will be followed.

=cut

sub grant_write_to_read_only{
   my $current_dir = shift;
   my $recursive = shift;
   my $follow_sym_links = shift;

   return 0 unless (-e $current_dir);
   return 0 unless (opendir(DIR, $current_dir));
   return 0 unless (my @names = readdir(DIR));
   return 0 unless closedir(DIR);

   foreach my $name (@names){
      next if ($name =~ m!^\.!);
      $name = $current_dir."/".$name;

      if (-d $name){

         if ($recursive){

            if ((!(-l $name)) || ($follow_sym_links)){
               grant_write_to_read_only($name, $recursive, $follow_sym_links);
            }
         }
      }

      # check for dangling symlinks
      if (-e $name){
        # ignore failures, they're probably unimportant
        make_writable($name);
      }
   }

   return 1;
}


1;

