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

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # mknew
   5 # $Id: mknew,v 1.19 2006/01/14 18:28:41 johnh Exp $
   6 #
   7 # Copyright (C) 1996,2012  Free Software Foundation, Inc.
   8 # Comments to <johnh@isi.edu>.
   9 #
  10 # This file is under the Gnu Public License, version 2.
  11 # For details see the COPYING which accompanies this distribution.
  12 #
  13
  14
  15 sub usage {
  16     print STDOUT <<END;
  17 usage: $0 new-date
  18
  19 Create a new notes file by cloning the most recent date.
  20 Output goes to stdout.
  21
  22 This program makes several assumptions about the notes-file format.
  23 Current hurestics:
  24
  25 1.  Before the first real entry, lines of the form
  26 "12-Jan-96 Friday" and "12 Jan 1996" are updated.
  27
  28 2.  A "today" entry is brought forward each day.
  29 (Some people use this as a to-do list.)
  30
  31 3.  If an entry named according to the day of the week exists, a new
  32 one is made.
  33
  34
  35 Known Bugs:
  36 We assume that notes are created on the day that they correspond to.
  37 The date is not inferred from the filename.
  38
  39 Known non-bug:  this program is Y2K OK.
  40 END
  41     exit 1
  42 }
  43
  44
  45 &usage if ($#ARGV == -1 || ($#ARGV >= 0 && $ARGV[0] eq '-?'));
  46
  47 require 5.000;
  48 use File::Basename;
  49 BEGIN { unshift(@INC, $ENV{'NOTES_BIN_DIR'}); };
  50 use NotesVars;
  51 use Notes;
  52 use POSIX qw(strftime);
  53 use strict;
  54
  55
  56 # xxx: dumb arg parsing
  57 my($cache) = 0;
  58 if ($ARGV[0] eq '-c') {
  59     $cache = 1;
  60     shift;
  61 };
  62 &usage if ($#ARGV != 0);
  63 my($date) = @ARGV;
  64 my($date_epoch) = pathname_to_epoch($date);
  65 my($name, $path) = fileparse($date);
  66
  67
  68 #
  69 # Constants.
  70 #
  71 my(@days, @months, @short_days, @short_months, $all_days_regexp_switch, $all_months_regexp_switch);
  72 &generate_constants;
  73
  74 sub generate_constants {
  75     # this stuff is based on the suggestion in perllocale(1)
  76     # The junk at the end is an list that is struct tm;
  77     # things are hardcoded to year 106 == 2006 since Jan 1 is nicely on a Sunday.
  78     foreach (0..6) {
  79         push(@days, strftime("%A",  1,0,0,$_+1,0, 106,$_));
  80         push(@short_days, strftime("%a", 1,0,0,$_+1,0, 106,$_));
  81     };
  82     foreach (0..11) {
  83         push(@months, strftime("%B", 1,0,0,1,$_, 106));
  84         push(@short_months, strftime("%b", 1,0,0,1,$_, 106));
  85     };
  86     $all_days_regexp_switch = join("|", @days, @short_days);
  87     $all_months_regexp_switch = join("|", @months, @short_months);
  88 };
  89
  90 my($prev) = &figure_prev($name, $path);
  91
  92 if ($cache) {
  93     print "mknew.cache 830494922\n$prev\n$date\n";
  94 };
  95 my($prev_notes) = new Notes($prev);
  96 &mknew($prev_notes);
  97
  98
  99 exit 0;
 100
 101
 102 sub figure_prev {
 103     my($name, $path) = @_;
 104
 105     # Given ${name,path}form, back-compute noon of the current date.
 106     my($epoch) = &pathname_to_epoch("$path/$name");
 107
 108     my($tries);
 109     # search back up to a year
 110     for ($tries = 0; $tries < 365; $tries++) {
 111         my($newpathname) = &epoch_to_pathname($epoch);
 112         # print "$newpathname\n";
 113         return $newpathname if (-f $newpathname);
 114         $epoch -= 24 * 60 * 60;
 115     };
 116     exit 0;
 117     # die("$0: could not find prior note.\n");
 118 }
 119
 120 sub sanitize_note {
 121     my($note, $title) = @_;
 122     $note =~ s/\nprev: <.*>\nnext: <.*>\n/\n/m;
 123     $note =~ s/\* .*\n-+\n//m if ($title);
 124     return $note;
 125 }
 126
 127 sub infer_day_form {
 128     my($sample) = @_;
 129     return '' if ($sample eq '');
 130     return '%a' if (length($sample) == 3);
 131     return '%A';
 132 }
 133
 134 sub infer_month_form {
 135     my($sample) = @_;
 136     return '' if ($sample eq '');
 137     return '%b' if (length($sample) == 3);
 138     return '%B';
 139 }
 140
 141 sub infer_year_form {
 142     my($sample) = @_;
 143     return '' if ($sample eq '');
 144     return '%y' if (length($sample) == 2);
 145     return '%Y';
 146 }
 147
 148 sub mknew {
 149     my($prev_notes) = @_;
 150     my($pre) = $prev_notes->prelude();
 151     my(@F);
 152
 153     #
 154     # Case 1:  dates at the beginning
 155     # This convetion in the format ``30-Apr-96 Tuesday'' is in use by johnh,
 156     # and in the format ``30 Apr 1996'' by geoff.
 157     #
 158     # Case 1a:  DayName? DayNum Month Year DayName?
 159     @F = ($pre =~ /[\s\n]?
 160             ($all_days_regexp_switch)?(\W+)?
 161             (\d+)(\W+)
 162             ($all_months_regexp_switch)(\W+)
 163             (\d+)
 164             (\W+)?($all_days_regexp_switch)?[\n]
 165             [ ]?(\-+)?
 166             (\n+)/xm);
 167     if ($#F != -1) {
 168         # date heading
 169         # Sigh.  Back-infer date format.
 170         foreach (0..$#F) {
 171             $F[$_] = '' if (!defined($F[$_]));
 172         };
 173         my($form);
 174         $form = &infer_day_form($F[0]) . $F[1] .
 175                 "%d" . $F[3] .
 176                 &infer_month_form($F[4]) . $F[5] .
 177                 &infer_year_form($F[6]) .
 178                 $F[7] . &infer_day_form($F[8]);
 179         # This next (bogus) line works around
 180         # a bug in redhat 5.0's perl-5.004-2.
 181         my($x) = sprintf("%x", 10);
 182 # print STDERR "mknew: 1a1b\n";
 183         my($new_date) = strftime_epoch($form, $date_epoch);
 184         # Hack to fix leading zeros.
 185         # strftime should support something like %!0d.
 186         if ($form =~ /^%d/m && $new_date =~ /^0\d/m) {
 187             $new_date =~ s/^0//m;
 188         };
 189         print "\n$new_date\n";
 190         print "" . ("-" x length($new_date))
 191             if ($F[9] =~ /\-/);
 192         print $F[10];
 193     };
 194     # Sigh, reverse month and DayNum
 195     # Case 1b:  DayName? Month DayNum Year DayName?
 196     @F = ($pre =~ /[\s\n]?
 197             ($all_days_regexp_switch)?(\W+)?
 198             ($all_months_regexp_switch)(\W+)
 199             (\d+)(\W+)
 200             (\d+)
 201             (\W+)?($all_days_regexp_switch)?[\n]
 202             [ ]?(\-+)?
 203             (\n+)/xm);
 204     if ($#F != -1) {
 205         # date heading
 206         # Sigh.  Back-infer date format.
 207         foreach (0..$#F) {
 208             $F[$_] = '' if (!defined($F[$_]));
 209         };
 210         my($form);
 211         $form = &infer_day_form($F[0]) . $F[1] .
 212                 &infer_month_form($F[2]) . $F[3] .
 213                 "%d" . $F[5] .
 214                 &infer_year_form($F[6]) .
 215                 $F[7] . &infer_day_form($F[8]);
 216         my($new_date) = strftime_epoch($form, $date_epoch);
 217         print "\n$new_date\n";
 218         print "" . ("-" x length($new_date)) . "\n\n"
 219             if ($F[9] =~ /\-/);
 220         print $F[10];
 221     };
 222
 223     #
 224     # Case 2:  the "today" entry.
 225     # This convention is in use by johnh.
 226     #
 227     my(@todays) = $prev_notes->by_subject('Today');
 228     if ($#todays >= 0) {
 229         die ("Too many today entries.\n")
 230             if ($#todays != 0);
 231         print sanitize_note($todays[0], 0);
 232     };
 233
 234     #
 235     # Case 3:  a day-of-the-week entry.
 236     # This convention is in use by geoff.
 237     #
 238     my($i);
 239     foreach $i (@days) {
 240         my(@entries) = $prev_notes->by_subject($i);
 241         if ($#entries != -1) {
 242             # Generate a raw entry; don't bother to move forward contents.
 243             my($t) = "* " . strftime_epoch("%A", $date_epoch);
 244             print "\n" .
 245                 $t .
 246                 "\n" .
 247                 ("-" x length($t)) .
 248                 "\n" .
 249                 sanitize_note($entries[0], 1);
 250         };
 251     };
 252 }
 253
 254