--- /dev/null
+#! /usr/bin/env python3
+
+"""
+
+Name : filename helper
+Author : Chris Koeritz
+Rights : Copyright (C) 1996-$now by Author
+
+Purpose:
+
+ Functions that manipulate filenames in various helpful ways.
+
+License:
+This program is free software; you can redistribute it and/or modify it
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2 of the License or (at your option)
+any later version. See: "http://www.gruntose.com/Info/GNU/GPL.html" for a
+version of the License. Please send any updates to "fred@gruntose.com".
+
+"""
+
+
+
+
+
+
+
+
+
+
+
+#unscanned below here.
+
+use Env qw(OS IS_MSYS);
+
+############################################################################
+
+#hmmm: lots of interesting perl interrupt handling stuff. do we need any of that? betting not.
+## #hmmm: make this lower-level, a script that is inherited by all perl scripts.
+##
+##sub yeti_interrupt_handler {
+## die "caught an interrupt; exiting.\n";
+##}
+##
+### hook in a ctrl-c catcher, since that seems to be universally needed.
+##sub install_interrupt_catcher {
+## $SIG{INT} = 'yeti_interrupt_handler';
+## $SIG{QUIT} = 'yeti_interrupt_handler';
+###print "mapped int and quit signals\n";
+## return 0
+##}
+
+############################################################################
+
+# takes an array of filenames (each possibly containing spaces and/or
+# wildcards) and resolves it to a useful list of actual files.
+
+python function defs anyone? amazing how fast this stuff vanishes.
+
+def glob_list(original_names: list) -> list:
+ """
+ takes a set of filenames that may be relative (or really arcane) and globs them into a normal list of filenames.
+ """
+
+unchecked below here
+
+ local(@to_return) = (); # the final form of the name list.
+#print "temp list is @original_names\n";
+
+ # scan through the list we're given.
+ foreach $entry (@original_names) {
+#print "entry is $entry\n";
+ local(@chopped_filename) = &split_filename($entry);
+#print "chopped 0=$chopped_filename[0]\n";
+#print "chopped 1=$chopped_filename[1]\n";
+ if ( (@chopped_filename[0] eq ".") || (@chopped_filename[0] eq "..") ) {
+ # add the simple directory name into the list.
+ push @to_return, $chopped_filename[0];
+ next;
+ }
+ if (@chopped_filename[1] eq ".") {
+ # add a directory that didn't have more pattern attached.
+ push @to_return, $chopped_filename[0];
+ next;
+ }
+ opendir WHERE, $chopped_filename[0]; # open the directory up.
+ local(@files_found) = readdir(WHERE);
+ closedir WHERE;
+ foreach $possible_name (@files_found) {
+ # we need to process the pattern a bit; directory patterns are different
+ # from perl regular expression patterns, so we end up massaging any "ls"
+ # wildcards into an equivalent perl-style one below.
+ local($match) = $chopped_filename[1];
+#hmmm: would be nice to combine the replacements into a long batch instead of separate commands, but i do not seem to know how to do that yet in perl.
+ $match =~ s/\./\\./g; # replace periods with escaped ones.
+ $match =~ s/\*/.*/g; # replace asterisks with dot star.
+ $match =~ s/\+/\\+/g; # escape plusses.
+ $match =~ s/\?/\\?/g; # escape question marks.
+ $match =~ s/\|/\\|/g; # escape pipe char.
+ $match =~ s/\$/\\\$/g; # escape dollar sign.
+ $match =~ s/\[/\\[/g; # escape open bracket.
+ $match =~ s/\]/\\]/g; # escape close bracket.
+ $match =~ s/\(/\\(/g; # escape open quote.
+ $match =~ s/\)/\\)/g; # escape close quote.
+ $match =~ s/\{/\\{/g; # escape open curly bracket.
+ $match =~ s/\}/\\}/g; # escape close curly bracket.
+
+ $match = "^" . $match . "\$"; # make sure the whole thing matches.
+#print "possibname is '$possible_name':\n";
+ if ($possible_name =~ /$match/) {
+ # this one matches so add it.
+ push @to_return, $chopped_filename[0] . $possible_name;
+#print "a match on: $chopped_filename\n";
+ }
+ }
+ }
+ return @to_return;
+}
+
+############################################################################
+
+# reports if two file names are the same file.
+
+sub same_file {
+ local($file1, $file2) = @_;
+
+ ($dev1, $ino1, $junk1) = stat $file1;
+ ($dev2, $ino2, $junk2) = stat $file2;
+
+ return ($dev1 == $dev2) && ($ino1 == $ino2);
+}
+
+############################################################################
+
+# splits a filename into a directory and file specification.
+
+sub split_filename {
+ local($chewed_name) = &remove_trailing_slashes(@_);
+ $chewed_name = &canonicalize($chewed_name);
+ $chewed_name = &patch_name_for_pc($chewed_name);
+ if ($chewed_name =~ /\//) {
+ # there's a slash in there.
+ local($directory_part) = $chewed_name;
+ $directory_part =~ s/^(.*\/)[^\/]*$/\1/;
+ local($file_part) = $chewed_name;
+ $file_part =~ s/^.*\/([^\/]*)$/\1/;
+ if ($file_part eq "") {
+ # if there was no file specification, just add a non-matching spec.
+ $file_part = ".";
+ }
+ return ($directory_part, $file_part);
+ } elsif ($chewed_name eq ".") {
+ return (".", "");
+ } elsif ($chewed_name eq "..") {
+ return ("..", "");
+ } else {
+ # no slash in this name, so we fix that and also make sure we match
+ # the whole name.
+ return ("./", $chewed_name);
+ }
+}
+
+############################################################################
+
+# returns the base part of the filename; this omits any directories.
+
+sub basename {
+ local(@parts) = &split_filename(@_);
+ return $parts[1];
+}
+
+# returns the directory part of the filename.
+
+sub dirname {
+ local(@parts) = &split_filename(@_);
+ return $parts[0];
+}
+
+# returns the extension found on the filename, if any.
+sub extension {
+ local($base) = &basename(@_);
+#printf "base is $base\n";
+ local($found) = -1;
+ for (local($i) = length($base) - 1; $i >= 0; $i--) {
+#printf "char is " . substr($base, $i, 1) . "\n";
+ if (substr($base, $i, 1) eq '.') {
+ $found = $i;
+#printf "got period found is $found\n";
+ last;
+ }
+ }
+ if ($found >=0) {
+ return substr($base, $found, length($base) - $found);
+ }
+ return ""; # no extension seen.
+}
+
+# returns the portion of the filename without the extension.
+sub non_extension {
+ local($full) = &remove_trailing_slashes(@_);
+ $full = &canonicalize($full);
+ $full = &patch_name_for_pc($full);
+ local($ext) = &extension($full);
+ local($to_remove) = length($ext);
+ return substr($full, 0, length($full) - $to_remove);
+}
+
+############################################################################
+
+# removes all directory slashes (either '/' or '\') from the end of a string.
+
+sub remove_trailing_slashes {
+ local($directory_name) = @_;
+ # start looking at the end of the string.
+ local($inspection_point) = length($directory_name) - 1;
+ while ($inspection_point > 0) {
+ # examine the last character in the string to see if it's a slash.
+ local($final_char) = substr($directory_name, $inspection_point, 1);
+ # leave the loop if it's not a slash.
+ if ( ($final_char ne "/") && ($final_char ne "\\") ) { last; }
+ chop($directory_name); # remove the slash.
+ $inspection_point--; # check the new last character.
+ }
+
+ return $directory_name;
+}
+
+############################################################################
+
+# returns the proper directory separator for this platform. this requires
+# an environment variable called "OS" for non-Unix operating systems. the
+# valid values for that are shown below.
+
+sub directory_separator {
+ if ( ($OS eq "Windows_NT") || ($OS eq "Windows_95")
+ || ($OS eq "DOS") || ($OS eq "OS2") ) { return "\\"; }
+ else { return "/"; }
+}
+
+############################################################################
+
+# these mutate the directory slashes in a directory name.
+
+# the one we use most frequently; it uses the unix slash.
+sub canonicalize {
+ return &canonicalizer(@_, "/");
+}
+
+# one that turns names into the style native on the current platform.
+sub native_canonicalize {
+ return &canonicalizer(@_, &directory_separator());
+}
+
+# one that explicitly uses pc style back-slashes.
+sub pc_canonicalize {
+ return &canonicalizer(@_, "\\");
+}
+
+# one that explicitly does unix style forward slashes.
+sub unix_canonicalize {
+ return &canonicalizer(@_, "/");
+}
+
+# this more general routine gets a directory separator passed in. it then
+# replaces all the separators with that one.
+sub canonicalizer {
+ local($directory_name) = $_[0];
+ local($dirsep) = $_[1];
+
+#print "old dir name is \"$directory_name\"\n";
+
+ if ($OS =~ /win/i) {
+#somewhat abbreviated check; only catches windoze systems, not dos or os2.
+ # IS_MSYS is calculated by feisty meow scripts startup; it will be
+ # non-empty if this is the msys tool kit.
+ if (length($IS_MSYS) > 0) {
+ # msys utilities version (http://www.mingw.org)
+ $directory_name =~ s/^(.):[\\\/](.*)$/\/\1\/\2/;
+ } else {
+ # cygwin utilities version (http://www.cygwin.com)
+ $directory_name =~ s/^(.):[\\\/](.*)$/\/cygdrive\/\1\/\2/;
+ }
+#print "new dir name is \"$directory_name\"\n";
+ }
+
+ # turn all the non-default separators into the default.
+ for (local($j) = 0; $j < length($directory_name); $j++) {
+ if ( (substr($directory_name, $j, 1) eq "\\")
+ || (substr($directory_name, $j, 1) eq "/") ) {
+ substr($directory_name, $j, 1) = $dirsep;
+ }
+ }
+ # remove all occurrences of double separators except for the first
+ # double set, which could be a UNC filename.
+ local($saw_sep) = 0;
+ for (local($i) = 1; $i < length($directory_name); $i++) {
+ # iterate through the string looking for redundant separators.
+ if (substr($directory_name, $i, 1) eq $dirsep) {
+ # we found a separator character.
+ if ($saw_sep) {
+ # we had just seen a separator, so this is two in a row.
+ local($head, $tail) = (substr($directory_name, 0, $i - 1),
+ substr($directory_name, $i, length($directory_name) - 1));
+ $directory_name = $head . $tail;
+ # put the name back together without this redundant character.
+ $i--; # skip back one and try again.
+ } else {
+ # we have now seen a separator.
+ $saw_sep = 1;
+ }
+ } else {
+ # this character was not a separator.
+ $saw_sep = 0;
+ }
+ }
+ if ($directory_name =~ /^.:$/) {
+ # fix a dos style directory that's just X:, since we don't want the
+ # current directory to be used on that device. that's too random.
+ # instead, we assume they meant the root of the drive.
+ $directory_name = $directory_name . "/";
+ }
+ return $directory_name;
+}
+
+############################################################################
+
+# fixes a PC directory name if it is only a drive letter plus colon.
+
+sub patch_name_for_pc {
+ local($name) = @_;
+#print "name=$name\n";
+ if (length($name) != 2) { return $name; }
+ local($colon) = substr($name, 1, 1);
+#print "colon=$colon\n";
+ # check whether the string needs patching.
+ if ($colon eq ":") {
+ # name is currently in feeble form of "X:"; fix it.
+ $name = $name . '/';
+ }
+#print "returning=$name\n";
+ return $name;
+}
+
+############################################################################
+
+# tells whether a filename is important or not. the unimportant category
+# can usually be safely ignored or deleted.
+
+sub important_filename {
+ local($name) = &basename($_[0]);
+
+ # these are endings that we consider unimportant. where a caret is used
+ # at the front, we will match only the whole string. double slashes are
+ # used before periods to ensure we match a real period character.
+ local(@junk_files) = ("~", "^\\.#.*", "^\\._.*", "\\.aps", "\\.bak",
+ "^binaries", "^bin.ant", "^bin.eclipse",
+ "\\.clw", "^cpdiff_tmp\\.txt", "^\\.ds_store", "^diffs\\.txt",
+ "^diff_tmp\\.txt", "\\.dsp", "\\.dsw", "\\.gid", "gmon\\.out", "\\.isr",
+ "^isconfig\\.ini", "\\.log", "^manifest.txt", "^obj",
+ "\\.obj", "\\.output", "\\.plg", "^RCa.*", "^Release", "\\.res",
+ "\\.sbr", ".*scc", "^Setup\\.dbg", "^Setup\\.inx",
+ "^Setup\\.map", "^Setup\\.obs", "^Selenium_.*Login.html",
+ "\\.stackdump", "^string1033\\.txt", "\\.suo", "\\.swp",
+ "^thumbs.db", "[a-zA-Z0-9]\\.tmp", "^trans\\.tbl", "\\.user", "_version\\.h",
+ "_version\\.rc", "^waste", "\\.ws4", "\\.wsm");
+
+ foreach $temp (@junk_files) {
+ $temp = $temp . '$';
+ if ($name =~ /${temp}/i) { return 0; }
+ # we hit a match on it being unimportant.
+ }
+
+ return 1; # anything else is considered important.
+}
+
+############################################################################
+
+sub sanitize_name {
+ return &patch_name_for_pc
+ (&remove_trailing_slashes
+ (&canonicalize(@_)));
+}
+
+############################################################################
+
+sub get_drive_letter {
+ local($path) = @_;
+ if (substr($path, 0, 1) =~ /[a-zA-Z]/) {
+ if (substr($path, 1, 1) eq ":") { return substr($path, 0, 1); }
+ }
+ return "";
+}
+
+############################################################################
+
+sub remove_drive_letter {
+ local($path) = @_;
+ if (substr($path, 0, 1) =~ /[a-zA-Z]/) {
+ if (substr($path, 1, 1) eq ":") { return substr($path, 2); }
+ }
+ return $path;
+}
+
+############################################################################
+
+# these return their argument with the case flipped to lower or upper case.
+
+sub lower {
+ local($name) = @_;
+ $name =~ tr/A-Z/a-z/;
+ return $name;
+}
+
+sub upper {
+ local($name) = @_;
+ $name =~ tr/a-z/A-Z/;
+ return $name;
+}
+
+############################################################################
+
+# recursively deletes a directory that is passed as the single parameter.
+# from http://developer.novell.com/wiki/index.php/Recursive_Directory_Remove
+sub recursive_delete {
+ my $dir;
+ foreach $dir (@_) {
+ if ( -f "$dir" ) {
+print "this is not a dir: $dir\nshould whack it here?\n";
+return;
+ }
+
+ local *DIR;
+ # if we can't open the dir, just skip to the next one.
+ opendir DIR, $dir or next;
+ while ($_ = readdir DIR) {
+ next if /^\.{1,2}$/;
+ my $path = "$dir/$_";
+ unlink $path if -f $path;
+ recursive_delete($path) if -d $path;
+ }
+ closedir DIR;
+ rmdir $dir or print "error - $!";
+ }
+}
+
+############################################################################
+
+# finds any directories under the arguments, which can be a list of directories.
+sub find_directories {
+ my @dirs_found = ();
+ my $dir;
+ foreach $dir (@_) {
+ local *DIR;
+ # if we can't open the dir, just skip to the next one.
+ opendir DIR, $dir or next;
+ while ($_ = readdir DIR) {
+ # skip if it's current or parent dir.
+ next if /^\.{1,2}$/;
+ my $path = "$dir/$_";
+ # skip if this entry is not itself a directory.
+ next if ! -d $path;
+ push @dirs_found, $path;
+ }
+ closedir DIR;
+ }
+ return @dirs_found;
+}
+
+############################################################################
+
+# given a list of paths, this returns an array of all the filenames found therein.
+sub find_files {
+ my @files_found = ();
+ my $dir;
+ foreach $dir (@_) {
+ if (-f $dir) {
+ # that's actually just a file, so add it.
+ push @files_found, $dir;
+ next;
+ }
+ local *DIR;
+ # if we can't open the dir, just skip to the next one.
+ opendir DIR, $dir or next;
+ while ($_ = readdir DIR) {
+ # skip if it's current or parent dir.
+ next if /^\.{1,2}$/;
+ my $path = "$dir/$_";
+ # skip if this entry is not a file.
+ next if ! -f $path;
+ push @files_found, $path;
+ }
+ closedir DIR;
+ }
+ return @files_found;
+}
+
+############################################################################
+
+# finds all directories starting at a particular directory and returns them
+# in an array. does not include the starting directory.
+sub recursive_find_directories {
+ # first find all the directories within the parameters.
+ my @toplevel = find_directories(@_);
+
+ my @to_return;
+ push(@to_return, @toplevel);
+
+ # return the composition of the list we found here plus any directories under those.
+ # we only recurse if there's something to chew on in our directory list.
+ # otherwise, we've hit the bottom of that tree.
+ if (scalar @toplevel > 0) {
+ my @subs_found = recursive_find_directories(@toplevel);
+ push(@to_return, @subs_found);
+ }
+ return @to_return;
+}
+
+############################################################################
+
+1;
+
projects / feisty_meow.git / commitdiff