# Tools for selecting the subset of papers.
# Generator of HTML form controls and WHERE and HAVING clausules
# of SQL SELECT.

use warnings;
use strict;

# SQL ==========================================================================
sub SQL_SEL_CLAUSULES # ($where, $having) = ( $opt )
# clausules are withouth the keywords
#  $opt->{ 'seldec' } = [ 'dec', 'un', 're', ... ]
#           ( p.accept_reject )
#  $opt->{ 'selrev' } = [ 'compl', 'uncompl', 'accompl' ]
#           ( r.state, nrev, GROUP BY p.id )
#  $opt->{ 'selsynt' } = [ 'compl', 'uncompl'  ]
#           ( ACOverall, mark )
#  $opt->{ 'selac' } = [ ac_id, ... ]
#           ( s.editor_id )
#  $opt->{ 'fromto' } = f-to|>=x|<=x|x
#           ( p.id )

{
    my ($opt) = @_;
    my $nopt = { %{$opt} };
    my ($where, $having) = ('','');


#todo: selassign

    # papers for AC -------------------------------------------------------------
    if( $opt->{'selac'} )
    {
        $where .= "\nAND (s.editor_id='" . 
            join( "' OR s.editor_id='", @{$opt->{'selac'}} ) . "')";
    }

    # decision ------------------------------------------------------------------
    if( $opt->{'seldec'} or $opt->{'sellock'} )
    {
        my %lck = ();

        if( $opt->{'sellock'} ) {
            @lck{@{$opt->{'sellock'}}} = @{$opt->{'sellock'}};

            if( $lck{'locked'} and $lck{'unlocked'} or 
                ( !$lck{'locked'} and !$lck{'unlocked'} ) ) {
                delete( $nopt->{'sellock'} );
                $lck{'locked'} = $lck{'unlocked'} = 1;
            }
        } else { $lck{'locked'} = $lck{'unlocked'} = 1; }

        my %sel = ();  # selected decision, 'un' is undecided
        my %invsel = (); # inverse selection - take all and remove selected

        if( $opt->{'seldec'} ) {
            my %notsel = ();
            @notsel{@{Decisions()},'un'} = (@{Decisions()},'un');
            foreach my $c ( @{$opt->{'seldec'}} )
            {
                $c eq 'dec' and do {
                    $lck{'locked'} and @sel{@{Decisions()}} = @{Decisions()};
                    $lck{'unlocked'} and 
                        @sel{@{UcDecisions()}} = @{UcDecisions()};
                    delete( @notsel{ @{Decisions()} } );
                    next;
                };

                delete( $notsel{lc($c)} );
                $lck{'locked'} and @sel{lc($c)} = lc($c);
                $lck{'unlocked'} and @sel{uc($c)} = uc($c);
            }
            scalar( keys( %notsel ) ) == 0 and # all, remove option
                delete( $nopt->{'seldec'} );
            scalar( keys( %notsel ) ) == 1 and $notsel{'un'} and # decided
                $nopt->{'seldec'} = [ 'dec' ];


        } else {
            $lck{'locked'} and @sel{@{Decisions()},'un'} = (@{Decisions()},'un');
            $lck{'unlocked'} and 
                @sel{@{UcDecisions()},'UN'} = (@{UcDecisions()},'UN');
        }

        @invsel{@{Decisions()},'un',@{UcDecisions()},'UN'} = 
            ( @{Decisions()},'un',@{UcDecisions()},'UN' );
        delete( @invsel{ keys( %sel ) } );

        scalar( keys( %invsel ) ) > 0 and do {
            if( $sel{'UN'} ) { # UN is inv of others -> inverse
                $where .= "\nAND NOT ( BINARY p.accept_reject IN('".
                    join("','", keys(%invsel)) . "') <=> 1)", 
            } else {
                $where .= "\nAND BINARY p.accept_reject IN('".
                    join("','", keys(%sel))."')";
            }
        };
    }
        
    # completness of review -----------------------------------------------------
    if( $opt->{'selrev'} )   
    {
        my %sel = ();
        @sel{@{$opt->{'selrev'}}} = @{$opt->{'selrev'}};

        if( $sel{'compl'} and $sel{'uncompl'} ) { #all, do nothing
            delete( $nopt->{'selrev'} );
        } elsif( $sel{'uncompl'} ) {
            $where .=  "\nAND !(r.state <=> 'reviewed')";
        } elsif( $sel{'compl'} ) {
            $where .=  "\nAND r.state = 'reviewed'";
            $having .= "\nAND nrev=3";
        } else { # all, do nothing
            delete( $nopt->{'selrev'} );
        }
    }

    if( $opt->{'selsynt'} )   
    # completness of synthese ---------------------------------------------------
    {
        my %sel = ();
        @sel{@{$opt->{'selsynt'}}} = @{$opt->{'selsynt'}};

        if( $sel{'compl'} and $sel{'uncompl'} ) { #all, do nothing
            delete( $nopt->{'selsynt'} );
        } elsif( $sel{'uncompl'} ) {
            $having .=  "\nAND (ACOverall=9 OR mark=9)";
        } elsif( $sel{'compl'} ) {
            $having .=  "\nAND ACOverall!=9 AND mark!=9";
        } else { # all, do nothing
            delete( $nopt->{'selsynt'} );
        }
    }

    if( $opt->{'selrep'} )   
    # completness of synthese report---------------------------------------------
    {
        my %sel = ();
        my $n = $opt->{'repmin'} || 3;
        $n =~ /^\d+$/ or $n = 3;
        $nopt->{'repmin'} = $n;
        @sel{@{$opt->{'selrep'}}} = @{$opt->{'selrep'}};

        if( $sel{'rep'} and $sel{'unrep'} ) { #all, do nothing
            delete( $nopt->{'selsynt'} );
        } elsif( $sel{'rep'} ) {
            $where .=  "\nAND (IFNULL(LENGTH(s.Contrib),0)>='$n')";
        } elsif( $sel{'unrep'} ) {
            $where .=  "\nAND (IFNULL(LENGTH(s.Contrib),0)<'$n')";
        } else { # all, do nothing
            delete( $nopt->{'selsynt'} );
        }
    }


    if( $opt->{'fromto'} )
    # paper id range
    {
        my $sel = '';
        foreach $_ ( split( ",", $opt->{'fromto'} ) )
        {
            if( m/^\s*(\d+)\s*-\s*(\d+)\s*$/ ) {
                $sel and $sel .= ' OR ';
                $sel .= "p.id>='$1' AND p.id<='$2'";
            } elsif( m/^\s*([<>]?=?)\s*(\d+)\s*$/ ) {
                $sel and $sel .= ' OR ';
                $sel .= "p.id".( $1 ? $1 : '=' ). "'$2'";
            }
        }
        $sel and $where .= "\nAND ($sel)";
    }

    #return clausules with the first 5 chars ("\nAND ") removed
    return (($where and substr( $where, 5 )),
            ($having and substr($having, 5 )),
            $nopt);
}

# FORMS =========================================================================
# ListSelectSet( $opts, $key, $vals, $texts, 
#              [separator_for_current, end_separator_for_current,
#              current_if_all_checked,current_if_none_checked],
#              $$current )
# -- set of options select (listbox)
# $opts can be [$opts, $opts_for_current]

sub ListSelect
{
    my ($opt, $key, $vals, $texts, $ptexts, $current, $size, $multiple ) = @_;
    my ($tx,$ctx,$sctx) = ('','','');
    my ($all,$any) = (1,0);
    my $copt = $opt;

    if( ref( $opt )eq 'ARRAY'  ) { ($opt,$copt) = @{$opt}; } 

    $current and !$$current and $$current = '';
    my %sel = ();
    $opt->{$key} and @sel{@{$opt->{$key}}} = @{$opt->{$key}};

    my %csel = ();
    $copt->{$key} and @csel{@{$copt->{$key}}} = @{$copt->{$key}};

    $tx = "<SELECT name='$key'" . ( $multiple ? ' multiple' : '' ) .
        " size=$size>\n";

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $tx .= "<option value='$vals->[$i]' ".
            "label='$texts->[$i]'" . ($sel{$vals->[$i]} ?' selected>':'>') .
                $texts->[$i] . "\n";
        ( $sel{$vals->[$i]} and $any = 1 ) or $all = 0;
        $csel{$vals->[$i]} and $current and do
        {
            $ctx .= $sctx . $texts->[$i];
            $sctx = $ptexts->[0];       # separator_for_current
        };
    }
    $ctx .= $ptexts->[1];               # end_separator_for_current
    $all and $ctx  = $ptexts->[2];      # current_if_all_checked
    !$any and $ctx  = $ptexts->[3];      # current_if_none_checked

    $current and $$current .= $ctx;

    return $tx . "</SELECT>";
}

# OptSelect( $opts, $key, $vals, $texts, 
#         [separator, end_separator_for_current ],
#         $$current )
# -- one option select (radio btn)
# $opts can be [$opts, $opts_for_current]
sub OptSelect
{
    my ($opt, $key, $vals, $texts, $ptexts, $current ) = @_;
    my $tx = '';
    my $copt = $opt;
    if( ref( $opt )eq 'ARRAY'  ) { ($opt,$copt) = @{$opt}; } 

    $current and !$$current and $$current = '';

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $i and $tx .= $ptexts->[0];     # separator
        $tx .= "<input type='radio' name='$key' value='$vals->[$i]'" .
            ( defined($opt->{$key}) && $opt->{$key} eq $vals->[$i] ?
              ' checked>' : '>' ) . $texts->[$i];
        defined( $opt->{$key} ) and
            ( $opt->{$key} eq $vals->[$i] )
                and $current and $$current .= $texts->[$i];
    }
    $current and $$current and $$current .= $ptexts->[1];

    return $tx;
}

# OptCheckSet( $opts, $key, $vals, $texts, 
#              [separator, separator_for_current, end_separator_for_current,
#              current_if_all_checked,current_if_none_checked],
#              $$current )
# -- set of options select (checkboxes)
# $opts can be [$opts, $opts_for_current]

sub OptCheckSet
{
    my ($opt, $key, $vals, $texts, $ptexts, $current ) = @_;
    my ($tx,$ctx,$sctx) = ('','','');
    my ($all,$any) = (1,0);
    my $copt = $opt;

    if( ref( $opt )eq 'ARRAY'  ) { ($opt,$copt) = @{$opt}; } 

    $current and !$$current and $$current = '';
    my %sel = ();
    $opt->{$key} and @sel{@{$opt->{$key}}} = @{$opt->{$key}};

    my %csel = ();
    $copt->{$key} and @csel{@{$copt->{$key}}} = @{$copt->{$key}};

    for( my $i = 0; $i <= $#{$vals}; ++ $i )
    {
        $i and $tx .= $ptexts->[0];     # separator
        $tx .= "<input type='checkbox' name='$key' value='$vals->[$i]' " .
            ( $sel{$vals->[$i]} ? ' checked>' : '>' ) . $texts->[$i];
        ( $csel{$vals->[$i]} and $any = 1 ) or $all = 0;
        $csel{$vals->[$i]} and $current and do
        {
            $ctx .= $sctx . $texts->[$i];
            $sctx = $ptexts->[1];       # separator_for_current
        };
    }
    $ctx .= $ptexts->[2];               # end_separator_for_current
    $all and $ctx  = $ptexts->[3];      # current_if_all_checked
    !$any and $ctx  = $ptexts->[4];      # current_if_none_checked

    $current and $$current .= $ctx;

    return $tx;
}


sub ACSelect
{
    my ( $sock, $opt, $key, $height, $mul, $seltext ) = @_;
    my $sth = $sock->prepare( "SELECT name, editor.id FROM editor " .
                              "LEFT JOIN reviewer on editor.id=reviewer.id " .
                              "ORDER by name" )

        or die( "ERROR: ".$sock->errstr );
    $sth->execute() or die( "ERROR: ".$sock->errstr );
    my @ids = ();
    my @names = ();
    while( my $A = $sth->fetchrow_hashref() )
    {
        push @ids, $A->{'id'};
        push @names, $A->{'name'};
    }

    print ListSelect($opt,'selac', \@ids, \@names, 
                     [' and ',' ','',''], $seltext, $height, $mul );
}

sub VectorizeSelectParams
{
    my ($input) = @_;

    VectorizeParams( $input, 'selconf', 'selassign', 'seldec', 'selrev', 
                     'selsynt', 'selbuddy', 'sellock', 'selac',
                     'selrep' );
}

sub PaperSelectForm  
# selcrit .. which criterion use
# [ 'conf', 'rev', 'dec', 'ac', 'buddy', 'id','show' ]
# 'ac'/'buddy' .. can be also [ 'ac', colspan, height, singleselec ]
#
{
    my ($sock, $opts, $action, $headertext, $selcrit ) = @_;
    my ($seltext,$buddyseltext,$acseltext,$sorttext,$showtext);
    my $gs = "style='background-color:#DDDDDD'";
    my $r = '';
    my @carg = undef; # argument list for criterion

    my $opt = $opts;
    my $selopt = {};
    if( ref( $opt) eq 'ARRAY'  ) { $opt = $opt->[0]; } 

    print "<form method=get action='$action'>\n";
    print "<p><table cellspacing=5><tr><td><b>Select</b> papers\n";

    foreach my $c (@{$selcrit}) {
        if( ref( $c ) eq 'ARRAY' ) {
            @carg = @{$c};
            $c = shift @carg;
        } else { @carg = (); }

        # confirmed
        $c eq 'conf' and do {
            print "$r<td $gs>" . OptCheckSet( $opts, 'selconf',
                                           [ 'conf', 'nconf' ] => 
                                           [ 'confirmed', 'not confirmed' ], 
                                           [', ', '', ' ','','' ], \$seltext );
            $r = ",\n<tr><td>";
            next;
        };

        # reviewed
        $c eq 'rev' and do {
            print "$r<td $gs>" .  OptCheckSet( $opts, 'selrev', 
                      [ 'compl', 'uncompl' ] => 
                      [ 'completely reviewed', 'not completely reviewed' ], 
                      [ ', ', '', ' ','','' ], \$seltext );
            $r = ",\n<tr><td>";
            next;
        };

        # assigned
        $c eq 'assign' and do {
            print "$r<td $gs>" .  OptCheckSet( $opts, 'selassign', 
                      [ 'compl', 'uncompl' ] => 
                      [ 'completely assigned', 'not completely assigned' ], 
                      [ ', ', '', ' ','','' ], \$seltext );
            $r = ",\n<tr><td>";
            next;
        };

        # synthesized
        $c eq 'synt' and do {
            print "$r<td $gs>" .  OptCheckSet( $opts, 'selsynt', 
                      [ 'compl', 'uncompl' ] => 
                      ['completely consolidated','not completely consolidated'],
                      [ ', ', '', ' ','','' ], \$seltext );
            $r = ",\n<tr><td>";
            next;
        };

        # reported
        $c eq 'rep' and do {
            print "$r<td $gs>" .  OptCheckSet( $opts, 'selrep', 
                      [ 'rep', 'unrep' ] => 
                      ['reported', 'unreported' ],
                      [ ', ', '', ' ','','' ], \$seltext );
            print " (min length <input type='text' name='repmin' " .
                "maxlength='4' size='4' value='" . ($opt->{'repmin'}||3) 
                ."'>) ";

            $r = ",\n<tr><td>";
            next;
        };

        # decided
        $c eq 'dec' and  do {
            print "$r<td $gs>" . OptCheckSet( $opts, 'seldec', 
              ['dec','un','or','bo','po','bp','re' ] => 
              [ 'decided', 'undecided','or', 'bo','po','bp','re' ], 
              [', ', ', ', ' ', '','' ], \$seltext );
            $r = ",\n<tr><td>";
            next;
        };

        # locked decision
        $c eq 'lock' and  do {
            print "$r<td $gs>" . OptCheckSet( $opts, 'sellock', 
              ['locked','unlocked'] => 
              [ 'locked', 'unlocked', ], 
              [', ', ', ', ' ', '','' ], \$seltext ) . " decision";
            $r = ",\n<tr><td>";
            next;
        };

        # given ac (rowspan = 2, height = 3)
        $c eq 'ac' and do {
            $r and $r = ",\n";
            my ( $rs, $height, $mul ) = ( $carg[0] || 2, 
                                          $carg[1] || 3,
                                          $carg[2] || 1);

            print "$r<td valign=middle rowspan=$rs $gs>for AC ";
            ACSelect( $sock, $opt, 'selac', $height, $mul, \$acseltext );
            $r = ",\n<tr><td>";
            next;
        };

        # given buddy (rowspan = 2, height = 3)
        $c eq 'buddy' and do {
            $r and $r = ",\n";
            my ( $rs, $height, $mul ) = ( $carg[0] || 2, 
                                          $carg[1] || 3,
                                          $carg[2] || 1);

            print "$r<td valign=middle rowspan=$rs $gs>for Buddy-AC ";
            ACSelect( $sock, $opt, 'selbuddy', $height, $mul, \$buddyseltext );
            $r = ",\n<tr><td>";
            next;
        };

        # paper id range
        $c eq 'id' and do {
            print "$r<td $gs>paper ID range " .
                "<input type=text name=fromto size=20 maxlength=50" .
                    " value='" . ($opt->{'fromto'} || '' ) . "'>";
            print " (n-m|&gt;=m|&lt;=m|n,...)";
            $r = ",\n<tr><td>";
            !$opt->{'fromto'} or $opt->{'fromto'} =~ /^\s*$/ or 
                $seltext .= "ID limited ($opt->{'fromto'}) ";
            next;
        };

        # the rest - unhandled for now
        $selopt->{$c} = 1;
    }        

    # show only n selected papers
    if( $selopt->{'show'} )
    {
        $r and $r = ".\n";
        print "$r<tr><td><b>Show</b><td>" .
            OptSelect( $opts, 'show' => [ 'all', 'first', 'last' ], 
                       ['all', 'the first', 'the last' ], 
                       [ ' or ',''], \$showtext  );
        if ( !defined( $opt->{'show'} ) || $opt->{'show'} eq 'all' )
        { $showtext = ''; } else { $showtext .= " $opt->{max} " };
        print " <input type='text' name='max'" .
            "maxlength='3' size='3' value='" . ($opt->{max}||'') 
                ."'> papers.\n";
        $r = '';
        delete( $selopt->{'show'} );
    }

    # sort by
    if( $selopt->{'sort'} )
    {
        $r and $r = ".\n";
        print "$r<tr><td><b>Sort</b> papers by<td>" ;
        print OptSelect( $opts, 'sort' => ['id', 'mark' ], ['ID', 'score' ], 
                         [ ' or by ',''], \$sorttext );
        delete( $selopt->{'sort'} );
    }

    if( $selopt->{'sortd'} )
    {
        $r and $r = ".\n";
        print "$r<tr><td><b>Sort</b> papers by<td>" ;
        print OptSelect( $opts, 'sort' => ['id', 'mark', 'dmark' ],
                         ['ID', 'score', 'decision and score' ], 
                         [ ' or by ',''], \$sorttext );
        delete( $selopt->{'sortd'} );
    }

    foreach my $o (keys( %{$selopt} ) )
    {
        warn "Unknown select option '$o'";
    }

    print "\n</table>\n<input type=submit name='select' value='Select'>";
    print "</form>\n";

    if( $headertext )
    {
        $$headertext = '';
        $showtext and $$headertext .= $showtext;
        $seltext and $$headertext .= $seltext;
        $$headertext .= 'papers';
        $acseltext and $$headertext .= " for AC $acseltext";
        $buddyseltext and $$headertext .= " for buddy-AC $buddyseltext";
        $sorttext and $$headertext .= " sorted by $sorttext";
    }
}
      
1;

