code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/mkall

   1 #!/usr/bin/perl -w
   2 # If the above path is incorrect for your system,
   3 # FOLLOW THE INSTALLATION INSTRUCTIONS in README.
   4
   5 #
   6 # mkall
   7 # $Id: mkall,v 1.18 2007/02/23 05:14:59 johnh Exp $
   8 #
   9 # Copyright (C) 1996,2012  Free Software Foundation, Inc.
  10 # Comments to <johnh@isi.edu>.
  11 #
  12 # This file is under the Gnu Public License, version 2.
  13 # For details see the COPYING which accompanies this distribution.
  14 #
  15
  16 sub usage {
  17     print STDOUT <<END;
  18 usage: $0
  19
  20 Does all reindexing needed for notes-mode.
  21 END
  22     exit 1;
  23 }
  24
  25
  26 require 5.000;
  27 BEGIN { unshift(@INC, $ENV{'NOTES_BIN_DIR'}); };
  28 use NotesVars;
  29 use strict;
  30 use Config;
  31
  32 &usage if (($#ARGV >= 0 && $ARGV[0] eq '-?'));
  33
  34 my($perl) = &find_perl_binary;
  35
  36 # xxx: currently rawindex generates @subjects that index uses.
  37 # Should remove this dependency.
  38 my(@subjects) = ();
  39
  40 &make_rawindex;
  41 &make_index;
  42 &make_index_cache;
  43 &make_prevnext;
  44 &make_mknew_cache;
  45 &fix_perms;
  46
  47 exit 0;
  48
  49
  50 sub find_perl_binary {
  51     my($perl) = $^X;
  52     return $perl if (-x $perl);
  53     $perl = $Config{'installbin'} . "/perl";
  54     return $perl if (-x $perl);
  55     # If we can't find perl, then we assume the user's set the #! lines correctly.
  56     return '';
  57 }
  58
  59
  60 sub run_over_all_notes {
  61     my($cmd, $user_cmd_name) = @_;
  62     open(CMD, "| $cmd") || die ("$0: cannot run $user_cmd_name.\n");
  63     foreach (glob "$::notes{'int_glob'}/$::notes{'file_glob'}") {
  64         print CMD "$_\n";
  65     };
  66     close CMD;
  67     if ($? >> 8) {
  68         die "$0: $user_cmd_name failed.";
  69     };
  70 }
  71
  72
  73 #
  74 # rawindex
  75 #
  76 #
  77 # The main thing that happens here is we find and sort the notes entries.
  78 # We do the sorting in perl because the system sort is less portable
  79 # (wrt stability, for example).
  80 #
  81 sub make_rawindex {
  82     chdir ($::notes{'dir'}) || die "$0: cannot cd to $::notes{'dir'}.\n";
  83     # if (-f "rawindex") {
  84     #     rename('rawindex', 'rawindex~') || die "$0: cannot rename rawindex.\n";
  85     # };
  86     # my($sed_arg) = '"s@' . $::notes{home} . '@/~@"';
  87     # system(<<END);
  88     #     $::notes{'bin_dir'}/mkrawindex $::notes{'dir'}/$::notes{'int_glob'}/$::notes{'file_glob'} |
  89     #     sort -f -t# +1 +0 |
  90     #     sed $sed_arg > rawindex
  91     # END
  92     # if ($? >> 8) {
  93     #     rename('rawindex', 'rawindex.bad');
  94     #     rename('rawindex~', 'rawindex');
  95     #     die "$0: rawindex pipeline failed.";
  96     # };
  97     #
  98     # xxx: eventually this will overflow the buffer and we'll need to
  99     # do something like xargs.  However, in 10 years of use this hasn't happened
 100     # for me yet.
 101     run_over_all_notes("$perl $::notes{'bin_dir'}/mkrawindex -X >prerawindex", "mkrawindex");
 102 #    open (IF, "$perl $::notes{'bin_dir'}/mkrawindex $::notes{'dir'}/$::notes{'int_glob'}/$::notes{'file_glob'} |") || die "$0: cannot run mkrawindex\n";
 103 #    binmode IF;
 104     open(IF, "<prerawindex") || die  "$0: cannot open prerawindex.\n";
 105     binmode IF;
 106     open (OF, ">rawindex+") || die "$0: cannot write to rawindex+\n";
 107     binmode OF;
 108     my($internal_marker) = chr(1);
 109     foreach (<IF>) {
 110         chomp;
 111         s@$::notes{'home'}@/~@;
 112         my($left, $right) = /^([^#]+)\#(.*)$/;
 113         push(@subjects, "${right}${internal_marker}${left}");
 114     };
 115     close IF;
 116     @subjects = sort { uc($a) cmp uc($b) } @subjects;
 117     foreach (0..$#subjects) {
 118         my($left, $right) = ($subjects[$_] =~ /^(.+)${internal_marker}(.*)$/);
 119         $subjects[$_] = "$right#$left";
 120         print OF "$subjects[$_]\n";
 121     };
 122     close OF;
 123     if (-f 'rawindex') {
 124         rename('rawindex', 'rawindex~') || die "$0: rename rawindex{,~} failed.\n";
 125     };
 126     rename('rawindex+', 'rawindex') || die "$0: rename rawindex{+,} failed.\n";
 127 }
 128
 129 #
 130 # index
 131 #
 132 sub make_index {
 133     if (-f 'index') {
 134         rename('index', 'index~') || die "$0: rename index{,~} failed.\n";
 135     };
 136     open (OF, "| $perl $::notes{'bin_dir'}/mkindex > index") || die "$0: cannot run mkindex.\n";
 137     binmode OF;
 138     my($last);
 139     foreach (@subjects) {
 140         if (!defined($last) || $last ne uc($_)) {
 141             print OF "$_\n";
 142             $last = uc($_);
 143          };
 144     };
 145     close OF;
 146     if ($? >> 8) {
 147         rename('index', 'index.bad') || warn "$0: recovery rename index{,.bad} failed.\n";
 148         rename('index~', 'index') || warn "$0: recovery rename index{~,} failed.\n";
 149         die "$0: index pipeline failed.";
 150     };
 151 }
 152
 153 #
 154 # index_cache.el
 155 #
 156 # Yes, the code should probably be compiled,
 157 # but compilation time doesn't seem to be the problem.
 158 #
 159 sub make_index_cache {
 160     if (-f 'index_cache.el') {
 161         rename('index_cache.el', 'index_cache.el~') || die "$0: rename index_cache.el{,~} failed.\n";
 162     };
 163     system(<<END);
 164     $perl $::notes{'bin_dir'}/mkindexcache < index > index_cache.el
 165 END
 166     #    emacs -batch --eval '(byte-compile-file "index_cache.el")' 2>&1 | grep -v 'free variable'
 167     if ($? >> 8) {
 168         rename('index_cache.el', 'index_cache.el.bad') || warn "$0: reanme index_cache.el{,.bad} failed.\n";
 169         rename('index_cache.el~', 'index_cache.el') || warn "$0: rename index_cache.el{~,} failed.\n";
 170         unlink('index_cache.elc') if (-f 'index_cache.elc');
 171         die "$0: index pipeline failed.";
 172     };
 173     #
 174     # Bug found by Klaus Zeitler <kzeitler@lucent.com>:
 175     # if we generate index_cache.el in less than a second,
 176     # it won't be considered up-to-date.
 177     #
 178     if (-M 'index' == -M 'index_cache.el') {
 179         # We're too fast---stall and update the file
 180         sleep(1);   # stall
 181         system('touch index_cache.el');   # "update"
 182     };
 183 }
 184
 185
 186 #
 187 # prevnext
 188 #
 189 sub make_prevnext {
 190     run_over_all_notes("$perl $::notes{'bin_dir'}/mkprevnext -X ./rawindex", "mkprevnext");
 191 }
 192
 193 #
 194 # mknew cache
 195 #
 196 sub make_mknew_cache {
 197     my($todays_file) = &epoch_to_pathname(time);
 198     system(<<END);
 199     $perl $::notes{'bin_dir'}/mknew -c $todays_file >./mknew.cache
 200 END
 201 }
 202
 203 #
 204 # fix permissions
 205 #
 206 sub fix_perms {
 207     my($perm);
 208     foreach (glob("*"), glob("*/*")) {
 209         my($mode) = (stat($_))[2];
 210         if ($mode & 0077) {
 211             chmod (($mode & 0700), $_) || warn "$0: could not chmod $_.\n";
 212         };
 213     };
 214 }
 215
 216