diff --git a/modules/ksb/FirstRun.pm b/modules/ksb/FirstRun.pm index ebfdea8..9eebe98 100644 --- a/modules/ksb/FirstRun.pm +++ b/modules/ksb/FirstRun.pm @@ -1,381 +1,413 @@ package ksb::FirstRun 0.10; use 5.014; use strict; use warnings; use File::Spec qw(splitpath); use ksb::BuildException; use ksb::Debug qw(colorize); use ksb::OSSupport; +use ksb::Util; =head1 NAME ksb::FirstRun =head1 DESCRIPTION Performs initial-install setup, implementing the C<--initial-setup> option. B This module is supposed to be loadable even under minimal Perl environments as fielded in "minimal Docker container" forms of popular distros. =head1 SYNOPSIS my $exitcode = ksb::FirstRun::setupUserSystem(); exit $exitcode; =cut sub setupUserSystem { my $baseDir = shift; my $os = ksb::OSSupport->new; eval { _installSystemPackages($os); _setupBaseConfiguration($baseDir); _setupBashrcFile(); }; if (had_an_exception($@)) { my $msg = $@->{message}; say colorize (" b[r[*] r[$msg]"); return 1; } return 0; } # Internal functions # Reads from the __DATA__ section below and dumps the contents in a hash keyed # by filename (the @@ part between each resource). my %packages; sub _readPackages { return \%packages if %packages; my $cur_file; my $cur_value; my $commit = sub { return unless $cur_file; $packages{$cur_file} = ($cur_value =~ s/ *$//r); $cur_value = ''; }; while(my $line = ) { next if $line =~ /^\s*#/ and $cur_file !~ /sample-rc/; chomp $line; my ($fname) = ($line =~ /^@@ *([^ ]+)$/); if ($fname) { $commit->(); $cur_file = $fname; } else { $cur_value .= "$line\n"; } } $commit->(); return \%packages; } sub _throw { my $msg = shift; die (make_exception('Setup', $msg)); } sub _installSystemPackages { my $os = shift; my $vendor = $os->vendorID; my $osVersion = $os->vendorVersion; print colorize(<> 8 == 0) { - say colorize (" b[*] b[g[Looks like things went OK!]"); + say colorize (" b[*] b[g[Looks like the necessary packages were successfully installed!]"); } else { say colorize (" r[b[*] Ran into an error with the installer!"); } } else { - say colorize (" r[b[*] Whoa, I'm not familiar with your distribution, skipping"); + say colorize (" r[b[*] Packages could not be installed, because kdesrc-build does not know your linux distribution."); } } sub _setupBaseConfiguration { my $baseDir = shift; if (-e "kdesrc-buildrc" || -e "$ENV{HOME}/.kdesrc-buildrc") { print colorize(</dev/null` || 4; $sampleRc =~ s/%\{num_cpus}/$numCpus/g; $sampleRc =~ s/%\{base_dir}/$baseDir/g; open my $sampleFh, '>', "$ENV{HOME}/.kdesrc-buildrc" or _throw("Couldn't open new ~/.kdesrc-buildrc: $!"); print $sampleFh $sampleRc or _throw("Couldn't write to ~/.kdesrc-buildrc: $!"); close $sampleFh or _throw("Error closing ~/.kdesrc-buildrc: $!"); } } -sub _bashrcIsSetup -{ - return 1; -} - sub _setupBashrcFile { - if (_bashrcIsSetup()) { + my $modifiedBashrc = 0; + + # Add kdesrc-build path to PATH if not already in there + if (!ksb::Util::isInPath('src/kdesrc-build')) { + + say colorize(<>', "$ENV{HOME}/.bashrc") or _throw("Couldn't open ~/.bashrc: $!"); + + print $bashrc "\n# Adding the kdesrc-build directory to the path\n"; + print $bashrc 'export PATH="$HOME/kde/src/kdesrc-build:$PATH"'; + print $bashrc "\n"; + + $modifiedBashrc = 1; + } + + # Create kdesrc-run alias for more convenient program execution + if (!ksb::Util::fileHasLine("$ENV{HOME}/.bashrc", "kdesrc-run ()")) { say colorize(<>', "$ENV{HOME}/.bashrc") or _throw("Couldn't open ~/.bashrc: $!"); + + print $bashrc "\n# Creating alias for running software built with kdesrc-build\n"; + print $bashrc "kdesrc-run ()\n"; + print $bashrc "{\n"; + print $bashrc ' source "$HOME/kde/build/$1/prefix.sh" && "$HOME/kde/usr/bin/$1"'; + print $bashrc "\n}\n"; + + $modifiedBashrc = 1; + } + + + + if ($modifiedBashrc) { + say colorize(<bestDistroMatch(@supportedDistros); say colorize (" Using installer for b[$bestVendor]"); my $version = $os->vendorVersion(); my @cmd; for my $opt ("$bestVendor/$version", "$bestVendor/unknown") { my $key = "cmd/install/$opt"; next unless exists $pkgsRef->{$key}; @cmd = split(' ', $pkgsRef->{$key}); last; } _throw("No installer for $bestVendor!") unless @cmd; # If not running as root already, add sudo unshift @cmd, 'sudo' if $> != 0; return @cmd; } sub _findBestVendorPackageList { my $os = shift; # Debian handles Ubuntu also my @supportedDistros = map { s{^pkg/([^/]+)/.*$}{$1}; $_ } grep { /^pkg\// } keys %{_readPackages()}; my $bestVendor = $os->bestDistroMatch(@supportedDistros); my $version = $os->vendorVersion(); say colorize (" Installing packages for b[$bestVendor]/b[$version]"); return _packagesForVendor($bestVendor, $version); } sub _packagesForVendor { my ($vendor, $version) = @_; my $packagesRef = _readPackages(); foreach my $opt ("pkg/$vendor/$version", "pkg/$vendor/unknown") { next unless exists $packagesRef->{$opt}; my @packages = split(' ', $packagesRef->{$opt}); return @packages; } return; } 1; __DATA__ @@ pkg/debian/unknown libyaml-libyaml-perl libio-socket-ssl-perl libjson-xs-perl git shared-mime-info cmake build-essential flex bison gperf libssl-dev intltool liburi-perl gettext @@ pkg/opensuse/unknown perl perl-IO-Socket-SSL perl-JSON perl-YAML-LibYAML git shared-mime-info make cmake libqt5-qtbase-common-devel libopenssl-devel intltool polkit-devel libqt5-qtbase-devel libqt5-qtimageformats-devel libqt5-qtmultimedia-devel libqt5-qtdeclarative-devel libqt5-qtx11extras-devel libqt5-qtxmlpatterns-devel libqt5-qtsvg-devel gperf gettext-runtime gettext-tools libxml2-devel libxml2-tools libxslt-devel docbook-xsl-stylesheets docbook_4 perl-URI libXrender-devel xcb-util-keysyms-devel flex bison libQt5Core-private-headers-devel libudev-devel libQt5WebKit5-devel libQt5WebKitWidgets-devel libQt5DesignerComponents5 libqt5-qttools-devel libSM-devel libattr-devel libboost_headers1_66_0-devel libQt5QuickControls2-devel libqt5-qtscript-devel wayland-devel libqt5-qtbase-private-headers-devel lmdb-devel libpng16-compat-devel giflib-devel ModemManager-devel # This pulls in so many other packages! :( NetworkManager-devel qrencode-devel @@ pkg/fedora/unknown perl-IO-Socket-SSL perl-JSON-PP perl-YAML-LibYAML perl-IPC-Cmd git bzr texinfo shared-mime-info make cmake openssl-devel intltool gcc gcc-c++ python mesa-libGL-devel dbus-devel gstreamer1-devel mesa-libgbm-devel polkit-devel pam-devel gperf gettext gettext-devel libxml2-devel libxml2 libxslt-devel docbook-style-xsl docbook-utils perl-URI libXrender-devel xcb-util-keysyms-devel flex bison libjpeg-devel libSM-devel libattr-devel xapian-core-devel boost-devel wayland-devel xcb-util-devel xcb-util-wm-devel xcb-util-cursor-devel lmdb-devel libpng-devel giflib-devel ModemManager-devel # This pulls in so many other packages! :( NetworkManager-libnm-devel qrencode-devel libassuan-devel @@ pkg/mageia/unknown perl-IO-Socket-SSL perl-JSON-PP perl-YAML-LibYAML perl-IPC-Cmd git shared-mime-info make cmake openssl-devel intltool gcc gcc-c++ python libgl-devel dbus-devel gstreamer1.0-devel polkit-devel gperf gettext gettext-devel libxml2-devel libxml2 libxslt-devel docbook-style-xsl docbook-utils perl-URI libxrender-devel xcb-util-keysyms-devel flex bison libsm-devel libattr-devel boost wayland-devel lmdb-devel libpng-devel giflib-devel modemmanager-devel # This pulls in so many other packages! :( libnm-devel qrencode-devel @@ pkg/gentoo/unknown dev-util/cmake dev-lang/perl @@ pkg/arch/unknown perl-json perl-yaml-libyaml perl-io-socket-ssl cmake gcc make qt5-base @@ cmd/install/debian/unknown apt-get -q -y --no-install-recommends install @@ cmd/install/opensuse/unknown zypper install -y --no-recommends @@ cmd/install/arch/unknown pacman -Syu --noconfirm --needed @@ cmd/install/fedora/unknown dnf -y install @@ sample-rc # This file controls options to apply when configuring/building modules, and # controls which modules are built in the first place. # List of all options: https://go.kde.org/u/ksboptions global # Paths kdedir ~/kde/usr # Where to install KF5-based software qtdir ~/kde/qt5 # Where to find Qt5 source-dir ~/kde/src # Where sources are downloaded build-dir ~/kde/build # Where the source build is run ignore-kde-structure true # Use flat structure # Will pull in KDE-based dependencies only, to save you the trouble of # listing them all below include-dependencies true cmake-options -DCMAKE_BUILD_TYPE=RelWithDebInfo make-options -j%{num_cpus} end global # With base options set, the remainder of the file is used to define modules to build, in the # desired order, and set any module-specific options. # # Modules may be grouped into sets, and this is the normal practice. # # You can include other files inline using the "include" command. We do this here # to include files which are updated with kdesrc-build. # Qt and some Qt-using middleware libraries include %{base_dir}/qt5-build-include include %{base_dir}/custom-qt5-libs-build-include # KF5 and Plasma :) include %{base_dir}/kf5-qt5-build-include # To change options for modules that have already been defined, use an # 'options' block options kcoreaddons make-options -j4 end options diff --git a/modules/ksb/Util.pm b/modules/ksb/Util.pm index cc0453b..6a36d90 100644 --- a/modules/ksb/Util.pm +++ b/modules/ksb/Util.pm @@ -1,680 +1,707 @@ package ksb::Util 0.30; # Useful utilities, which are exported into the calling module's namespace by default. use 5.014; # Needed for state keyword use strict; use warnings; use Scalar::Util qw(blessed); use File::Path qw(make_path); use File::Find; use Cwd qw(getcwd); use Errno qw(:POSIX); use Digest::MD5; use ksb::Debug; use ksb::Version qw(scriptVersion); use ksb::BuildException; use Exporter qw(import); # Use Exporter's import method our @EXPORT = qw(list_has assert_isa assert_in any unique_items absPathToExecutable fileDigestMD5 log_command disable_locale_message_translation trimmed split_quoted_on_whitespace safe_unlink safe_system p_chdir pretend_open safe_rmtree get_list_digest is_dir_empty super_mkdir filter_program_output prettify_seconds); # Function to work around a Perl language limitation. # First parameter is a reference to the list to search. ALWAYS. # Second parameter is the value to search for. # Returns true if the value is in the list sub list_has { my ($listRef, $value) = @_; my @list = @{$listRef}; return scalar grep { "$_" eq "$value" } (@list); } # Subroutine to return the path to the given executable based on the # either the given paths or the current PATH. # E.g.: # absPathToExecutable('make') -> '/usr/bin/make' # absPathToExecutable('make', 'foo', 'bar') -> /foo/make # If the executable is not found undef is returned. # # This assumes that the module environment has already been updated since # binpath doesn't exactly correspond to $ENV{'PATH'}. sub absPathToExecutable { my ($prog, @preferred) = @_; # If it starts with a / the path is already absolute. return $prog if $prog =~ /^\//; my @paths = @preferred ? @preferred : split(/:/, $ENV{'PATH'}); for my $path (@paths) { return "$path/$prog" if (-x "$path/$prog"); } return undef; } # Throws an exception if the first parameter is not an object at all, or if # it is not an object of the type given by the second parameter (which # should be a string of the class name. There is no return value; sub assert_isa { my ($obj, $class) = @_; if (!blessed($obj) || !$obj->isa($class)) { croak_internal("$obj is not of type $class, but of type " . ref($obj)); } return $obj; } # Throws an exception if the first parameter is not included in the # provided list of possible alternatives. The list of alternatives must # be passed as a reference, as the second parameter. sub assert_in { my ($val, $listRef) = @_; if (!list_has($listRef, $val)) { croak_runtime("$val is not a permissible value for its argument"); } return $val; } # Subroutine to unlink the given symlink if global-pretend isn't set. sub safe_unlink { if (pretending()) { pretend ("\tWould have unlinked ", shift, "."); return 1; # Return true } return unlink (shift); } # Subroutine to execute the system call on the given list if the pretend # global option is not set. # # Returns the shell error code, so 0 means success, non-zero means failure. sub safe_system(@) { if (!pretending()) { whisper ("\tExecuting g['", join("' '", @_), "'"); return system (@_) >> 8; } pretend ("\tWould have run g['" . join("' '", @_) . "'"); return 0; # Return true } # Is exactly like "chdir", but it will also print out a message saying that # we're switching to the directory when debugging. sub p_chdir($) { my $dir = shift; debug ("\tcd g[$dir]\n"); chdir ($dir) or do { return 1 if pretending(); croak_runtime("Could not change to directory $dir: $!"); }; } # Helper subroutine to create a directory, including any parent # directories that may also need created. # Throws an exception on failure. See File::Path. sub super_mkdir { my $pathname = shift; state %createdPaths; if (pretending()) { if (!exists $createdPaths{$pathname} && ! -e $pathname) { pretend ("\tWould have created g[$pathname]"); } $createdPaths{$pathname} = 1; return 1; } else { make_path($pathname); return (-e $pathname) ? 1 : 0; } } # Calculates the MD5 digest of a file already on-disk. The digest is # returned as a hex string digest as from Digest::MD5::md5_hex # # First parameter: File name to read # Return value: hex string MD5 digest of file. # An exception is thrown if an error occurs reading the file. sub fileDigestMD5 { my $fileName = shift; my $md5 = Digest::MD5->new; open my $file, '<', $fileName or croak_runtime( "Unable to open $fileName: $!"); binmode($file); $md5->addfile($file); return $md5->hexdigest(); } # This function is intended to disable the message translation catalog # settings in the program environment, so that any child processes executed # will have their output untranslated (and therefore scrapeable). # # As such this should only be called for a forked child about to exec as # there is no easy way to undo this within the process. sub disable_locale_message_translation { # Ensure that program output is untranslated by setting 'C' locale. # We're really trying to affect the LC_MESSAGES locale category, but # LC_ALL is a catch-all for that (so needs to be unset if set). # # Note that the ONLY SUPPORTED way to pass file names, command-line # args, etc. to commands is under the UTF-8 encoding at this point, as # that is the only sane way for this en_US-based developer to handle # the task. Patches (likely using Encode::Locale) are accepted. :P $ENV{'LC_MESSAGES'} = 'C'; if ($ENV{'LC_ALL'}) { $ENV{'LANG'} = $ENV{'LC_ALL'}; # This is lower-priority "catch all" delete $ENV{'LC_ALL'}; } } # Returns an array of lines output from a program. Use this only if you # expect that the output will be short. # # Since there is no way to disambiguate no output from an error, this # function will call die on error, wrap in eval if this bugs you. # # First parameter is subroutine reference to use as a filter (this sub will # be passed a line at a time and should return true if the line should be # returned). If no filtering is desired pass 'undef'. # # Second parameter is the program to run (either full path or something # accessible in $PATH). # # All remaining arguments are passed to the program. # # Return value is an array of lines that were accepted by the filter. sub filter_program_output { my ($filterRef, $program, @args) = @_; $filterRef //= sub { return 1 }; # Default to all lines debug ("Slurping '$program' '", join("' '", @args), "'"); # Check early for whether an executable exists since otherwise # it is possible for our fork-open below to "succeed" (i.e. fork() # happens OK) and then fail when it gets to the exec(2) syscall. if (!absPathToExecutable($program)) { croak_runtime("Can't find $program in PATH!"); } my $execFailedError = "\t - kdesrc-build - exec failed!\n"; my $pid = open(my $childOutput, '-|'); croak_internal("Can't fork: $!") if ! defined($pid); if ($pid) { # parent my @lines = grep { &$filterRef; } (<$childOutput>); close $childOutput or do { # $! indicates a rather grievous error croak_internal("Unable to open pipe to read $program output: $!") if $!; # we can pass serious errors back to ourselves too. my $exitCode = $? >> 8; if ($exitCode == 99 && @lines >= 1 && $lines[0] eq $execFailedError) { croak_runtime("Failed to exec $program, is it installed?"); } # other errors might still be serious but don't need a backtrace if (pretending()) { whisper ("$program gave error exit code $exitCode"); } else { warning ("$program gave error exit code $exitCode"); } }; return @lines; } else { disable_locale_message_translation(); # We don't want stderr output on tty. open (STDERR, '>', '/dev/null') or close (STDERR); exec { $program } ($program, @args) or do { # Send a message back to parent print $execFailedError; exit 99; # Helper proc, so don't use finish(), just die }; } } # Subroutine to return a string suitable for displaying an elapsed time, # (like a stopwatch) would. The first parameter is the number of seconds # elapsed. sub prettify_seconds { my $elapsed = $_[0]; my $str = ""; my ($days,$hours,$minutes,$seconds,$fraction); $fraction = int (100 * ($elapsed - int $elapsed)); $elapsed = int $elapsed; $seconds = $elapsed % 60; $elapsed = int $elapsed / 60; $minutes = $elapsed % 60; $elapsed = int $elapsed / 60; $hours = $elapsed % 24; $elapsed = int $elapsed / 24; $days = $elapsed; $seconds = "$seconds.$fraction" if $fraction; my @str_list; for (qw(days hours minutes seconds)) { # Use a symbolic reference without needing to disable strict refs. # I couldn't disable it even if I wanted to because these variables # aren't global or localized global variables. my $value = eval "return \$$_;"; my $text = $_; $text =~ s/s$// if $value == 1; # Make singular push @str_list, "$value $text" if $value or $_ eq 'seconds'; } # Add 'and ' in front of last element if there was more than one. push @str_list, ("and " . pop @str_list) if (scalar @str_list > 1); $str = join (", ", @str_list); return $str; } # Subroutine to mark a file as being the error log for a module. This also # creates a symlink in the module log directory for easy viewing. # First parameter is the module in question. # Second parameter is the filename in the log directory of the error log. sub _setErrorLogfile { my $module = assert_isa(shift, 'ksb::Module'); my $logfile = shift; return unless $logfile; my $logdir = $module->getLogDir(); $module->setOption('#error-log-file', "$logdir/$logfile"); debug ("Logfile for $module is $logfile"); # Setup symlink in the module log directory pointing to the appropriate # file. Make sure to remove it first if it already exists. unlink("$logdir/error.log") if -l "$logdir/error.log"; if(-e "$logdir/error.log") { # Maybe it was a regular file? error ("r[b[ * Unable to create symlink to error log file]"); return; } symlink "$logfile", "$logdir/error.log"; } # Subroutine to run a command, optionally filtering on the output of the child # command. # # First parameter is the module object being built (for logging purposes # and such). # Second parameter is the name of the log file to use (relative to the log # directory). # Third parameter is a reference to an array with the command and its # arguments. i.e. ['command', 'arg1', 'arg2'] # # After the required three parameters you can pass a hash reference of # optional features: # 'callback' => a reference to a subroutine to have each line # of child output passed to. This output is not supposed to be printed # to the screen by the subroutine, normally the output is only logged. # However this is useful for e.g. munging out the progress of the build. # USEFUL: When there is no more output from the child, the callback will be # called with an undef string. (Not just empty, it is also undefined). # # 'no_translate' => any true value will cause a flag to be set to request # the executed child process to not translate (for locale purposes) its # output, so that it can be screen-scraped. # # The return value is the shell return code, so 0 is success, and non-zero is # failure. # # NOTE: This function has a special feature. If the command passed into the # argument reference is 'kdesrc-build', then log_command will, when it # forks, execute the subroutine named by the second parameter rather than # executing a child process. The subroutine should include the full package # name as well (otherwise the package containing log_command's implementation # is used). The remaining arguments in the list are passed to the # subroutine that is called. sub log_command { my ($module, $filename, $argRef, $optionsRef) = @_; assert_isa($module, 'ksb::Module'); my @command = @{$argRef}; $optionsRef //= { }; my $callbackRef = $optionsRef->{'callback'}; debug ("log_command(): Module $module, Command: ", join(' ', @command)); ksb_debug_inspect('log_command', "$module", $filename, $argRef, $optionsRef); if (pretending()) { pretend ("\tWould have run g['" . join ("' '", @command) . "'"); return 0; } # Do this before we fork so we can see errors my $logpath = $module->getLogPath("$filename.log"); # Fork a child, with its stdout connected to CHILD. my $pid = open(CHILD, '-|'); if ($pid) { # Parent if (!$callbackRef && debugging()) { # If no other callback given, pass to debug() if debug-mode is on. while () { print ($_) if $_; } } if ($callbackRef) { &{$callbackRef}($_) while (); # Let callback know there is no more output. &{$callbackRef}(undef); } # This implicitly does a waitpid() as well close CHILD or do { if ($! == 0) { _setErrorLogfile($module, "$filename.log"); return $?; } return 1; }; return 0; } else { # Child. Note here that we need to avoid running our exit cleanup # handlers in here. For that we need POSIX::_exit. # Apply altered environment variables. $module->buildContext()->commitEnvironmentChanges(); $SIG{PIPE} = "IGNORE"; $SIG{INT} = sub { close (STDOUT); # This should be a pipe close (STDERR); POSIX::_exit(EINTR); }; # Redirect STDIN to /dev/null so that the handle is open but fails when # being read from (to avoid waiting forever for e.g. a password prompt # that the user can't see. open (STDIN, '<', "/dev/null") unless exists $ENV{'KDESRC_BUILD_USE_TTY'}; if ($callbackRef || debugging()) { open (STDOUT, "|tee $logpath") or do { error ("Error opening pipe to tee command."); # Don't abort, hopefully STDOUT still works. }; } else { open (STDOUT, '>', $logpath) or do { error ("Error $! opening log to $logpath!"); }; } # Make sure we log everything. open (STDERR, ">&STDOUT"); # Call internal function, name given by $command[1] if ($command[0] eq 'kdesrc-build') { # No colors! ksb::Debug::setColorfulOutput(0); debug ("Calling $command[1]"); my $cmd = $command[1]; splice (@command, 0, 2); # Remove first two elements. no strict 'refs'; # Disable restriction on symbolic subroutines. if (! &{$cmd}(@command)) # Call sub { POSIX::_exit (EINVAL); } POSIX::_exit (0); # Exit child process successfully. } # Don't leave empty output files, give an indication of the particular # command run. Use print to go to stdout. say "# kdesrc-build running: '", join("' '", @command), "'"; say "# from directory: ", getcwd(); # If a callback is set assume no translation can be permitted. disable_locale_message_translation() if $optionsRef->{'no_translate'}; # External command. exec (@command) or do { my $cmd_string = join(' ', @command); error (<($_) && return 1) foreach @{$listRef}; return 0; } # Returns unique items of the list. Order not guaranteed. sub unique_items { # See perlfaq4 my %seen; my @results = grep { ! $seen{$_}++; } @_; return @results; } # Subroutine to delete a directory and all files and subdirectories within. # Does nothing in pretend mode. An analog to "rm -rf" from Linux. # Requires File::Find module. # # First parameter: Path to delete # Returns boolean true on success, boolean false for failure. sub safe_rmtree { my $path = shift; # Pretty user-visible path my $user_path = $path; $user_path =~ s/^$ENV{HOME}/~/; my $delete_file_or_dir = sub { # $_ is the filename/dirname. return if $_ eq '.' or $_ eq '..'; if (-f $_ || -l $_) { unlink ($_) or croak_runtime("Unable to delete $File::Find::name: $!"); } elsif (-d $_) { rmdir ($File::Find::name) or croak_runtime("Unable to remove directory $File::Find::name: $!"); } }; if (pretending()) { pretend ("Would have removed all files/folders in $user_path"); return 1; } # Error out because we probably have a logic error even though it would # delete just fine. if (not -d $path) { error ("Cannot recursively remove $user_path, as it is not a directory."); return 0; } eval { $@ = ''; finddepth( # finddepth does a postorder traversal. { wanted => $delete_file_or_dir, no_chdir => 1, # We'll end up deleting directories, so prevent this. }, $path); }; if ($@) { error ("Unable to remove directory $user_path: $@"); return 0; } return 1; } # Returns a hash digest of the given options in the list. The return value is # base64-encoded at this time. # # Note: Don't be dumb and pass data that depends on execution state as the # returned hash is almost certainly not useful for whatever you're doing with # it. (i.e. passing a reference to a list is not helpful, pass the list itself) # # Parameters: List of scalar values to hash. # Return value: base64-encoded hash value. sub get_list_digest { use Digest::MD5 "md5_base64"; # Included standard with Perl 5.8 return md5_base64(@_); } # Utility function to see if a directory path is empty or not sub is_dir_empty { my $dir = shift; opendir my $dirh, $dir or return; # while-readdir needs Perl 5.12 while (readdir $dirh) { next if ($_ eq '.' || $_ eq '..'); closedir ($dirh); return; # not empty } closedir ($dirh); return 1; } +# Takes in a string and returns 1 if that string exists somewhere in the +# path variable. +sub isInPath +{ + if (index($ENV{'PATH'}, $_[0]) != -1) { + return 1; + } else { + return 0; + } +} + +# Takes in a string and returns 1 if that string exists as a line in the +# ~/.bashrc file. +sub fileHasLine +{ + my $found = 0; + open(my $bashrc, '<', $_[0]) or _croak_runtime("Couldn't open ~/.bashrc: $!"); + + while (my $line = <$bashrc>) { + if (index($line, $_[1]) == 0){ + return 1; + } + } + + return 0; +} + 1;