--- /dev/null
+#!/usr/bin/perl
+
+##############
+#
+# Name : generate_aliases
+# Author : Chris Koeritz
+# Rights : Copyright (C) 1996-$now by Author
+#
+# Purpose:
+#
+# This script generates feisty meow script alias files. Alias files
+# contain a list of definitions for command aliases that are written in the
+# specified shell dialect (such as bash or perl) and which are additionally
+# tailored for the operating system to be used.
+#
+##############
+# This program is free software; you can redistribute it and/or modify it
+# under 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".
+##############
+
+require "filename_helper.pl";
+
+use Env qw(FEISTY_MEOW_BINARIES BUILD_TOP FEISTY_MEOW_APEX FEISTY_MEOW_LOADING_DOCK FEISTY_MEOW_SCRIPTS DEBUG_FEISTY_MEOW HOME );
+
+# given a possible aliasable filename, this will decide whether to create a perl
+# or bash alias for it. it needs the filename of the possible alias and the
+# directory where that file resides.
+sub make_alias {
+ local($file, $dir) = @_;
+ if ($file =~ /\.[pP][yY]$/) {
+ local($aliasname) = $file; $aliasname =~ s/\.[Pp][yY]$//;
+ &make_python_alias($aliasname, "$dir");
+ } elsif ($file =~ /\.[sS][hH]$/) {
+ local($aliasname) = $file; $aliasname =~ s/\.[Ss][Hh]$//;
+ &make_bash_alias($aliasname, "$dir");
+ } elsif ($file =~ /\.[pP][lL]$/) {
+ local($aliasname) = $file; $aliasname =~ s/\.[Pp][lL]$//;
+ &make_perl_alias($aliasname, "$dir");
+ }
+}
+
+# makes an alias for a bash script given the alias name.
+sub make_bash_alias {
+ local($aliasname) = shift(@_);
+ local($full_alias) = $aliasname;
+#print "full alias is $full_alias\n";
+ $aliasname =~ s/^.*\/([^\/]*)/\1/;
+#print "alias became $aliasname\n";
+ print she "define_yeti_alias $aliasname=\"bash $full_alias.sh\"\n";
+}
+
+# makes an alias for a python script given the alias name.
+#hmmm: don't love that we're hardcoding python3 in here, but apparently some systems don't have a 'python' command despite having python installed.
+sub make_python_alias {
+ local($aliasname) = shift(@_);
+ local($full_alias) = $aliasname;
+ $aliasname =~ s/^.*\/([^\/]*)/\1/;
+#print "alias became $aliasname\n";
+ print she "define_yeti_alias $aliasname=\"python3 $full_alias.py\"\n";
+}
+
+# makes an alias for a perl script given the alias name.
+sub make_perl_alias {
+ local($aliasname) = shift(@_);
+ local($full_alias) = $aliasname;
+ $aliasname =~ s/^.*\/([^\/]*)/\1/;
+#print "alias became $aliasname\n";
+ print she "define_yeti_alias $aliasname=\"perl $full_alias.pl\"\n";
+}
+
+##############
+
+# The "common.alias" file is used in the generated aliases file as a base
+# set of generally useful aliases. We also add aliases for any script files
+# (perl, bash, python, etc) that we find in the feisty meow script hierarchy.
+# Any *.alias files found in the $FEISTY_MEOW_LOADING_DOCK/custom folder are
+# loaded also.
+sub rebuild_script_aliases {
+
+ if (length($DEBUG_FEISTY_MEOW)) {
+ print "rebuilding generated aliases file...\n";
+ }
+
+ # create our generated shells directory if it's not already.
+ if ( ! -d $FEISTY_MEOW_LOADING_DOCK ) {
+ mkdir $FEISTY_MEOW_LOADING_DOCK;
+ if (length($DEBUG_FEISTY_MEOW)) {
+ print "made FEISTY_MEOW_LOADING_DOCK at '$FEISTY_MEOW_LOADING_DOCK'\n";
+ }
+ }
+
+ # test if we can use color in ls...
+# $test_color=` ls --help 2>&1 | grep -i color `;
+
+ # this is an array of files from which to draw alias definitions.
+ @ALIAS_DEFINITION_FILES = ("$FEISTY_MEOW_SCRIPTS/core/common.alias");
+
+ # if custom aliases files exist, add them to the list.
+#hmmm: would be nice to have this name in a symbol somewhere instead of having "custom" or "customize" everywhere.
+ foreach $i (&glob_list("$FEISTY_MEOW_LOADING_DOCK/custom/*.alias")) {
+ if (-f $i) { push(@ALIAS_DEFINITION_FILES, $i); }
+ }
+ if (length($DEBUG_FEISTY_MEOW)) {
+ print "using these alias files:\n";
+ foreach $i (@ALIAS_DEFINITION_FILES) {
+ local $base_of_dir = &basename(&dirname($i));
+ local $basename = &basename($i);
+ print " $base_of_dir/$basename\n";
+ }
+ }
+
+ # write the aliases for sh and bash scripts.
+ local $GENERATED_ALIAS_FILE = "$FEISTY_MEOW_LOADING_DOCK/fmc_core_and_custom_aliases.sh";
+ if (length($DEBUG_FEISTY_MEOW)) {
+ print "writing generated aliases in $GENERATED_ALIAS_FILE...\n";
+ }
+
+#hmmm: perhaps a good place for a function to create the header,
+# given the appropriate comment code.
+
+ open GENOUT, ">$GENERATED_ALIAS_FILE" or die "cannot open $GENERATED_ALIAS_FILE";
+
+ print GENOUT "##\n";
+ print GENOUT "## generated file: $GENERATED_ALIAS_FILE\n";
+ print GENOUT "## please do not edit.\n";
+ print GENOUT "##\n";
+
+# if (length($test_color)) {
+# print GENOUT "export color_add='--color=auto'\n";
+# } else {
+# print GENOUT "export color_add=\n";
+# }
+
+ # plow in the full set of aliases into the file.
+ foreach $i (@ALIAS_DEFINITION_FILES) {
+ open CURR_ALIASER, "<$i" or die "cannot open current alias file $i";
+ foreach $line (<CURR_ALIASER>) {
+ print GENOUT "$line";
+ }
+ }
+
+ close GENOUT;
+
+ if (length($DEBUG_FEISTY_MEOW)) {
+ print("done rebuilding generated aliases file.\n");
+ }
+}
+
+##############
+
+# make sure we know where to store the files we're creating.
+if ( ! length("$FEISTY_MEOW_LOADING_DOCK") ) {
+ print "\
+The FEISTY_MEOW_LOADING_DOCK variable is not defined. This must point to\
+the location where the generated scripts are stored. You may still need to\
+configure the feisty meow script system with something like:\
+ bash /opt/feistymeow.org/feisty_meow/scripts/core/reconfigure_feisty_meow.sh\
+Please see http://feistymeow.org for more details.\n";
+ exit 1;
+#really need to use better exit codes.
+}
+
+##############
+
+$FEISTY_MEOW_LOADING_DOCK =~ s/\\/\//g;
+$FEISTY_MEOW_SCRIPTS =~ s/\\/\//g;
+$FEISTY_MEOW_APEX =~ s/\\/\//g;
+
+##############
+
+# create our generated shells directory if it's not already there.
+if (! -d $FEISTY_MEOW_LOADING_DOCK) {
+ mkdir $FEISTY_MEOW_LOADING_DOCK;
+}
+
+##############
+
+# set the executable bit for binaries for just this current user.
+if (-d $FEISTY_MEOW_BINARIES) {
+ system("find \"$FEISTY_MEOW_BINARIES\" -type f -exec chmod u+x \"{}\" ';'");
+}
+
+##############
+
+# generate the first set of alias files that are defined in the core
+# and custom scripts directories.
+&rebuild_script_aliases;
+
+##############
+
+# trash the old versions.
+unlink("$FEISTY_MEOW_LOADING_DOCK/fmc_aliases_for_scripts.sh");
+
+if (length($DEBUG_FEISTY_MEOW)) {
+ printf "writing $FEISTY_MEOW_LOADING_DOCK/fmc_aliases_for_scripts.sh...\n";
+}
+
+##############
+
+# open the alias files to be created.
+open(she, ">> $FEISTY_MEOW_LOADING_DOCK/fmc_aliases_for_scripts.sh");
+
+# find the list of files in the scripts directory.
+@shell_files = (find_files(recursive_find_directories("$FEISTY_MEOW_SCRIPTS")),
+ find_files("$FEISTY_MEOW_LOADING_DOCK/custom/scripts"),
+ find_files(recursive_find_directories("$FEISTY_MEOW_LOADING_DOCK/custom/scripts")));
+
+# strip out the customization files, since they are added in on demand only.
+#print "before filtering list: @shell_files\n";
+@shell_files = grep ! /\/customize\//, @shell_files;
+#print "after filtering list: @shell_files\n";
+
+#printf "found all these files in main script dirs:\n";
+#printf " @shell_files\n";
+
+# construct aliases for items in the scripts directory.
+foreach $file (@shell_files) {
+ # test to see what type of item we got.
+ if ($file =~ '^\.$'
+ || $file =~ '^\.\.$'
+ || $file =~ '^.svn$'
+ || $file =~ '^.git$'
+ || $file =~ /\/\.$/
+ || $file =~ /\/\.\.$/
+ || $file =~ /\/\.svn$/
+ || $file =~ /\/\.git$/
+ ) {
+ # just skip this item; it's a special directory or a file we don't want to include.
+ print "skipping name: $file\n";
+ } else {
+ &make_alias($file, "");
+ }
+}
+
+close(she);
+
+##############
+
+# prepare a finalizer chunk that is the last thing to load.
+
+open(she, ">> $FEISTY_MEOW_LOADING_DOCK/fmc_ending_sentinel.sh");
+
+# write in our sentinel alias that says alias loading was handled.
+print she "define_yeti_alias CORE_ALIASES_LOADED=true\n";
+
+close(she);
+
+##############
+
+1;
+
--- /dev/null
+#!/usr/bin/perl
+
+###############################################################################
+# #
+# Name : filename_helper #
+# Author : Chris Koeritz #
+# Rights : Copyright (C) 1996-$now by Author #
+# #
+# Purpose: #
+# #
+# Support for manipulating filenames. #
+# #
+###############################################################################
+# This program is free software; you can redistribute it and/or modify it #
+# under 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". #
+###############################################################################
+
+use Env qw(OS IS_MSYS);
+
+############################################################################
+
+#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.
+
+sub glob_list {
+ local(@temp_list) = @_; # the names we're given.
+ local(@to_return) = (); # the final form of the name list.
+#print "temp list is @temp_list\n";
+
+ # scan through the list we're given.
+ foreach $entry (@temp_list) {
+#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