
  ###########################################################################
  #
  #  SCAN_THEMES
  #
  #  Take us from a state of complete theme ignorance to a fulfilling
  #  position of knowing as much about the existing themes as possible,
  #  and do it using cached info from the data file to minimize disk
  #  access.
  #
  #  results:
  #    %themes is populated
  #    %cached_dirs is populated


sub _scan_themes {
  my (@defaultdirs, $cdir, $ddir, $isdir, %scanned_dirs, $okdirs);

  return if $themes_were_scanned;

  %cached_dirs = ();
  %themes = ();

   #
   #  1) read cached directories, themes, and determine default directories
   #

  read_themedata();

    ##  these dirs exist and are readable/executable at this point
  @defaultdirs = wm_getdefaultdirs();
  dbugout(scalar @defaultdirs . " default directories:\n  ["
    . join("]\n  [", @defaultdirs) . ']') if $debug;

   #
   #  2) merge in the default directories, setting their mtime to 0
   #     so they will be automatically scanned if there was no cache entry
   #

  foreach (@defaultdirs) {
    unless (exists $cached_dirs{$_}) {
      $cached_dirs{$_} = 0;
      $themedata_modified = 1;
      dbugout("default directory \"$_\" was not cached") if $debug;
    }
  }

   #
   #  3) On each cached dir, remove if it doesn't fall within a default directory,
   #     otherwise scan it for themes.
   #

  $okdirs = '';
  CDIRS: foreach $cdir (keys %cached_dirs) {
    if (-d $cdir and -x _) {
      foreach $ddir (@defaultdirs) {
        if ($cdir =~ /^\Q$ddir\E(?:\/|$)/) {
          if ((stat _)[9] != $cached_dirs{$cdir}) {
            dbugout("scanning $cdir") if $debug;
            %scanned_dirs = wm_scandir($cdir);
            foreach (keys %scanned_dirs) {
              $cached_dirs{$_} = $scanned_dirs{$_};
            }
            $themedata_modified = 1;
          } else {
            $okdirs .= "\Q$cdir\E|";
            dbugout("not scanning $cdir") if $debug;
          }
          next CDIRS;
        }
      }
    }
    delete $cached_dirs{$cdir};
    $themedata_modified = 1;
    dbugout("directory \"$cdir\" was cached but invalid") if $debug;
  }
  chop $okdirs;

   #
   #  4) cull any themes which were read from the data file, but have
   #     not been found during scanning (i.e. 'validated' not set to 1
   #     by wm_scandir()), unless their directory was found to be
   #     unmodified
   #

  foreach (keys %themes) {
    unless ($themes{$_}{validated} or $themes{$_}{path} =~ /^(?:$okdirs)\/[^\/]+$/) {
      dbugout("culling theme $_") if $debug;
      delete $themes{$_};
      $themedata_modified = 1;
    }
  }

  $themelist = join("\n", '', keys %themes, '');
  $themes_were_scanned = 1;
}

sub createthemerec {
  my ($name, $path, $owner) = @_;

  dbugout("saving \"$name\"") if $debug;
  $themes{$name} = makethemerec() unless exists $themes{$name};
  $themes{$name}{path} = $path;
  $themes{$name}{owner} = $owner;
  $themes{$name}{mtime} = (stat $path)[9];
  $themes{$name}{validated} = 1;
}

sub read_themedata {
  my ($temptime, $datatime);
  my $dataname = "$wmthemedir/$programname.data";
  return if $themedata_was_read;
  check_reentrance();
  $themedata_was_read = 1;            # remember even the attempt

  if (-e "$dataname.temp") {
    $temptime = (stat _)[9];
    if (-e $dataname) {
      $datatime = (stat _)[9];
      if ($datatime > $temptime) {
        complain
          ("warning: temporary data file found with an older timestamp than the",
          "         data file, which exists.  this is very strange.");
        unlink "$dataname.temp" or choke("can't unlink $dataname.temp: $!");
      } else {
        unlink $dataname or choke("can't unlink $dataname: $!");
        rename "$dataname.temp", $dataname or
          choke("can't rename $dataname.temp to $dataname: $!");
      }
    } else {
      rename "$dataname.temp", $dataname or
        choke("can't rename $dataname.temp to $dataname: $!");
    }
  }
  open F, $dataname or return;

  %loginfo = (
    'lastaction', '',
    'favorite', ''
  );

  my $theme = '';

  dbugout("reading the cache") if $debug;
  while (<F>) {
    if ($theme ne '') {   # Perl's concept of truth rears its ugly head!
      if (/^\s*endtheme/) {
        $theme = '';
      } elsif (/^\s*(\S+) (.+)/) {
        $themes{$theme}{$1} = $2;
      }
    } elsif (/^\s*dir (\d+) (.+)/) {
      $cached_dirs{$2} = $1;
      dbugout("cached dir $2 $1") if $debug;
    } elsif (/^\s*theme (.+)/) {
      $theme = $1;
      $themes{$theme} = makethemerec();
    } elsif (/^\s*installed (.+)/) {
      push @installlog, $1;
    } elsif (/^\s*(\S+) (.+)/) {
      $loginfo{$1} = $2;
    }
  }
  close F;
}

  ###########################################################################
  #
  #  WRITE_THEMEDATA
  #

sub _write_themedata {
  my $filename = "$wmthemedir/$programname.data";
  return unless open F, ">$filename.temp";

  my ($theme, $dir);

  dbugout("writing the cache") if $debug;
  foreach $theme (keys %themes) {
    print F "theme $theme\n";
    foreach (keys %{$themes{$theme}}) {
      print F "  $_ $themes{$theme}{$_}\n" if $themes{$theme}{$_} ne ''
        and $_ ne 'validated';
    }
    print F "endtheme\n\n";
  }

  foreach $dir (keys %cached_dirs) {
    print F "dir $cached_dirs{$dir} $dir\n";
  }
  foreach (@installlog) {
    print F "installed $_\n";
  }
  foreach (keys %loginfo) {
    print F "$_ $loginfo{$_}\n" if $loginfo{$_} ne '';
  }
  close F;
  $themedata_modified = 0;
  if (-f $filename) {
    unlink $filename or
      choke("can't remove unlink $filename: $!");
  }
  rename "$filename.temp", $filename or
    choke("can't rename $filename.temp to $filename: $!");
}

sub check_reentrance {
  $lockname = "$wmthemedir/$programname.lock";

  if (-l $lockname or -e $lockname) {

    ## Make sure it's a symlink (paranoia!)
    unless (-l _) {
      unlink $lockname or choke("can't remove invalid lockfile $lockname: $!");
      return;
    }

    $oldpid = readlink($lockname);

    ## Make sure it's numeric (paranoia again)
    unless ($oldpid =~ /^\d+$/) {
      unlink $lockname or choke("can't remove invalid lockfile $lockname: $!");
      complain("invalid lockfile \"$oldpid\" found and removed (continuing)");
      return;
    }

    ## Make sure it's really running before complaining
    ## [following kill command tested on: Linux, OpenBSD, SunOS]
    unless (kill(0, $oldpid)) {
      ## Not running.
      unlink $lockname or choke("can't remove stale lockfile $lockname: $!");
      return;
    }

    complain
      ("$programname seems to be running already, and running multiple copies of",
      "$programname is bad.  Press Y to continue if $programname isn't really",
      "running.  Continue? [y/N] ");

    if (<STDIN> =~ /^[yY]/) {
      unless (kill('TERM', $oldpid)) {
        ## Running, term failed
        complain("$programname: polite termination request failed, going brutal");
        unless (kill('KILL', $oldpid)) {
          choke("unable to proceed -- indestructible zombie at pid $oldpid");
        }
      }
      unlink $lockname or choke("can't remove lockfile $lockname: $!");
      
    } else {
      complain("bye.");
      exit;
    }
  }
  symlink $$, $lockname;
}

1;

