view release on metacpan or  search on metacpan

lib/Date/Manip/DM5.pm  view on Meta::CPAN

  } else {
    # 0 to N-1
    if ($$val>($N-1)) {
      $$rem+= int($$val/$N);
      $$val = $$val%$N;
    } elsif ($$val<0) {
      $$rem-= int(-($$val+1)/$N)+1;
      $$val = ($N-1)-(-($$val+1)%$N);
    }
  }
}

# $Flag=_IsInt($String [,$low, $high]);
#    Returns 1 if $String is a valid integer, 0 otherwise.  If $low is
#    entered, $String must be >= $low.  If $high is entered, $String must
#    be <= $high.  It is valid to check only one of the bounds.
sub _IsInt {
  my($N,$low,$high)=@_;
  return 0  if (! defined $N  or
                $N !~ /^\s*[-+]?\d+\s*$/  or
                defined $low   &&  $N<$low  or
                defined $high  &&  $N>$high);
  return 1;
}

# $File=_CleanFile($file);
#   This cleans up a path to remove the following things:
#     double slash       /a//b  -> /a/b
#     trailing dot       /a/.   -> /a
#     leading dot        ./a    -> a
#     trailing slash     a/     -> a
sub _CleanFile {
  my($file)=@_;
  $file =~ s/\s*$//;
  $file =~ s/^\s*//;
  $file =~ s|//+|/|g;  # multiple slash
  $file =~ s|/\.$|/|;  # trailing /. (leaves trailing slash)
  $file =~ s|^\./||    # leading ./
    if ($file ne "./");
  $file =~ s|/$||      # trailing slash
    if ($file ne "/");
  return $file;
}

# $File=_ExpandTilde($file);
#   This checks to see if a "~" appears as the first character in a path.
#   If it does, the "~" expansion is interpreted (if possible) and the full
#   path is returned.  If a "~" expansion is used but cannot be
#   interpreted, an empty string is returned.
#
#   This is Windows/Mac friendly.
#   This is efficient.
sub _ExpandTilde {
  my($file)=shift;
  my($user,$home)=();
  # ~aaa/bbb=      ~  aaa      /bbb
  if ($file =~ s|^~([^/]*)||) {
    $user=$1;
    # Single user operating systems (Mac, MSWindows) don't have the getpwnam
    # and getpwuid routines defined.  Try to catch various different ways
    # of knowing we are on one of these systems:
    return ""  if ($OS eq "Windows"  or
                   $OS eq "Mac"  or
                   $OS eq "Netware"  or
                   $OS eq "MPE");
    $user=""  if (! defined $user);

    if ($user) {
      $home= (getpwnam($user))[7];
    } else {
      $home= (getpwuid($<))[7];
    }
    $home = VMS::Filespec::unixpath($home)  if ($OS eq "VMS");
    return ""  if (! defined $home);
    $file="$home/$file";
  }
  $file;
}

# $File=_FullFilePath($file);
#   Returns the full or relative path to $file (expanding "~" if necessary).
#   Returns an empty string if a "~" expansion cannot be interpreted.  The
#   path does not need to exist.  _CleanFile is called.
sub _FullFilePath {
  my($file)=shift;
  my($rootpat) = '^/'; #default pattern to match absolute path
  $rootpat = '^(\\|/|([A-Za-z]:[\\/]))' if ($OS eq 'Windows');
  $file=_ExpandTilde($file);
  return ""  if (! defined $file);
  return _CleanFile($file);
}

# $Flag=_CheckFilePath($file [,$mode]);
#   Checks to see if $file exists, to see what type it is, and whether
#   the script can access it.  If it exists and has the correct mode, 1
#   is returned.
#
#   $mode is a string which may contain any of the valid file test operator
#   characters except t, M, A, C.  The appropriate test is run for each
#   character.  For example, if $mode is "re" the -r and -e tests are both
#   run.
#
#   An empty string is returned if the file doesn't exist.  A 0 is returned
#   if the file exists but any test fails.
#
#   All characters in $mode which do not correspond to valid tests are
#   ignored.
sub _CheckFilePath {
  my($file,$mode)=@_;
  my($test)=();
  $file=_FullFilePath($file);
  $mode = ""  if (! defined $mode);

  # Run tests
  return 0  if (! defined $file or ! $file);
  return 0  if ((                  ! -e $file) or
                ($mode =~ /r/  &&  ! -r $file) or
                ($mode =~ /w/  &&  ! -w $file) or
                ($mode =~ /x/  &&  ! -x $file) or
                ($mode =~ /R/  &&  ! -R $file) or
                ($mode =~ /W/  &&  ! -W $file) or
                ($mode =~ /X/  &&  ! -X $file) or
                ($mode =~ /o/  &&  ! -o $file) or
                ($mode =~ /O/  &&  ! -O $file) or
                ($mode =~ /z/  &&  ! -z $file) or
                ($mode =~ /s/  &&  ! -s $file) or
                ($mode =~ /f/  &&  ! -f $file) or
                ($mode =~ /d/  &&  ! -d $file) or
                ($mode =~ /l/  &&  ! -l $file) or
                ($mode =~ /s/  &&  ! -s $file) or
                ($mode =~ /p/  &&  ! -p $file) or