#!/usr/bin/env perl

# Some tests for the '--match' flag

use lib 'lib/perl';
use Test::More 'no_plan';
use Test::Darcs;
use Shell::Command;
use strict;
use warnings;

# predeclare some subs so we can use them without parens.
sub reset_repo;
sub create_entry;
sub match_date;
sub nomatch_date;
sub parse_date;

# matching by date
reset_repo();
create_entry( "1973-02-04 15:08Z" );

# parse_date just checks for parsing, while match_date checks for an actual match.
# It's better if we can use "match_date", but we have to be able to construct such a date
# based on a date dynamically generated by this test script. 

my $raw_date = get_first_date_from_changes();
my ($mon,$mm,$dd,$year,$hhmmss,$tz) = deconstruct_date( $raw_date );

# use Data::Dumper;
# warn Dumper  ($raw_date, $mon,$mm,$dd,$year,$hhmmss,$tz );

# alternately, it might be more useful to build a random date string generator
# using QuickCheck... for any n random CalendarTimes, have it generate some
# possible variants and roundtrip them to see if they match

# this block of dates should all refer to the same thing
match_date "$year-$mm-$dd";
match_date "$year$mm$dd";
match_date "$year-$mm";
match_date "$year$mm";
match_date "$year";

# week dates. note that 2007 was selected as it starts on Monday
reset_repo();
create_entry "2007-01-04 15:00";
match_date '2007-W01-4';
nomatch_date '2007-W01-1';
match_date '2007W014';
match_date '2007-W01';
nomatch_date '2007-W02-1';
create_entry "2007-01-08 15:00";
match_date '2007-W02';
match_date '2007-W02-1';
create_entry "2007-05-20 15:00";
match_date '2007-W20';
nomatch_date '2007-W21';
nomatch_date '2007-W19';
# ordinal dates. eh... why not?
match_date '2007-004'; # fourth day of 2007
match_date '2007004';
nomatch_date '2007-005';

# midnight and zero
reset_repo();
create_entry "1992-10-15 00:00";
match_date '1992-10-14 24:00';
match_date '1992-10-15 00:00';

# all the same date/time
reset_repo();
create_entry "1992-02-12T22:32:11";
match_date '1992-02-12T22:32:11';
match_date '1992-02-12 22:32:11';
match_date '1992-02-12T223211.0000';

# english dates - the old hard coded from < darcs 1.0.6
reset_repo();
create_entry_now();
$raw_date = get_first_date_from_changes();
($mon,$mm,$dd,$year,$hhmmss,$tz) = deconstruct_date( $raw_date );
reset_repo();
create_entry(($year-1)."$mm-$dd");
nomatch_date 'today';
nomatch_date 'yesterday';
nomatch_date 'day before yesterday';
nomatch_date 'last week';
nomatch_date 'last month';
# note: this test might fail if you run it just before midnight
reset_repo();
create_entry_now();
match_date 'today';
nomatch_date 'yesterday';
nomatch_date 'day before yesterday';
match_date 'last week';
match_date 'last month';

reset_repo();
create_entry(($year-1)."-$mm-$dd");
# english dates - new possibilities
nomatch_date 'yesterday at 14:00:00';
match_date 'last 3 years';
match_date 'last year';
nomatch_date '2 days ago';
nomatch_date 'last month 13:00' ;
nomatch_date '3 days before last week';
reset_repo();
create_entry_now();
match_date 'day after yesterday';
match_date 'week after last week';
create_entry("1992-10-02 00:15");
match_date '15 minutes after 1992-10-02';
reset_repo();
create_entry("1992-10-02 00:15+05");
# note that earlier dates will always match
match_date '15 minutes after 1992-10-02 00:00+05';   # same time
match_date '15 minutes after 1992-10-01 23:00+04';   # same time
nomatch_date '15 minutes after 1992-10-02 01:00+05'; # 1 hour later
nomatch_date '15 minutes after 1992-10-02 00:00+04'; # 1 hour later
nomatch_date '1 hour, 15 minutes after 1992-10-02 00:00+05'; # 1 hour later
match_date '1 hour, 15 minutes after 1992-10-02 00:00+06'; # same time
match_date '1 hour, 15 minutes after 1992-10-01 23:00+05'; # same time

reset_repo();
create_entry_now();
create_entry("1992-10-02 00:15");
# english intervals
nomatch_date 'between last fortnight and day before yesterday';
match_date 'between last fortnight and today';
match_date 'in the last 45 seconds';
match_date 'after 1992';


# iso 8601 intervals
parse_date '1992-10-02 00:00Z/1992-10-02 00:16Z';
match_date '1992-10-02 00:00/1992-10-02 00:16';
match_date 'between 1992-10-02 00:00 and 1992-10-12 00:16';
parse_date 'P3YT3M/1992';
parse_date '1992/P3Y3M4DT5H3M2S';
parse_date '1992/P3Y3M';

# stuff from the manual
reset_repo();
create_entry_now();
nomatch_date 'between 2004-03-12 and last week';
match_date 'last week';
parse_date 'yesterday';
parse_date 'today 14:00';
nomatch_date '3 days before last year at 17:00';
# We can't in general parse the raw date output by darcs.  If we change the
# format to not include timezone information, this would be possible.  But
# maybe that's not desireable.  For now, we just won't test the raw date.
#match_date "$raw_date";
parse_date 'after 2005';
parse_date 'in the last 3 weeks';
parse_date 'P3M/2006-03-17';
parse_date '2004-01-02/2006-03-17';
parse_date 'P2M6D';

# cvs dates
parse_date '2006/01/19 21:14:20 UTC';
match_date "$year/$mm/$dd $hhmmss";

# -------------------------------------------------------------------
# matching on atomic stuff (other than date)
# -------------------------------------------------------------------

init_tmp_repo();

touch 'bar';
darcs qw( add bar );
darcs qw( record -a -m "first patch"  bar -A author1 );
`echo foo > bar`;
darcs qw( record -a -m "\"second\" \\ patch" bar -A author2 );
`echo blop > bar`;
darcs qw( record -a -m "second" bar -A author3 );

# matching on author really matches on that, and not something else
unlike(darcs(qw(changes --match='author "first patch"')), qr(.+));

{ # normal changes shows both authors and both names
  my $res = darcs qw( changes );
  like($res, qr(author1));
  like($res, qr(author2));
  like($res, qr(author3));
  like($res, qr(first patch));
  like($res, qr("second" \\ patch));
  like($res, qr(second));
}

{ # exact
  my $res = darcs qw( changes --match='exact second' );
  unlike ($res, qr(author1), 'does not find unrelated patch');
  unlike ($res, qr(author2), 'does not find similar patch');
  like   ($res, qr(author3), 'finds the patch');
}

{ # name
  my $res = darcs qw( changes --match='name second' );
  unlike ($res, qr(author1), 'does not find unrelated patch');
  like   ($res, qr(author2), 'finds one of the patches');
  like   ($res, qr(author3), 'finds the other patch');
}

{ # author
  my $res = darcs qw( changes --match='author author1');
  like   ($res, qr(author1));
  unlike ($res, qr(author2));
  unlike ($res, qr(author3));
}

{ #hash
  my $xml = darcs(qw(changes --xml-output --match='exact "\"second\" \ patch"'));
  if ($xml =~ /hash='(.*?)'/) {
    my $res = darcs "changes --match='hash $1'";
    unlike($res, qr(author1));
    like  ($res, qr(author2));
    unlike($res, qr(author3));
  } else {
    ok ( 0 );
  }
}

# -------------------------------------------------------------------
# matching on combinations
#
# uses the setup from the atomic patches
# -------------------------------------------------------------------

{ # or
  my $res = darcs(qw(changes --match='author author1 || author author2'));
  like  ($res, qr(author1));
  like  ($res, qr(author2));
  unlike($res, qr(author3));
}

{ # and
  my $res = darcs(qw(changes --match='name second && author author2'));
  unlike($res, qr(author1));
  like  ($res, qr(author2));
  unlike($res, qr(author3));
}

{ # not
  my $res = darcs(qw(changes --match='not name second'));
  like  ($res, qr(author1));
  unlike($res, qr(author2));
  unlike($res, qr(author3));
}

{ # grouping
  my $res = darcs(qw(changes --match='(not name second) || author author3'));
  like  ($res, qr(author1));
  unlike($res, qr(author2));
  like  ($res, qr(author3));
}



######

# just be happy if it doesn't complain about the date being fancy
sub parse_date {
  my $d = shift;
  unlike( darcs("changes --match='date $d'"), qr(fancy), "date format $d is recognized" );
}

sub match_date {
    my $d = shift;
    like( darcs(qq(changes --match 'date "$d"')), qr/tester/, "date format $d finds a match");
}

sub nomatch_date {
    my $d = shift;
    my $out = darcs(qq(changes --match 'date "$d"'));
    unlike($out, qr/tester/, "date format $d shouldn't find a match");
    unlike($out, qr/fancy/, "date format $d should be recognized");
}

# Return the date found in the first entry of 'darcs changes';
sub get_first_date_from_changes {
    my $out = darcs 'changes';
    my ($date) = split "  tester", $out;
    # $date should now look like:  Wed Jan  9 20:02:18 EST 2008
    return $date;
}

#

=head2 deconstruct_date

    my ($mon,$mon_num,$day_num,$year,$hhmmss,$tz) = deconstruct_date( $raw_date );

# mon     => 'Jan'
# mon_num => 01
# day_num => 09
# year    => 2008
# hhmmss  => 01:03:04

Given a date as get_first_date_from_changes() returns, deconstruct it into base components. 

example input: Wed Jan  9 20:02:18 EST 2008



=cut 

sub deconstruct_date { 
    my $raw_date  = shift;

    my %month_to_num = (
        'Jan' => '01',
        'Feb' => '02',
        'Mar' => '03',
        'Apr' => '04',
        'May' => '05',
        'Jun' => '06',
        'Jul' => '07',
        'Aug' => '08',
        'Sep' => '09',
        'Oct' => '10',
        'Nov' => '11',
        'Dec' => '12',
    );

    # example input: Wed Jan  9 20:02:18 EST 2008
    my ($mon,$day_num,$hhmmss,$tz,$year) = ($raw_date =~ m{
            \s*
            \w+              # dow
            \s+
            (\w+)            # mon
            \s+
            (\d+)            # day
            \s+
            (\d\d:\d\d:\d\d) # HH::MM:SS
            \s+
            (\w+)            # Time zone abbreviation
            \s+
            (\d\d\d\d)       # year
            \s*
        }msx);
    $day_num = '0'.$day_num if (length $day_num == 1);
    my $mon_num = $month_to_num{$mon};

    return ($mon,$mon_num,$day_num,$year,$hhmmss,$tz);
}

sub reset_repo {
  init_tmp_repo();
  touch 'bar';
  darcs 'add bar';
}

sub create_entry_now {
  open BAR,">>bar";
  print BAR "today\n";
  close BAR;
  darcs('record -a -m "" bar');
}

sub create_entry {
  my ($date) = shift;
  open BAR,">>bar";
  print BAR "$date\n";
  close BAR;
  echo_to_darcs('record -m "" --pipe bar',"$date","tester","a","","");
}


