Optware Collector

optware.pl

#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Long;
use List::Util qw(first);
use File::Basename;
use File::Path qw(make_path remove_tree);
use File::Temp qw(tempdir);
use File::Find;
use File::Copy::Recursive qw(rmove);
use Cwd qw(abs_path);

my $HOME = $ENV{HOME};

my @cfg_search        = split(/:/, $ENV{OPTWARE_SEARCH_DIRS} || "$HOME/.local/opt:/opt");
my $cfg_cache         = $ENV{OPTWARE_CACHE_DIR} || "$HOME/.cache/optware";
my $cfg_bin           = undef;
my $cfg_bin_old       = undef;
my $cfg_override_file = $ENV{OPTWARE_OVERRIDE_FILENAME} || ".optware_path";
my $cfg_exports_file  = $ENV{OPTWARE_EXPORT_FILENAME} || ".optware_export";
my $cfg_max_depth     = $ENV{OPTWARE_MAX_DEPTH} || 3;
my @cfg_bindir_names  = split(/:/, $ENV{OPTWARE_BINDIR_NAMES} || ".:bin:bin64:bin32:libexec");

my $preview = 0;
my $verbose = 0;

my $what = undef;

GetOptions(
   'update'        => \&set_what,
   'search-dir=s%' => \@cfg_search,
   'bin-dir=s%'    => \@cfg_bindir_names,
   'cache-dir=s'   => \$cfg_cache,
   'preview+'      => \$preview,
   'max-depth=i'   => \$cfg_max_depth,
   'verbose=i'     => sub {
      my ($_name, $param) = @_;
      if ($param && $param =~ m/\d*/) {
         $verbose = $param;
      } else {
         ++$verbose;
      }
   },
);

$cfg_bin ||= $ENV{OPTWARE_BIN_DIR} || "$cfg_cache/bin";
$cfg_bin_old ||= $ENV{OPTWARE_BIN_DIR_OLD} || "${cfg_bin}.old";

make_path($cfg_cache, $cfg_bin, dirname($cfg_bin_old));

die "Invalid action or action not present\n" unless $what;

if ($what eq 'update') {
   cmd_update();
}

exit;

sub cmd_update {
   my @optware_dirs;
   my @target_dirs;
   my @target_files;

   # Collect all optware dirs (directories immediately beneath an optware dir)
   foreach my $search_dir (@cfg_search) {
      my $base_depth = depth($search_dir);

      find({
         wanted => sub {
            return if depth($_) > ($base_depth + 1);
            if (-d $_) {
               push @optware_dirs, $_;
               printf_debug("optware_dirs += %s\n", $_);
            }
         },
         no_chdir => 1
      }, $search_dir);
   }

   # Process optware dirs and search for candidate bin dirs
   foreach my $optware_dir (@optware_dirs) {
      my $base_depth = depth($optware_dir);

      my $exports_file  = "$optware_dir/$cfg_exports_file";
      my $override_file = "$optware_dir/$cfg_override_file";

      if (-f $exports_file) {
         # There is list of files to be exported here, don't search at all and add entries to @target_files
         open my $exports, "<$exports_file";
         while (<$exports>) {
            chomp;

            next if $_ eq '';

            my $fqp = "$optware_dir/$_";
            push @target_files, $fqp;
            printf_debug("target_files += %s (export file: %s)\n", $fqp, $exports_file);
         }
         close $exports;
      } elsif (-f $override_file) {
         # Insert a custom list of search directories into @target_dirs
         open my $custom, "<$override_file";
         while (<$custom>) {
            chomp;

            next if $_ eq '';

            my $fqp = "$optware_dir/$_";

            if (-d $fqp) {
               push @target_dirs, $fqp;
               printf_debug("target_dirs += %s (path file: %s)\n", $fqp, $override_file);
            } else {
               warn "Invalid search directory: $fqp\n";
            }
         }
         close $custom;
      } else {
         find({
            wanted => sub {
               return if depth($_) > ($base_depth + $cfg_max_depth);
               if (is_candidate($_)) {
                  push @target_dirs, $_;
                  printf_debug("target_dirs += %s\n", $_);
               }
            },
            no_chdir => 1
         }, $optware_dir);

         push @target_dirs, $optware_dir if first {$_ eq '.'} @cfg_bindir_names;
      }
   }

   # Process target dirs and collect executable files
   foreach my $target_dir (@target_dirs) {
      opendir(my $dh, $target_dir) || die "Can't open candidate directory $target_dir: $!";

      while (readdir($dh)) {
         next if $dh =~ /\.+/;

         my $fqp = "$target_dir/$_";

         if (!(-d $fqp) && -x $fqp) {
            push @target_files, $fqp;
            printf_trace("target_files += %s\n", $fqp);
         }
      }

      closedir $dh;
   }

   # Prepare output directory and build link cache
   my $stage_dir = tempdir(CLEANUP => 0, TEMPLATE => "/tmp/optware_bin_XXXXX");

   foreach my $target (@target_files) {
      my $basename = basename($target);
      my $link     = "$stage_dir/$basename";

      if (-l $link) {
         printf_nag("$link already exists (points to " . (readlink $link) . ")\n");
      }

      printf_trace("symlink at $stage_dir/$basename pointing to $target\n");
      symlink abs_path($target), "$stage_dir/$basename";
   }

   # Remove the .old bindir
   printf_debug("remove $cfg_bin_old if present\n");
   remove_tree($cfg_bin_old) if -e $cfg_bin_old;

   # Move the current bindir to .old
   printf_debug("rename $cfg_bin to $cfg_bin_old\n");
   rmove($cfg_bin, $cfg_bin_old) if -e $cfg_bin or die "Could not move old bindir: $!";

   # Promote the staging bindir to the current bindir
   printf_debug("rename $stage_dir to $cfg_bin\n");
   rmove($stage_dir, $cfg_bin) or die "Could not move stage dir: $!";
}

sub set_what {
   die "Only one mode may be specified" if $what;
   my ($name, $_value) = @_;
   $what = $name;
}

sub is_candidate {
   my ($path) = @_;
   my $basename = basename($path);
   (first {$_ eq $basename} @cfg_bindir_names) && -d $path;
}

sub depth {
   my ($path) = @_;
   $path =~ tr!/!!;
}

sub printf_nag {
   printf @_ if $verbose >= 1;
}

sub printf_debug {
   printf @_ if $verbose >= 2;
}

sub printf_trace {
   printf @_ if $verbose >= 3;
}