Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 255 lines (217 sloc) 6.201 kb
#!/usr/bin/perl -w
#
# mknew
# $Id: mknew,v 1.19 2006/01/14 18:28:41 johnh Exp $
#
# Copyright (C) 1996,2012 Free Software Foundation, Inc.
# Comments to <johnh@isi.edu>.
#
# This file is under the Gnu Public License, version 2.
# For details see the COPYING which accompanies this distribution.
#
sub usage {
print STDOUT <<END;
usage: $0 new-date
Create a new notes file by cloning the most recent date.
Output goes to stdout.
This program makes several assumptions about the notes-file format.
Current hurestics:
1. Before the first real entry, lines of the form
"12-Jan-96 Friday" and "12 Jan 1996" are updated.
2. A "today" entry is brought forward each day.
(Some people use this as a to-do list.)
3. If an entry named according to the day of the week exists, a new
one is made.
Known Bugs:
We assume that notes are created on the day that they correspond to.
The date is not inferred from the filename.
Known non-bug: this program is Y2K OK.
END
exit 1
}
&usage if ($#ARGV == -1 || ($#ARGV >= 0 && $ARGV[0] eq '-?'));
require 5.000;
use File::Basename;
BEGIN { unshift(@INC, $ENV{'NOTES_BIN_DIR'}); };
use NotesVars;
use Notes;
use POSIX qw(strftime);
use strict;
# xxx: dumb arg parsing
my($cache) = 0;
if ($ARGV[0] eq '-c') {
$cache = 1;
shift;
};
&usage if ($#ARGV != 0);
my($date) = @ARGV;
my($date_epoch) = pathname_to_epoch($date);
my($name, $path) = fileparse($date);
#
# Constants.
#
my(@days, @months, @short_days, @short_months, $all_days_regexp_switch, $all_months_regexp_switch);
&generate_constants;
sub generate_constants {
# this stuff is based on the suggestion in perllocale(1)
# The junk at the end is an list that is struct tm;
# things are hardcoded to year 106 == 2006 since Jan 1 is nicely on a Sunday.
foreach (0..6) {
push(@days, strftime("%A", 1,0,0,$_+1,0, 106,$_));
push(@short_days, strftime("%a", 1,0,0,$_+1,0, 106,$_));
};
foreach (0..11) {
push(@months, strftime("%B", 1,0,0,1,$_, 106));
push(@short_months, strftime("%b", 1,0,0,1,$_, 106));
};
$all_days_regexp_switch = join("|", @days, @short_days);
$all_months_regexp_switch = join("|", @months, @short_months);
};
my($prev) = &figure_prev($name, $path);
if ($cache) {
print "mknew.cache 830494922\n$prev\n$date\n";
};
my($prev_notes) = new Notes($prev);
&mknew($prev_notes);
exit 0;
sub figure_prev {
my($name, $path) = @_;
# Given ${name,path}form, back-compute noon of the current date.
my($epoch) = &pathname_to_epoch("$path/$name");
my($tries);
# search back up to a year
for ($tries = 0; $tries < 365; $tries++) {
my($newpathname) = &epoch_to_pathname($epoch);
# print "$newpathname\n";
return $newpathname if (-f $newpathname);
$epoch -= 24 * 60 * 60;
};
exit 0;
# die("$0: could not find prior note.\n");
}
sub sanitize_note {
my($note, $title) = @_;
$note =~ s/\nprev: <.*>\nnext: <.*>\n/\n/m;
$note =~ s/\* .*\n-+\n//m if ($title);
return $note;
}
sub infer_day_form {
my($sample) = @_;
return '' if ($sample eq '');
return '%a' if (length($sample) == 3);
return '%A';
}
sub infer_month_form {
my($sample) = @_;
return '' if ($sample eq '');
return '%b' if (length($sample) == 3);
return '%B';
}
sub infer_year_form {
my($sample) = @_;
return '' if ($sample eq '');
return '%y' if (length($sample) == 2);
return '%Y';
}
sub mknew {
my($prev_notes) = @_;
my($pre) = $prev_notes->prelude();
my(@F);
#
# Case 1: dates at the beginning
# This convetion in the format ``30-Apr-96 Tuesday'' is in use by johnh,
# and in the format ``30 Apr 1996'' by geoff.
#
# Case 1a: DayName? DayNum Month Year DayName?
@F = ($pre =~ /[\s\n]?
($all_days_regexp_switch)?(\W+)?
(\d+)(\W+)
($all_months_regexp_switch)(\W+)
(\d+)
(\W+)?($all_days_regexp_switch)?[\n]
[ ]?(\-+)?
(\n+)/xm);
if ($#F != -1) {
# date heading
# Sigh. Back-infer date format.
foreach (0..$#F) {
$F[$_] = '' if (!defined($F[$_]));
};
my($form);
$form = &infer_day_form($F[0]) . $F[1] .
"%d" . $F[3] .
&infer_month_form($F[4]) . $F[5] .
&infer_year_form($F[6]) .
$F[7] . &infer_day_form($F[8]);
# This next (bogus) line works around
# a bug in redhat 5.0's perl-5.004-2.
my($x) = sprintf("%x", 10);
# print STDERR "mknew: 1a1b\n";
my($new_date) = strftime_epoch($form, $date_epoch);
# Hack to fix leading zeros.
# strftime should support something like %!0d.
if ($form =~ /^%d/m && $new_date =~ /^0\d/m) {
$new_date =~ s/^0//m;
};
print "\n$new_date\n";
print "" . ("-" x length($new_date))
if ($F[9] =~ /\-/);
print $F[10];
};
# Sigh, reverse month and DayNum
# Case 1b: DayName? Month DayNum Year DayName?
@F = ($pre =~ /[\s\n]?
($all_days_regexp_switch)?(\W+)?
($all_months_regexp_switch)(\W+)
(\d+)(\W+)
(\d+)
(\W+)?($all_days_regexp_switch)?[\n]
[ ]?(\-+)?
(\n+)/xm);
if ($#F != -1) {
# date heading
# Sigh. Back-infer date format.
foreach (0..$#F) {
$F[$_] = '' if (!defined($F[$_]));
};
my($form);
$form = &infer_day_form($F[0]) . $F[1] .
&infer_month_form($F[2]) . $F[3] .
"%d" . $F[5] .
&infer_year_form($F[6]) .
$F[7] . &infer_day_form($F[8]);
my($new_date) = strftime_epoch($form, $date_epoch);
print "\n$new_date\n";
print "" . ("-" x length($new_date)) . "\n\n"
if ($F[9] =~ /\-/);
print $F[10];
};
#
# Case 2: the "today" entry.
# This convention is in use by johnh.
#
my(@todays) = $prev_notes->by_subject('Today');
if ($#todays >= 0) {
die ("Too many today entries.\n")
if ($#todays != 0);
print sanitize_note($todays[0], 0);
};
#
# Case 3: a day-of-the-week entry.
# This convention is in use by geoff.
#
my($i);
foreach $i (@days) {
my(@entries) = $prev_notes->by_subject($i);
if ($#entries != -1) {
# Generate a raw entry; don't bother to move forward contents.
my($t) = "* " . strftime_epoch("%A", $date_epoch);
print "\n" .
$t .
"\n" .
("-" x length($t)) .
"\n" .
sanitize_note($entries[0], 1);
};
};
}
Jump to Line
Something went wrong with that request. Please try again.