#!perl -w
use strict;
$|=1;

#todo: add option to select from multiple named servers from .tracrc 

package TracServer;
use strict;
use warnings;
use WebServer;
use Carp;
use POSIX;
sub new {
    my ($class, $server, %properties)= @_;

    my $self= bless {
        server=> WebServer->new($server),

        %properties,
    }, $class;
    $self->{server}->credentials($properties{username}, $properties{password});

    $self->get("");
    return $self;
}
sub formtoken {
    my ($self)= @_;
    return $self->{server}->getcookie($self->{server}{hostname}, $self->{server}{basepath}, 'trac_form_token');
}
# $self->post("newticket", { type=>'defect', status=>'new', summary=>'.....' });
sub post {
    my ($self, $action, @params)= @_;
    return $self->{server}->httppost($action, __FORM_TOKEN=>$self->formtoken(), @params);
}
sub get {
    my ($self, $action, @params)= @_;

    return $self->{server}->httpget($action, @params);
}

#<form action="/projects/secphone/newticket" method="post">

#<input type="hidden" name="__FORM_TOKEN" value="7b7ac81551191280614cab7a" />
#    * get this from cooke_jar->scan( sub { $form_token=$_[2] if ($_[1] eq "trac_form_token}"); }
#    cookie_jar->{COOKIES}{'tilt.cryptophone.de'}{'/projects/secphone'}{trac_form_token}
#<input type="text" name="field_summary" />
#<input type="text" name="field_reporter" value="itsme" />
#<textarea name="field_description" ></textarea>
#<input type="text" name="field_owner" />
#<select name="field_type">	defect	enhancement	task
#<select name="field_priority">	blocker	critical	major	minor	trivial
#<select name="field_milestone">
#<select name="field_component">
#<input type="text" name="field_keywords" />
#<input type="text" name="field_cc" />
#<input type="checkbox" name="attachment" />
#<input type="hidden" name="field_status" value="new" />
#<input type="submit" name="preview" value="Preview" />
#<input type="submit" name="submit" value="Create ticket" />

#</form>

# in: hash with
#   summary
#   reporter
#   description
#   owner
#   type
#   priority
#   milestone
#   component
#   keywords
#   cc
# returns:
#   ticketnr
sub newticket {
    my ($self, %p)= @_;
    my $rp= $self->post("newticket", field_reporter=>$ENV{USER}, field_status=>'new', submit=>"Create ticket", map { ("field_$_"=>$p{$_}) } keys %p);

    if ($rp->header('Location') && $rp->header('Location')=~/ticket\/(\d+)/) {
        return $1;
    }
    my $html= join "",$rp->content;
    if ($html =~ /<div id="warning" class="system-message">(.*?)<\/div>/s) {
        my $txt= $1;
        $txt=~ s/<[^>]*>/ /gm;
        $txt=~ s/^\s+//gm;
        $txt=~ s/\s+$//gm;
        print "$txt\n";
    }
    die "error creating ticket";
}

# <form action="/projects/secphone/ticket/383" method="post">
# <input type="hidden" name="__FORM_TOKEN" value="fc79d08b295669930391df48" />
# <textarea name="comment"> </textarea>
# <input type="text" name="field_summary" value="the answer button stays greyed-out for too long" />
# <input type="text" name="field_reporter" value="itsme" />
# <textarea name="field_description"> </textarea>
# <select name="field_type">defect	enhancement	task	testcase
# <select name="field_priority">blocker	critical	major	minor	trivial
# <select name="field_milestone">Sirrix Gateway Release	Golden CSD Release	IP 1. Beta	IP 1. Release	IP 2nd Release	IP + Messaging Beta	IP + Messaging RC	IP + Messaging Release	IP Release Candidate	Incoming	trac &amp; admin stuff
# <select name="field_component">Base OS	CryptoPhone UI	IP client	IP presence server	IP protocol	IP trunk server	PSTN UI	SMS protocol	SMS-UI	SMS-client	Thuraya phone fixer	audio path	build environment	codec	crypto kernel	gkconsole	keyexchange	lineprotocol	policy manager	productiontools	research	secure storage	spcore	spipc	trac	updater
# <select name="field_version">PSTN/1	G10i+	CP-USB	CP301	CP300
# <input type="text" name="field_keywords" value="" />
# <input type="text" title="Space or comma delimited email addresses and usernames are accepted." name="field_cc" value="" />
# <select name="field_testcase_result">pass	fail	incomplete
# <input type="radio" name="action"/>leave	reopen	resolve	reassign	accept
# <select name="action_resolve_resolve_resolution">fixed	invalid	wontfix	duplicate	worksforme
# <input type="text" name="action_reassign_reassign_owner" value="anonymous" />
# <input type="hidden" name="ts" value="2009-12-01 21:14:05+00:00" />
# <input type="hidden" name="replyto" />        # value = comment id  || 'description'
# <input type="hidden" name="cnum" value="4" />
# <input type="submit" name="preview" value="Preview" />
# <input type="submit" name="submit" value="Submit changes" />
# </form>

# in: tickernr, hash with updated fields
sub changeticket {
    my ($self, $nr, %p)= @_;
    my $comment= $p{comment};
    delete $p{comment};
    my $resolve= $p{action_resolve_resolve_resolution};
    delete $p{action_resolve_resolve_resolution};

    my $origticket= $self->readticket($nr);
    return $self->post("ticket/$nr", author=>$ENV{USER}, cnum=>1, action=>($resolve?'resolve':'leave'), 
        $resolve?(action_resolve_resolve_resolution=>$resolve):(),
        ts=>$origticket->{ts}, comment=>$comment, submit=>"Submit changes", map { ("field_$_"=>$p{$_}) } keys %p);
}
sub gettimestamp {
    return POSIX::strftime("%Y-%m-%d %H:%M:%S+00:00", gmtime(time()));
}
sub readticket {
    my ($self, $nr)= @_;
    my $html= join "",$self->get("ticket/$nr")->content;
    if ($html=~/name="ts" value="(.*?)"/) {
        return { ts=>$1 };
    }
}
# <form method="post" enctype="multipart/form-data" action="">
# <input type="hidden" name="__FORM_TOKEN" value="258292f6f0a2f90eafcccf2e" />
# <input type="file" name="attachment" />
# <input type="text" name="description" />
# <input type="checkbox" name="replace" />
# <input type="hidden" name="action" value="new" />
# <input type="hidden" name="realm" value="ticket" />
# <input type="hidden" name="id" value="4" />
# <input type="submit" value="Add attachment" />
# <input type="submit" name="cancel" value="Cancel" />
# </form>
# in: ticketnr, filename or filedata
sub attachfile {
}

sub getprops {
    my ($self)= @_;
    my $rp= $self->get("newticket");

    my %props;
    my $html= join "", $rp->content;
    while ($html =~ m{<select.*?</select>}gs) {
        my ($name, @values)= parseselect($&);
        $props{$name}= \@values;
    }

    # extract possible fields from page
    my @fields;
    while ($html =~ m{name="field_(\w+)"}gs) {
        push @fields, $1;
    }
    $props{properties}= \@fields;
    return %props;
}
sub parseselect {
    my ($html)=@_;
    my $name;
    if ($html =~ /<select.*?name="([^"]+)"/) {
        $name= $1;
    }
    else {
        print "$html\n";
        die "no name in select\n";
    }
    my @values;
    if ($html =~ /<opt[^>]*>(.*)<\/option>/s) {
        my $opthtml= $1;
        @values= split /\s*<\/option>.*?<option[^>]*>\s*/s, $opthtml;
    }
    else {
        print "$html\n";
        die "no options in select\n";
    }
    return ($name, @values);
}
package main;
use strict;
use Getopt::Long;
my $tracrc= "$ENV{HOME}/.tracrc";
my $verbose;
my $testinput;
my $listprops;
sub usage {
    return <<__EOF__
Usage: tracsubmit [-l]
    -l  : list server properties ( like versions, components, milestones, etc )
          and possible property names
pipe a list of subjects through this tool to add each subject as a new ticket.

   indent description messages

   :key=value   indented k/v sets ticket specific properties

:key=value  sets properties for all following tickets

#NR message    - adds a message to a specific ticket
#NR            - (bulk) set properties for ticket
__EOF__
}
GetOptions(
    "v"=>\$verbose,
    "n"=>\$testinput,
    "l"=>\$listprops,
) or die usage();

my $params= readconfig($tracrc);

# http://tilt.cryptophone.de/projects
my $server= $params->{server};
delete $params->{server};

sub readconfig {
    open FH, "<$_[0]" or die "$_[0]: $!\n";
    my %params;
    while (<FH>) {
        $params{$1}=$2 if (/^(\w+)\s*=\s*(.*)/);
    }
    close FH;
    return \%params;
}

my @newtickets;
my @messages;
my %spec= ( );
my $cur;
#  :milestone=ip beta
#  :severity=bug
#  :component=...
#  #123 short message
#     line
#     line
#  sometitle
#     a description
while(<>) {
    s/\s+$//;
    if (length($_)==0) {
        # ignore empty line
    }
    elsif (/^:(\w+)=(.*)/) {
        # global property
        if ($2) {
            $spec{$1}= $2;
        }
        else {
            delete $spec{$1};
        }
    }
    elsif (/^#(\d+)(?:\s+(\S.*))?/) {
        # update ticket
        $cur= {
            ticketnr=> $1,
            lines=>[],
        };
        my $line= $2;
        if (!defined $line) {
            # add global properties
            $cur= { %$cur, %spec};
        }
        elsif ($line eq "FIXED" || $line eq "WONTFIX" || $line eq "DUPLICATE") {
            $cur->{action_resolve_resolve_resolution}= lc($line);
        }
        elsif ($line) {
            push @{$cur->{lines}}, $line;
        }
        push @messages, $cur;
    }
    elsif (/^\s+:(\w+)=(.*)/) {
        # item property
        if ($2) {
            $cur->{$1}= $2;
        }
        else {
            delete $cur->{$1};
        }
    }
    elsif (/^\S.*/) {
        # new ticket
        $cur= {
            summary=>$&,
            lines=>[],
            %spec,
        };
        push @newtickets, $cur;
    }
    elsif (/^\s+(\S.*)/) {
        # comment / description text
        push @{$cur->{lines}}, $1;
    }
    else {
        die "\nERROR: unhandled line in input: $_\n";
    }
}
if (!$listprops && !@newtickets && !@messages) {
    die usage();
}
if ($testinput) {
    exit 0;
}
my $trac= TracServer->new($server, %$params);
if ($listprops) {
    my %props= $trac->getprops();

    my $keycol=0;
    for my $k (keys %props) {
        printf("==== %s\n", $k);
        printf("| %s\n", $_) for @{$props{$k}};
        printf("\n");
    }
    exit 0;
}
printf("adding %d new tickets, %d notes\n", scalar @newtickets, scalar @messages);
printf("server: %s\n", $server);
for my $n (@newtickets) {
    $n->{description}= join("\n", @{$n->{lines}});
    $n->{description} =~ s/^\*\s*/ * /gm;
    delete $n->{lines};
    my $nr= $trac->newticket(%$n);
    printf("#%d NEW %s\n", $nr, $n->{summary});
}
my $prevnr;
for my $n (@messages) {
    $n->{comment}= join("\n", @{$n->{lines}});
    $n->{comment} =~ s/^\*\s*/ * /gm;
    delete $n->{lines};
    my $nr= $n->{ticketnr};
    delete $n->{ticketnr};

    # make sure changes have unique timestamps
    sleep(1.5) if ($prevnr && $nr==$prevnr);
    $trac->changeticket($nr, %$n);

    $prevnr= $nr;
}

=end
## example .tracrc
server=http://www.demo.com/trac/myproject
username=itsme
password=blablabla
## example script:
:component=component1
:milestone=milestone1
new test ticket 31
   desc1
   desc2
   desc3

#31 adding note
   :component=component2
   qweqweqwqw
#31 adding note
   :milestone=milestone4
   wopiqwpoieqwoep
#31 adding note
   ,mzxcn,mznc,znc
#31 adding note
    1892371982748124

#31 adding more notes
  test
  test
#31 FIXED
  problem fixed