#!/usr/bin/perl -w
use strict;
use Cwd;
use Getopt::Long;
use IO::File;
use Data::Dumper;
use Date::Format;
use List::Util qw(first);

$|=1;

# done: write code to fill out fields that were initially missing
#  current:
#    messages.{created,user,message}
#    history.{changed,new,old,field}
#    created,fullid,history,lid,messages,state,title
#    reported,summary,component,project  -- are not in all tickets
#   
# done: change vcs->proj+comp   to 'related paths'
# done: allow add to 'related' set
#
# tick -n    will ignore the current dir and not filter for related paths
# tick       will list tickets related to the current path

sub findroot {
    my (@names)=@_;
    my $dir= getcwd;
    $dir =~ s{[/\\]$}{};

    while (!empty($dir) && ! grep { -d "$dir/$_" } @names)
    {
        $dir =~ s{[/\\][^/\\]+$}{};
    }

    return grep { -d $_ } map { "$dir/$_" } @names;
}
sub read_config {
    my ($file)=@_;
    my $fh= IO::File->new($file, "r") || return {};

    my $VAR1;
    local $/;
    eval <$fh>;
    if ($@) {
        print("error parsing config: $@\n");
    }
    $fh->close();
    return $VAR1;
}
sub save_config {
    my ($file, $cfg)=@_;
    my $fh= IO::File->new($file, "w") || return;
    $fh->print(Dumper($cfg));
    $fh->close();
}
sub create_tickdir {
    my ($dir)= @_;
    mkdir "$dir/.tick";
    mkdir "$dir/.tick/issues";
}

if (@ARGV && $ARGV[0] eq 'init') {
    create_tickdir(".");
    exit 0;
}
my ($tickdir)= findroot(".tick") or die mainusage("no .tick dir found\n");
my $filecfg= read_config($tickdir."/config");
my $cfg= {
    # defaults;
    user=>$ENV{USER},
    next_lid=>1,
    %$filecfg
};
sub set_config {
    my ($key, $val)= @_;
    $cfg->{$key}=$val;
    save_config($tickdir."/config", $cfg);
}

sub mainusage {
    return <<__EOF__
@_
simple distributed ticketing system

  tick            - lists all open tickets
  tick init       - create new tick database in current directory
  tick new        [contents]
  tick [selector]      : summary of tickets matching selector
  tick [selector]  [contents]     : modify ticket fields
  tick [selector]  -m "message"   : add message to ticket
  tick close [selector]  -m "message"
options:
  -n : don't use curdir for 'related' filter
  -v : verbose

[contents]      |  [selector] can be:
  -c component  |  [fields]/regex/  - matches tickets with matching field(s)
  -s summary    |  #id              - local id
  -a assigned   |  xxx-xxx-xx       - matches full uniqueid
  -T type       |  @                - most recently used ticket
  -p project    | 
  -t title      | fields: c,s,a,T,p,t,S ( like contents )
  -S state      |
  +. add cwd to related
  -. remove cwd from related
__EOF__
}

my $filter_related= 1;
my $verbose= 0;
my $upgradeformat= 0;
while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
    my $flag= $1;
    if ($flag eq 'n') {
        $filter_related=0;
    }
    elsif ($flag eq 'v') {
        $verbose=1;
    }
#   elsif ($flag eq 'F') {
#       $upgradeformat=1;
#   }
    else {
        die mainusage("invalid option: $ARGV[0]\n");
    }
    shift @ARGV;
}
my $add_cwd_to_related;
my $del_cwd_from_related;

my @add_to_related;
my @del_from_related;

my @keywords;
my @selectors;
my @contents;
my @messages;

my $contentfield;

my %letter2field= (
    c=>'component',
    s=>'summary',
    a=>'assigned',
    T=>'type',
    p=>'project',
    t=>'title',
    S=>'state',
    m=>'message',
);
sub get_proj_comp_from_dir {
    my ($dir)= @_;
    $dir =~ s/\/\.\w+$//;

    my $cwd= getcwd;
    if ($cwd eq $dir) {
        return ('','');
    }

    my $project= substr($cwd, length($dir)+1);
    if ($project =~ /\//) {
        my $comp = $project;

        $project =~ s/\/.*//;
        $comp = substr($comp, length($project)+1);
        return ($project, $comp);
    }
    else {
        return ($project, '');
    }
}
sub get_proj_comp_from_vcs {
    my ($vcsdir)= @_;
    $vcsdir =~ s/\/\.\w+$//;

    my $project= $vcsdir;
    $project =~ s/.*\///;

    my $cwd= getcwd;
    if ($cwd eq $vcsdir) {
        return ($project, "");
    }

    return ($project, substr($cwd, length($vcsdir)+1));
}
sub get_proj_comp_from_svn_entries {
    my ($entriesfile)= @_;
    my $fh= IO::File->new($entriesfile, "r") or return ();
    my ($repos, $url);
    my $firstline= <$fh>;
    if ($firstline =~ /^<\?xml/) {
        while (<$fh>) {
            if (/url=\"(.*)\"/) { $url=$1; }
            elsif (/repos=\"(.*)\"/) { $url=$1; last; }
        }
    }
    else {
        for (1..3) {
            # skip 3 lines
            my $line= <$fh>;
        }
        $url=<$fh>;
        $repos=<$fh>;
    }
    $fh->close();
    $repos =~ s/\/?\s*$//;
    $url=~ s/\/?\s*$//;
    (my $project= $repos) =~ s/.*\///;

    if ($url eq $repos || $url =~ /\/(?:trunk|tags|branches)$/) {
        return ($project, '');
    }
    my $comp= substr($url, length($repos)+1);
    $comp =~ s/^trunk\///;
    return ($project, $comp);
}

for my $arg (@ARGV) {
    if (!empty($contentfield)) {
        if ($contentfield eq 'message') {
            if ($arg eq '-') {
                $arg=join("", <>);
            }
            push @messages, $arg;
        }
        else {
            push @contents, { field=>$contentfield, value=>$arg };
        }
        $contentfield=undef;
    }
    elsif ($arg =~ /^\w+$/) {
        push @keywords, $arg;
    }
    elsif ($arg =~ /^#(\d+(?:,\d+)*)$/) {
        push @selectors, { type=>'localid', list=>[split /,/, $1] };
    }
    elsif ($arg =~ /^(\w+-\w+-\w+-\w+-\w+)$/) {
        push @selectors, { type=>'fullid', value=>$1 };
    }
    elsif ($arg eq '@') {
        push @selectors, { type=>'current' };
    }
    elsif ($arg =~ m{^([\w*])/(.*)/$}) {
        push @selectors, { type=>'regex', fields=>$1, regex=>$2 };
    }
    elsif ($arg eq "+.") { $add_cwd_to_related++; }
    elsif ($arg eq "-.") { $del_cwd_from_related++; }
    elsif ($arg =~ /^-(\w)$/) {
        my $letter= $1;
        if (!exists $letter2field{$letter}) {
            die mainusage("unknown option: $arg\n");
        }
        $contentfield= $letter2field{$letter};
    }
    else {
        die mainusage("unhandled argument: $arg\n");
        
    }
}
# done processing arguments
my $no_selector_args=!@selectors;
my $no_content_args=!(@contents || $add_cwd_to_related || $del_cwd_from_related);
my $no_message_args=!@messages;

sub genguid {
    my $guid="";
    for (0..7) {
        $guid .= '-' if $_ >= 2 && $_ <= 5;
        $guid .= sprintf("%04lx", rand(0x10000));
    }
    return $guid;
}
sub alloclocalid {
    my $id= $cfg->{next_lid};
    $cfg->{next_lid}++;
    save_config($tickdir."/config", $cfg);
    return $id;
}

my ($vcs_project, $vcs_subdir)=('','');
my ($vcsdir)= findroot(".svn", ".git");
#printf("vcs=%s\n", $vcsdir);
if ($add_cwd_to_related || $del_cwd_from_related || $filter_related) {
    if (!empty($vcsdir)) {
        if ($vcsdir=~/\.git/) {
            ($vcs_project, $vcs_subdir)= get_proj_comp_from_vcs($vcsdir);
        }
        elsif ($vcsdir=~/\.svn/) {
            ($vcs_project, $vcs_subdir)= get_proj_comp_from_svn_entries("$vcsdir/entries");
        }
        printf("%s: %s : %s\n", substr($vcsdir,-3), $vcs_project, $vcs_subdir) if ($verbose);
    }
    else {
        # deduce from current dir
        ($vcs_project, $vcs_subdir)= get_proj_comp_from_dir($tickdir);
    }
}
my $relateto_dir=$vcs_project ? "$vcs_project:$vcs_subdir" : "";
push @add_to_related, $relateto_dir if ($add_cwd_to_related);
push @del_from_related, $relateto_dir if ($del_cwd_from_related);
if (@keywords && $keywords[0] eq 'new') {
    if (!$no_selector_args) {
        die mainusage("can't have selectors with new\n");
    }
    create_new_ticket(\@contents);
    exit 0;
}
if (@keywords) {
    die mainusage("unknown keywords: @keywords\n");
}

push @selectors, { type=>'related', dir=>$relateto_dir } if ($filter_related);
if ($no_content_args && $no_selector_args && $no_message_args) {
    push @selectors,({ type=>'regex', fields=>'S', regex=>'open' });

    list_selected_tickets(\@selectors);
    exit 0;
}
if ($no_content_args && $no_message_args) {
    list_selected_tickets(\@selectors);
    exit 0;
}
if ($no_selector_args) {
    die mainusage("must have selector with contents\n");
}

push @contents, { addto=>'related', value=>$_ } for (@add_to_related);
push @contents, { delfrom=>'related', value=>$_ } for (@del_from_related);
modify_ticket(\@selectors, \@contents, \@messages);
exit 0;

###############

sub list_selected_tickets {
    my ($selectors)= @_;

    my @tickets= filter_tickets($selectors);
    if (@tickets==1) {
        show_ticket_details($tickets[0]);
    }
    else {
        for my $ticket (sort { ticket_ordering($a,$b) } @tickets) {
            write_summary_line($ticket);
        }
    }
    if ($upgradeformat) {
        save_ticket($_) for @tickets;
    }
}
sub modify_ticket {
    my ($selectors, $contents, $messages)= @_;
    my @tickets= filter_tickets($selectors);
    if (@tickets!=1) {
        die sprintf("be more specific - %d matches\n", scalar @tickets);
    }
    my $ticket= shift @tickets;
    
    set_config('current', $ticket->{lid});

    # for contents 
    #    add old+new -> history
    #    set new value
    for my $c (@$contents) {
        if (exists $c->{field}) {
            add_to_history($ticket, $c->{field}, $ticket->{$c->{field}}, $c->{value});
            $ticket->{$c->{field}} = $c->{value};
        }
        elsif (exists $c->{addto}) {
            if (add_to_set($ticket->{$c->{addto}}, $c->{value})) {
                add_to_history($ticket, $c->{field}, "", $c->{value});
            }
        }
        elsif (exists $c->{delfrom}) {
            if (del_from_set($ticket->{$c->{delfrom}}, $c->{value})) {
                add_to_history($ticket, $c->{field}, $c->{value}, "");
            }
        }
    }

    # add message
    for my $m (@$messages) {
        add_message($ticket, $cfg->{user}, time(), $m);
    }

    save_ticket($ticket);
}
sub add_message {
    my ($ticket, $user, $timestamp, $message)=@_;
    push @{$ticket->{messages}}, {
        user=>$user,
        created=>$timestamp,
        message=>$message,
    };
    add_to_history($ticket, 'messages', "", "added msg #".scalar @{$ticket->{messages}});
}
sub add_to_history {
    my ($ticket, $fieldname, $oldval, $newval)= @_;
    push @{$ticket->{history}}, {
        field=>$fieldname,
        changed=>time(),
        old=>$oldval,
        new=>$newval,
    };
}
sub create_new_ticket {
    my ($contents)= @_;

    my $ticket= {
        lid=>alloclocalid(),
        fullid=>genguid(),
        state=>'open',
        created=>time(),
        reported=>$cfg->{user},
        messages=> [ ],
        history=> [ ],

        related=> { $filter_related && !empty($relateto_dir) ? ($relateto_dir=>1) : () },

        map { ($_->{field}=>$_->{value})} @$contents,
    };
    add_to_history($ticket, '', "", "created ticket #".$ticket->{lid});
    set_config('current', $ticket->{lid});
    save_ticket($ticket);
}

sub filter_tickets {
    my ($selectors)=@_;
    if (hasselector($selectors, 'localid')) {
        # shortcut: only filter localid
        return map { ticket_by_localid($_) } map { @{$_->{list}} } grep { $_->{type} eq 'localid' } @$selectors;
    }
    my @list=all_tickets();
    for my $s (@$selectors) {
        # todo: change selectors in objects, with 'asstring' and 'filter' methods
        printf("sel: %s : %s : %s\n", $s->{type}, $s->{fields} || "", $s->{value} || $s->{regex} || $s->{dir} || ($s->{list}?join(",",@{$s->{list}}):"")) if ($verbose);
        if ($s->{type} eq 'localid') {
            @list = filter_by_localid(\@list, $s->{list});
        }
        elsif ($s->{type} eq 'fullid') {
            return ticket_by_fullid($s->{value});
        }
        elsif ($s->{type} eq 'current') {
            return ticket_by_localid($cfg->{current});
        }
        elsif ($s->{type} eq 'regex') {
            @list = filter_by_regex(\@list, $s);
        }
        elsif ($s->{type} eq 'related') {
            @list = filter_by_related(\@list, $s->{dir});
        }
    }
    return @list;
}
sub indent {
    my $msg= shift;
    $msg=~ s/\n/\n  /gs;
    return $msg;
}
sub show_ticket_details {
    my ($ticket)=@_;
    printf("%5d %s %s\n", $ticket->{lid}, time2str("%Y-%m-%d %H:%M:%S", $ticket->{created}), $ticket->{fullid});
    printf("%s | %s\n", time2str("%Y-%m-%d %H:%M:%S", last_changed($ticket)), $ticket->{title});
    printf("%s (%s) %s %s\n", get_related_for_cwd($ticket), map { $ticket->{$_} ||"-" } qw(assigned state type));
    printf("\n");
    printf("%s\n", $ticket->{summary}||"");
    printf("-------\n");
    for my $m (@{$ticket->{messages}}) {
        printf("%s %s\n%s\n\n", $m->{user}, time2str("%Y-%m-%d %H:%M:%S", $m->{created}), indent($m->{message}));
    }
}
sub write_summary_line {
    my ($ticket)=@_;
# -id- -title-
    printf("%4d %-30.30s %s\n", $ticket->{lid}, get_related_for_cwd($ticket) || get_proj_comp($ticket), $ticket->{title});
}
sub get_proj_comp {
    my ($ticket)= @_;
    my $str="";
    $str .= $ticket->{project}.":" if !empty($ticket->{project});
    $str .= $ticket->{component} if !empty($ticket->{component});
    return $str;
}
sub save_ticket {
    my ($ticket)=@_;
    my $fh= IO::File->new("$tickdir/issues/$ticket->{lid}", "w") or die "$!: saving #$ticket->{lid} to $tickdir\n";
    $fh->print(Dumper($ticket));
    $fh->close();
}

sub ticket_by_localid {
    my ($lid)= @_;
    my $fh= IO::File->new("$tickdir/issues/$lid", "r") or die "$!: loading #$lid from $tickdir\n";
    my $VAR1;
    local $/;
    eval <$fh>;
    if ($@) {
        print("error parsing ticket #$lid: $@\n");
    }
    $fh->close();

    # code to translate from prj:comp -> related
#   if (!exists $VAR1->{related}) {
#       $VAR1->{related}= { "$VAR1->{project}:".($VAR1->{component}||"")=>1 } if !empty($VAR1->{project});
#       delete $VAR1->{project};
#       delete $VAR1->{component};
#   }
    return $VAR1;
}
sub filter_by_localid {
    my ($list, $ids)= @_;
    my %idset;
    $idset{$_}=1 for @$ids;
    return grep { exists $idset{$_->{lid}} } @$list;
}
sub ticket_by_fullid {
    #TODO -- use fullid
}
sub all_tickets {
    opendir(DIR, "$tickdir/issues/") or die "$!: reading $tickdir/issues\n";
    my @files= grep { -f "$tickdir/issues/$_" } readdir DIR;
    closedir DIR;

    return map { ticket_by_localid($_) } @files;
}
sub filter_by_regex {
    my ($list, $regex)= @_;
    return grep { regex_match($_, $regex) } @$list;
}
sub regex_match {
    my ($tick, $regex)= @_;
    for my $f (split //, $regex->{fields}) {
        #print("l:$f,f:$letter2field{$f},v:$tick->{$letter2field{$f}},re:$regex->{regex}.\n");
        if (!defined $tick->{$letter2field{$f}} || $tick->{$letter2field{$f}} !~ $regex->{regex}) {
            return 0;
        }
    }
    return 1;
}
sub last_changed {
    my ($ticket)= @_;
    return @{$ticket->{history}} ? $ticket->{history}[-1]{changed} : $ticket->{created};
}
sub ticket_ordering {
    my ($a,$b)=@_;
    return $a->{created} <=> $b->{created} || $a->{lid} <=> $b->{lid};
}

sub hasselector {
    my ($list, $type, $fields)= @_;
    for my $s (@$list) {
        if ($s->{type} eq $type) {
            if ($type eq 'regex' && $s->{fields} =~ $fields) {
                return 1;
            }
            elsif ($type eq 'localid') {
                return 1;
            }
        }
    }
    return 0;
}
sub incontents {
    my ($list, $type)= @_;
    for my $s (@$list) {
        if ($s->{field} eq $type) {
            return 1;
        }
    }
    return 0;
}
sub filter_by_related {
    my ($list, $dir)= @_;
    return grep { isrelated($_, $dir) } @$list;
}
sub isrelated {
    my ($ticket, $dir)= @_;
    return 1 if empty($dir) && !keys %{$ticket->{related}};
    return first { issubdir($_, $dir) } keys %{$ticket->{related}};
}
sub issubdir {
    my ($subdir, $basedir)= @_;
    return 1 if $subdir eq $basedir;
    return 1 if empty($basedir);
    return 0 if length($subdir)<length($basedir);
    #printf("b='%s', s='%s'  %d && (%d || %d)\n",$basedir,$subdir, substr($subdir, 0, length($basedir)) eq $basedir, substr($subdir, length($basedir), 1) eq '/', substr($subdir, length($basedir)-1, 1) eq ':');
    return 1 if substr($subdir, 0, length($basedir)) eq $basedir && (substr($subdir, length($basedir), 1) eq '/' || substr($subdir, length($basedir)-1, 1) eq ':');
    return 0;
}
sub get_related_for_cwd {
    my ($ticket)= @_;

    # returns the related item in ticket->{related}, most related to $relateto_dir
    if (keys %{$ticket->{related}}) {
        # todo: find most matching, instead of first item
        return (keys %{$ticket->{related}})[0];
    }
    else {
        return "";
    }
}
sub add_to_set {
    my ($set, $item)= @_;
    my $existed= exists $set->{$item};
    $set->{$item}= 1;
    return !$existed;
}
sub del_from_set {
    my ($set, $item)= @_;
    my $existed= exists $set->{$item};

    delete $set->{$item};

    return $existed;
}
sub empty {
    return 1 if !defined $_[0];
    return 1 if !length($_[0]);
    return 0;
}
__END__

=head1 data model:

model {
    tickets [
        ticket
    ]
}

ticket: {
    (properties) {
        * subject
        * summary
        * project
        * component
        * platform
        * deadline
    }
    messages [
        ticket_message 
    ]

    history [
        ticket_activity
    ]
}

ticket_message {
    * title
    * content
    * from
    * timestamp
}
ticket_activity {
    * timestamp
    * user
    changes [
        * field
        * oldvalue
        * newvalue
    ]
}


=head1 storage ideas:

1) one file per ticket, containing all properties, history ( like ditz, dbug, cil, ...)
 1a) encoding: using Data::Dumper
 1b) mbox format
2) one dir per ticket, (like be, ticgit, ...)
3) sql database

.. data in branch of dcvs, or just in the filesystem?


=head1 how to use:

cd       -- move to home dir
tick init
  - initializes a tick db in your home dir

cd cvsprj/project/somewhere

... do work ...
... think of problem ...

tick new -t "problem description"
  -> creates ticket for project ( automatically finds .svn, .git root )
      and component ( subdir under .svn/.git root )

cd     -- move to home dir

tick p/projname/ t/titlematch/ -m "another note"
   -> adds note to ticket in projname, matcing titlematch


=head1 about current

the 'current' timesout after not being used for .5 day 

=head1 distributed use

1) use dcvs merge to handle this
2) need guid to uniquely identify tickets


=head1 indexes

i may need to add indexes for various searchable fields, when i don't want to use a sqldb
index needs rebuilding after merging in external tickets