#!/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);
	};
    };
}


