package Vee::Form;
use strict;
use base 'Class::Accessor::Fast';

__PACKAGE__->mk_accessors(qw/controls name submitted/);

=head1 NAME

Vee::Form - Form processing, handling, and printing

=head1 SYNOPSIS

Coming soon

=head1 DESCRIPTION

Coming soon

=head1 METHODS

Coming soon

=cut

################################################################################
# constructor

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    
    my %opts = @_;
    
    bless ($self, $class);
    $self->name($opts{id} || 'form');
    $self->controls({});       # expected potential controls
    $self->submitted(undef);
    $self->add_fields( %{ $opts{fields} } ) if $opts{fields};
    if ($opts{copy_params}) {
        $self->params( {%{ $opts{params} }} );
    } else {
        $self->params($opts{params});
    }

    return $self;
}

################################################################################
# data access

# returns whether this was passed in the query string
sub exists {
    my ($self, $name) = @_;
    return exists $self->params->{$name};
}

# returns parameter hashref
sub params {
    my ($self, $params) = @_;
    if (defined $params) {
        $self->{params} = $params;
        $self->submitted(1) if %$params;
        $self->validate_params;
    }
    return $self->{params};
}

# returns list of all values in array context, or just the first in scalar context
sub get {
    my $self = shift;
    unless (@_) { return undef; }
    my $name = shift;
    if (ref $self->params->{$name}) {
        return wantarray ? @{ $self->params->{$name} } : $self->params->{$name}->[0];
    } else {
        return exists $self->params->{$name} ? $self->params->{$name} :
              (exists $self->controls->{$name} ? $self->controls->{$name}->{value} : undef);
    }
}

# forcibly changes a value passed through the query string.
# useful for testing or for ignoring passed data.
# if the value is omitted, the value will be deleted.
sub force {
    my ($self, $name, $newvalue) = @_;
    if (@_ == 2) {
        delete $self->params->{$name}
    } else {
        $self->params->{$name} = $newvalue
    }
}

################################################################################
# form creation and defaulting and stuff.  if there are any query parameters
# with the correct names, the passed parameters will replace the 'value' etc
# parameters passed.  unless otherwise stated, everything is used as an html
# attribute.

# for dropdowns, radio sets, and groups of checkboxes, pass all possible
# values and labels for them through the 'options' param.  a hashref will
# be sorted with keys as the actual form data and values as labels; an
# arrayref will have each element used as both data and label.
# if you want them sorted, pass an arrayref as 'options_sorted'.  its values
# will be used to create a hash, so pretend it's a hashref with braces.

# adds many at once
sub add_fields {
    my ($self, %fields) = @_;
    for my $key (keys %fields) {
        $self->add_field($key, $fields{$key})
    }
}

# just one!
sub add_field {
    my $self = shift;
    my ($name, $attr);
    if (@_ == 1 and ref $_[0] eq 'HASH') {
        $attr = $_[0];
        $name = delete $attr->{name};
    } elsif (@_ == 2 and ref $_[0] eq '' and ref $_[1] eq 'HASH') {
        ($name, $attr) = @_;
    } elsif (@_ % 2 == 0) {
        $attr = { @_ };
        $name = delete $attr->{name};
    } else {
        die "Couldn't understand parameters to add_field";
    }
    
    if (!$name) { die "Name required" }

    # put options in the correct format
    if (exists $attr->{options}) {
        if (ref $attr->{options} eq 'HASH') {
            $attr->{options} = [
                map {
                    [ $_ => $attr->{options}{$_} ]
                } sort keys %{$attr->{options}}
            ];
        }

        if (ref $attr->{options} ne 'ARRAY') {
            die "'options' parameter must be an arrayref for now";
        }
        
        if (!ref $attr->{options}[0]) {
            $attr->{options} = [
                map {[ $_ => $_ ]} @{ $attr->{options} }
            ];
        }
    }
    
    if (!exists $attr->{default}) {
        if (exists $attr->{options}) {
            if ($attr->{type} ne 'checkbox') {
                $attr->{default} = $attr->{options}[0][0];
            }
        } else {
            $attr->{default} = ''
        }
    }

    if (!ref $attr->{default} and $attr->{count} and $attr->{count} > 1) {
        $attr->{default} = [ ( $attr->{default} ) x $attr->{count} ];
    }
    
    $self->controls->{$name} = $attr;
    return $name;
}

# return a hash of just parameters that aren't defaults
sub simplified_params {
    my $self = shift;
    my $res = { %{ $self->params } };
    for my $field (keys %{$self->controls}) {
        next unless exists $res->{$field};
        # TODO: fix for arrays
        my $delete = 1;
        my $default = $self->controls->{$field}->{default};
        if (defined $res->{$field} xor defined $default or
          ref $res->{$field} ne ref $default) {
            $delete = 0
        } elsif (ref $res->{$field} eq 'ARRAY') {
            my %defaults;
            $defaults{$_}++ for @$default;
            my @values;
            for my $val (@{ $res->{$field} }) {
                if ($defaults{$val}) {
                    $defaults{$val}--;
                } else {
                    push @values, $val;
                }
            }
            $res->{$field} = \@values;
            $delete = 0 if @values;
        } elsif (ref $res->{$field} eq '') {
            $delete = 0 if defined $res->{$field} and $res->{$field} ne $default;
        }
        delete $res->{$field} if $delete;
    }
    return $res;
}

# ensures that the passed parameters fit 
# in general this shouldn't be called by anyone on the outside
# of course, right now this module is designed to just use new() and nothing else...
sub validate_params {
    my $self = shift;

    my $p = $self->params;
    my $c = $self->controls;
    
    # only cycle through control list
    # (i.e., if a parameter got here without a matching control, leave it be)
    for my $field (keys %$c) {
        # if there is no fixed list to choose from, just use default
        if (not $c->{$field}{options} or not defined $p->{$field}) {
            $p->{$field} = $c->{$field}{default} unless defined $p->{$field};
            if (not ref $p->{$field} and $c->{$field}{count}) {
                $p->{$field} = [ $p->{$field} ];
            }
            next;
        }
        
        # delete anything not in the fixed list
        my @ok_params;
        for my $param (Vee::Utils::array( $p->{$field} )) {
            next unless scalar grep { $_->[0] eq $param } @{ $c->{$field}{options} };
            push @ok_params, $param;
        }
        
        if (!@ok_params) {
            if (exists $c->{$field}{default}) {
                $p->{$field} = $c->{$field}{default}
            } else {
                delete $p->{$field}
            }
        } else {
            $p->{$field} = scalar @ok_params == 1 ? $ok_params[0] : [ @ok_params ]
        }
    }
}

# returns the <input> tag(s) for a given name.
# if the tag is a set, this will return "tag label <br/> tag label..."
# if the tag is a set AND you specify a value for the second param, this will return "tag label"
sub get_tag {
    my ($self, $name, $req_value) = @_;
    if (!$name or !exists $self->controls->{$name}) { return '[Nonexistant control]' }
    my %attr = %{ $self->controls->{$name} };
    delete $attr{default};
    delete $attr{checked};
    
    my $is_checked;
    if (exists $attr{options} and defined $req_value and defined $self->params->{$name}) {
        $is_checked = 1 if Vee::Utils::in($req_value, Vee::Utils::array($self->params->{$name}));
    }

    $attr{name} = $name;
    $attr{value} = $self->params->{$name};
    delete $attr{value} unless defined $attr{value};
    $attr{id} ||= $self->name . '_' . $name;

    my @options = Vee::Utils::array(delete $attr{options}) if exists $attr{options};

    my $count = delete $attr{count};
    # count may be 1 or not
    # req_value may be given or not
    if ($count) {
        if (defined $req_value) {
            $attr{value} = $attr{value}->[$req_value] if ref $attr{value} eq 'ARRAY';
        } else {
            return join '<br/>', map { $self->get_tag($name, $_) } 0 .. $count - 1;
        }
    }

    $attr{value} = '' if not defined $attr{value};

    # boring old textbox or passwordbox; nothing special
    if ($attr{type} eq 'text' or $attr{type} eq 'hidden') {
        return sprintf '<input %s/>', join ' ', map { qq'$_="$attr{$_}"' } keys %attr

    # password/file requires..  nothing
    } elsif ($attr{type} eq 'file' or $attr{type} eq 'password') {
        delete $attr{value};
        return sprintf '<input %s/>', join ' ', map { qq'$_="$attr{$_}"' } keys %attr;

    # checkboxen
    } elsif ($attr{type} eq 'checkbox') {
        if (!@options) {
        # just one checkbox
            if (!defined $attr{id}) { $attr{id} = $self->id . '_' . $name; }
            delete $attr{checked};
            if ($attr{value}) {
                $attr{checked} = 'checked';
            } else {
                delete $attr{value}
            }
            return sprintf '<input %s/>', join ' ', map { qq'$_="$attr{$_}"' } keys %attr;
        } elsif (defined $req_value) {
        # multiple checkboxes, one selected
            if (defined $req_value and not scalar grep { $_->[0] eq $req_value } @options) { return '' }
            $attr{value} = $req_value;
            $attr{checked} = 'checked' if $is_checked;
            if (defined $attr{id}) { $attr{id} = $attr{id} . '_' . $req_value } else { $attr{id} = qq'qry_${name}_$req_value'; }
            return sprintf '<input %s/>', join ' ', map { qq'$_="$attr{$_}"' } keys %attr;
        } else {
        # multiple checkboxes, return them all
            my $cur_value = $attr{value};
            delete $attr{value};
            my @res;
            my $id = $attr{id};
            for my $pair (@options) {
                if ($cur_value and Vee::Utils::in($pair->[0], Vee::Utils::array($cur_value))) { $attr{checked} = 'checked' } else { delete $attr{checked} }
                $attr{value} = $pair->[0];
                if (defined $id) { $attr{id} = $id . '_' . $pair->[0] } else { $attr{id} = qq'qry_${name}_$pair->[0]'; }
                push @res, sprintf '<label> <input %s/> %s </label>', join(' ', map { qq'$_="$attr{$_}"' } keys %attr), $pair->[1];
            }
            return join '<br/>', @res;
        }

    } elsif ($attr{type} eq 'radio') {
    # set of radio buttons
        if (defined $req_value) {
        # multiple radio buttons, one selected
            if ($req_value and not scalar grep { $_->[0] eq $req_value } @options) { return '' }
            $attr{checked} = 'checked' if $is_checked;
            $attr{value} = $req_value;
            if (defined $attr{id}) { $attr{id} = $attr{id} . '_' . $req_value } else { $attr{id} = qq'qry_${name}_$req_value'; }
            return sprintf '<input %s/>', join ' ', map { qq'$_="$attr{$_}"' } keys %attr;
        } else {
        # multiple radio buttons, return them all
            my $cur_value = $attr{value};
            delete $attr{value};
            my @res;
            my $id = $attr{id};
            for my $pair (@options) {
                if ($pair->[0] eq $cur_value) { $attr{checked} = 'checked' } else { delete $attr{checked} }
                $attr{value} = $pair->[0];
                if (defined $id) { $attr{id} = $id . '_' . $pair->[0] } else { $attr{id} = qq'qry_${name}_$pair->[0]'; }
                push @res, sprintf '<label> <input %s/> %s </label>', join(' ', map { qq'$_="$attr{$_}"' } keys %attr), $pair->[1];
            }
            return join '<br/>', @res;
        }

    # dropdown box
    # TODO: rest of attributes
    } elsif ($attr{type} eq 'select') {
        my $res = qq'<select name="$attr{name}" id="$attr{id}"> ';
        for my $pair (@options) {
            $res .= qq'<option value="$pair->[0]"';
            if ($attr{value} eq $pair->[0]) { $res .= ' selected="selected"' }
            $res .= "> $pair->[1] </option> ";
        }
        $res .= '</select>';
        return $res;    

    # textarea, mostly like text but..  completely different
    } elsif ($attr{type} eq 'textarea') {
        my $value = delete $attr{value};
        delete $attr{type};
        return sprintf qq'<textarea %s>%s</textarea>',
            join(' ', map { qq'$_="$attr{$_}"' } keys %attr),
            $value;

    } else {
        return qq'[Unknown control $attr{type}]';
    }
}

# returns a hash of all passed query parameters that also have a corresponding
# control but are set to something other than the default
# TODO: make this do a deep compare!
sub get_changes {
    my $self = shift;
    my %res = ();
    for my $k (keys %{ $self->params }) {
        next unless exists $self->controls->{$k};
        if ($self->params->{$k} ne $self->controls->{$k}->{value}) {       
            $res{$k} = $self->params->{$k};
        }
    }
    return %res;
}

# like getchanges above, but just returns a query string for linking
sub get_query {
    my $self = shift;
    my @res = ();
    for my $k (keys %{ $self->params }) {
        next unless exists $self->controls->{$k};
        if ($self->params->{$k} ne $self->controls->{$k}->{value}) {
            if (ref $self->params->{$k} eq 'ARRAY') {
                # this mess checks to see if the default LIST is identical to the provided list
                if (ref $self->controls->{$k} eq 'ARRAY' &&
                    join("\0", sort @{ $self->params->{$k} }) eq join("\0", sort @{ $self->controls->{$k} }))
                { next }
                
                # push each one, one at a time
                push @res, map { "$k=$_" } @{ $self->params->{$k} };
            } else {
                push @res, $k . '=' . $self->params->{$k};
            }
        }
    }
    return join ';', @res;
}

=head1 AUTHOR

Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)

See the included F<AUTHORS> file for a full list of contributers.

=head1 LICENSE

See the included F<LICENSE> file.

=cut

1;