X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/e31b4973197f7d0ca6b9ca5fbf2ba923d3ea63fe..f9e51fc19507839a1347b41967520814cd05bcd8:/modules/Tool.pm?ds=inline

diff --git a/modules/Tool.pm b/modules/Tool.pm
index 6a615da..a05b459 100644
--- a/modules/Tool.pm
+++ b/modules/Tool.pm
@@ -6,7 +6,7 @@ package Tool;
 # Some shared sub routines
 #
 # Author:        Patrick Canterino <patrick@patshaping.de>
-# Last modified: 2004-12-16
+# Last modified: 2005-01-04
 #
 
 use strict;
@@ -28,6 +28,7 @@ use base qw(Exporter);
 @EXPORT = qw(check_path
              clean_path
              devedit_reload
+             dos_wildcard_match
              equal_url
              file_name
              mode_string
@@ -53,8 +54,9 @@ sub check_path($$)
  $root = abs_path($root);
  $root = File::Spec->canonpath($root);
 
- $path =~ s!^/{1}!!;
- $path = $root."/".$path;
+ $path =~ tr!\\!/!;
+ $path =~ s!^/+!!;
+ $path =  $root."/".$path;
 
  # We extract the last part of the path and create the absolute path
 
@@ -75,7 +77,7 @@ sub check_path($$)
  # Create short path name
 
  my $short_path = substr($path,length($root));
- $short_path =~ tr!\\!\/!;
+ $short_path =~ tr!\\!/!;
  $short_path = "/".$short_path if($short_path !~ m!^/!);
  $short_path = $short_path."/" if($short_path !~ m!/$! && -d $path);
 
@@ -159,6 +161,30 @@ sub devedit_reload(;$)
  return \$header;
 }
 
+# dos_wildcard_match()
+#
+# Check if a string matches against a DOS-style wildcard
+#
+# Params: 1. Pattern
+#         2. String
+#
+# Return: Status code (Boolean)
+
+sub dos_wildcard_match($$)
+{
+ my ($pattern,$string) = @_;
+
+ # The following part is stolen from File::DosGlob
+
+ # escape regex metachars but not glob chars
+ $pattern =~ s:([].+^\-\${}[|]):\\$1:g;
+ # and convert DOS-style wildcards to regex
+ $pattern =~ s/\*/.*/g;
+ $pattern =~ s/\?/.?/g;
+
+ return ($string =~ m|^$pattern$|is);
+}
+
 # equal_url()
 #
 # Create URL equal to a file or directory
@@ -173,8 +199,8 @@ sub equal_url($$)
  my ($root,$path) = @_;
  my $url;
 
- $root =~ s!/$!!;
- $path =~ s!^/!!;
+ $root =~ s!/+$!!;
+ $path =~ s!^/+!!;
  $url  =  $root."/".$path;
 
  return $url;