#
#  This file is part of WebDyne.
#
#  This software is copyright (c) 2026 by Andrew Speer <andrew.speer@isolutions.com.au>.
#
#  This is free software; you can redistribute it and/or modify it under
#  the same terms as the Perl 5 programming language system itself.
#
#  Full license text is available at:
#
#  <http://dev.perl.org/licenses/>
#
package WebDyne::HTML::Tiny;


#  Pragma
#
use strict qw(vars);
use vars   qw($VERSION);
use warnings;


#  Constants, inheritance
#
our $AUTOLOAD;
our @ISA=qw(HTML::Tiny);


#  External Modules
#
use HTML::Tiny;
#use CGI::Simple;
use Data::Dumper;
use HTML::Element;


#  WebDyne Modules
#
use WebDyne::Constant;
use WebDyne::Util;
use WebDyne::CGI;


#  Constants
#
use constant {

    URL_ENCODED => 'application/x-www-form-urlencoded',
    MULTIPART   => 'multipart/form-data'

};


#  Package state
#
my %Package;


#  Version information
#
$VERSION='2.075';


#  Debug load
#
debug("Loading %s version $VERSION", __PACKAGE__);


#  Trick to allow use of illegal subroutine name to suppport treebuilder comment format
#
*{'WebDyne::HTML::Tiny::~comment'}=\&_comment;
*{'WebDyne::HTML::Tiny::entity_encode'}=sub { return $_[1] };


#  All done. Positive return
#
return ${&_init()} || err('error running init code');


#==================================================================================================


sub new {


    #  Start new instance
    #
    my ($class, @param)=@_;
    my %param;
    if (ref($param[0]) eq 'HASH') {
        %param=%{$param[0]};
    }
    else {
        %param=@param;
    }
    debug("$class new, %s", Dumper(\%param));
    
    
    #  Shortcuts (start_html, start_form etc.) enabled by default.
    #
    &shortcut_enable() unless
        $param{'noshortcut'}; # no sense before ? was || $Package{'_shortcut_enable'};
        
        
    #  Get HTML::Tiny ref
    #
    my $self=$class->SUPER::new( mode=>(delete($param{'mode'}) || $WEBDYNE_HTML_TINY_MODE));
    
    
    #  Save away other supplied params into self ref
    #
    $self->{'_r'}=$param{'r'};
    

    #  Done
    #
    return $self;

}


sub Vars { 

    #  Get CGI::Simple Vars to ensure we can find values needed to persist choices across form submissions
    #
    my $self=shift();
    debug("$self Vars");
    return ($self->{'_Vars'} ||= $self->CGI()->Vars());    

}


sub CGI {

    
    #  Get CGI::Simple object ref
    #
    my $self=shift();
    debug("$self CGI");
    return ($self->{'_CGI'} ||= WebDyne::CGI->new($self->{'_r'}));
    
}


sub _init {


    #  Initialise various subs
    #
    *HTML::Tiny::start=\&HTML::Tiny::open || *HTML::Tiny::start;    # || *HTML::Tiny::Start stops warning
    *HTML::Tiny::end=\&HTML::Tiny::close  || *HTML::Tiny::end;      # || as above


    #  Translate CGI.pm shortcut field to HTML::Tiny equiv
    #
    my %type=(
        textfield      => 'text',
        password_field => 'password',
        filefield      => 'file',
        defaults       => 'submit',
        image_button   => 'image',
        button         => 'button'
    );
    

    #  Which tags do we need to persist value ?
    #
    my %persist=(
        textfield	=> 1,
        password_field	=> 1,
        filefield	=> 1
    );


    #  Re-impliment CGI input shortcut tags
    #
    foreach my $tag (qw(textfield password_field filefield button submit reset defaults image_button hidden button)) {
            
        *{$tag}=sub {
            my ($self, $attr_hr, @param)=@_;
            debug("$self $tag, attr_hr: %s", Dumper($attr_hr));
            if (defined($attr_hr)) {
                #  Copy attr so don't pollute ref
                my %attr=%{$attr_hr};
                my $label=delete $attr{'label'};
                #my $param_hr=$self->Vars();
                my $param_hr=$self->CGI->Vars();
                if ($persist{$tag}) {
                    if ($attr{'name'} && (my $value=$param_hr->{$attr{'name'}}) && !$attr{'force'}) {
                        $attr{'value'}=$value;
                    }
                }
                
                #  Wrap in label if needed
                #
                if ($label) {
                    return $self->label(join('', grep {$_} @param, $label) . $self->input({type => $type{tag}, %attr}));
                }
                else {
                    return $self->input({type => $type{$tag} || $tag, %attr}, @param);
                }
            }
            else {
                return $self->input({type => $type{$tag} || $tag}, @param)
            }

        } unless UNIVERSAL::can(__PACKAGE__, $tag);
    }


    #  Isindex deprecated but reimplement anyway
    #
    foreach my $tag (qw(isindex)) {

        no strict qw(refs);
        *{$tag}=sub {shift()->closed($tag, @_)}
            unless UNIVERSAL::can(__PACKAGE__, $tag);

    }


    #  Done return OK
    #
    return \1;

}


sub shortcut {

    #  Set or return passthough flag which flags us to ignore all start_* methods
    #
    my $self=shift();
    debug("self: $self, shortcut: %s", Dumper(\@_));
    if (@_) {
        return shift() ? $self->shortcut_enable() : $self->shortcut_disable()
    }
    else {
        return $self->{'_shortcut'}
    }

}


sub shortcut_disable {

    no warnings qw(redefine);
    debug('shortcut_disable: %s', Dumper(\@_));
    foreach my $sub (grep {/^(?:_start|_end)/} keys %{__PACKAGE__ . '::'}) {
        (my $sub_start=$sub)=~s/^_//;

        #print "disable $sub_start=>$sub";
        if (my ($action, $tag)=($sub_start=~/^(start|end)_([^:]+)$/)) {

            #print "action: $action, tag: $tag\n";
            *{$sub_start}=sub {shift()->$action($tag, @_)};
        }
    }
    delete $Package{'_shortcut_enable'};
    
    #  || *start_html to remove warnings
    *start_html=sub {shift()->_start_html_bare(@_)} || *start_html

}


sub shortcut_enable {

    no warnings qw(redefine);
    debug('shortcut_enable: %s', Dumper(\@_));
    foreach my $sub (grep {/^(?:_start|_end])/} keys %{__PACKAGE__ . '::'}) {
        (my $sub_start=$sub)=~s/^_//;

        #if ( *{__PACKAGE__ . "::${sub_start}"}{'CODE'} eq \&{$sub} ) {
        #    debug("code for $sub_start exists, skipping");
        #    last;
        #}
        #else {
        #    debug("code for $sub_start needed, creating");
        #}

        debug("enable $sub_start=>$sub, %s", *{__PACKAGE__ . "::${sub_start}"}{'CODE'});
        *{$sub_start}=\&{$sub};
    }
    $Package{'_shortcut_enable'}++;

    #*start_html=\&_start_html_bare;

}


#  Start_html shorcut and include DTD
#
sub _start_html {


    #  Get self ref and any attributes passed
    #
    my ($self, $attr_hr, @param)=@_;
    debug("$self _start_html, attr: %s, param: %s", Dumper($attr_hr, \@param));

    #return $self->SUPER::start_html($attr_hr, @param) if $self->{'_passthrough'};


    #  Attributes we are going to use
    #
    debug('WEBDYNE_START_HTML_PARAM: %s', Dumper($WEBDYNE_START_HTML_PARAM));
    my %attr=(
        %{$WEBDYNE_HTML_PARAM},
        %{$WEBDYNE_START_HTML_PARAM},
        %{$attr_hr}
    );
    debug('attr: %s', Dumper(\%attr));


    #  If no attributes passed used defaults from constants file
    #
    #keys %{$attr_hr} || ($attr_hr=$WEBDYNE_HTML_PARAM);


    #  Pull out meta attributes leaving rest presumably native html tag attribs
    #
    my %attr_page=map {$_ => delete $attr{$_}}  grep { exists($attr{$_}) } (qw(
        title
        meta
        style
        base
        target
        author
        script
        include
        include_script
        include_style
        static
        cache
        handler
        h1
        h2
        h3
        h4
        h5
        h6
        hr
    ), keys %{$WEBDYNE_START_HTML_SHORTCUT_HR});
    debug('start_html %s', Dumper(\%attr_page));


    #  Start with the DTD
    #
    my @html=$WEBDYNE_DTD;


    #  Static, cache ? If so mark as such in HTML::Tiny object to be 
    #  reviewed at end of parse by Treebuilder. Not ideal, good enough
    #
    foreach my $attr (qw(static cache handler)) {
        if (my $value=$attr_page{$attr}) {
            debug("found attr: $attr, setting to value: $value");
            $self->{"_${attr}"}=$value;
            $self->{'_static'} ||=1 if ($attr eq 'cache');
        }
    }
    
    
    #  Shortcuts ? Add to relevant attributes
    #
    foreach my $shortcut (grep {$attr_page{$_}} keys %{$WEBDYNE_START_HTML_SHORTCUT_HR}) {
        my $shortcut_hr=$WEBDYNE_START_HTML_SHORTCUT_HR->{$shortcut};
        debug("found shortcut tag: $shortcut, content: %s", Dumper($shortcut_hr));
        while (my($type, $href_ar)=each %{$shortcut_hr}) {
            unless (ref($href_ar) eq 'ARRAY') { $href_ar=[$href_ar] }
            debug("processing type: $type, href: %s", Dumper($href_ar));
            if (my $type_attr_value_ar=$attr_page{$type}) {
                 unless (ref($type_attr_value_ar) eq 'ARRAY') { $type_attr_value_ar=[$type_attr_value_ar] }
                 debug("found existing start_html attr type: $type, content: %s", Dumper($type_attr_value_ar));
                 push @{$type_attr_value_ar}, @{$href_ar};
                 $attr_page{$type}=$type_attr_value_ar;
                 debug("updated start_html attr type: $type to: %s", Dumper($type_attr_value_ar));
            }
            else {
                debug("no start_hrml attr type: $type found, creating with content: %s", Dumper($href_ar));
                $attr_page{$type}=$href_ar
            }
        }
    }


    #  Add meta section
    #
    my @meta;
    if (my $hr=$attr_page{'meta'}) {
        debug('have meta hr: %s', Dumper($hr));
        @meta=$self->meta({content => $attr_page{'meta'}});
        debug('processed to: %s', Dumper(\@meta));
    }
    else {
        debug('no meta run');
    }
    
    
    #  Logic error below, replaced by above
    #
    #my @meta=$self->meta({ content=>$attr_page{'meta'} })
    #    if $attr_page{'meta'};
    ##debug('meta: %s', Dumper(\@meta));
    ##while (my ($name, $content)=each %{$attr_page{'meta'}}) {
    ##    push @meta, $self->meta({name => $name, content => $content});
    ##}
    #  Used to do this
    #while (my ($name, $content)=each %{$WEBDYNE_META}) {
        #push @meta, $self->meta({$name => $content});

    #}
    #  Now this
    ##push @meta, $self->meta({ content => $WEBDYNE_META }) unless 


    #  Base and/or target
    #
    my @base;
    if ($attr_page{'base'} || $attr_page{'target'}) {
        my %attr_base;
        $attr_base{'href'} = $attr_page{'base'} if $attr_page{'base'};
        $attr_base{'target'} = $attr_page{'target'} if $attr_page{'target'};
        push @base, $self->base(\%attr_base);
    }
    

    #  Add any stylesheets
    #
    my @link;
    if (my $style=$attr_page{'style'}) {
    
        #  Generate HTML for link tag stylheet
        #
        push @link, $self->_start_html_tag('link', 'href', $style, 
            { rel=>'stylesheet'});

    }
    if (my $include_style=$attr_page{'include_style'}) {

        #  Generate HTML to make an include section for any styles user wants, wrap in <style> tag
        #
        push @link, $self->_start_html_tag('include', 'file', $include_style, 
            { wrap =>'style'});
            
            
        #  Used to do this way but only could do single file
        #
        #my $html_or=HTML::Element->new('include', wrap=>'style', file => $include_style);
        #push @link, $html_or->as_HTML();
    }

    if (my $author=$attr_page{'author'}) {
        $author=$self->url_encode($author);
        my $html_or=HTML::Element->new('link', rel=> 'author', href => sprintf('mailto:%s', $author));
        push @link, $html_or->as_HTML();
    }
    

    #  Scripts
    #
    my @script;
    if (my $script=$attr_page{'script'}) {
    
        #  Script same as style above
        #
        push @script, $self->_start_html_tag('script', 'src', $script);
    }
    if (my $include_script=$attr_page{'include_script'}) {
    
        #  Include script same as style above
        #
        push @script, $self->_start_html_tag('include', 'file', $include_script, 
            { wrap =>'script'});

    }
    
    
    #  Include any other files
    #
    my @include;
    if (my $fn=$attr_page{'include'}) {
    
        
        #  Same as other tags above, generate <include> HTML
        #
        push @include, $self->_start_html_tag('include', 'file', $fn);
        
        
        #  Used to do this way
        #
        #my $html_or=HTML::Element->new('include', file => $fn);
        #push @include, $html_or->as_HTML();
        

        #  Older way was experimental
        #
        #$include=${
        #    $webdyne_or->include({ file=>$fn, head=>1 }) ||
        #        return err();
        #};
        #debug("include: $include");

    }
    else {
        
        #  No included file (which should include default metadata) so add default
        #
        debug('no include file, adding default metadata');
        push @meta, $self->meta({ content => $WEBDYNE_META });
        
    }

    
    
    #  Build title
    #
    my ($title, $title_html);
    unless (@include && (grep {/<title>.*?<\/title>/i} @include)) {
        if (defined($attr_page{'title'})) {
            #  Title is defined (presumably some string)
            #
            debug('title attr defined, using: %s', $attr_page{'title'});
            $title_html=$self->title($title=$attr_page{'title'});
        }
        elsif (exists($attr_page{'title'})) {
            #  Exists but undefined, leave title undef also
            #
            debug('title attr exists but undefined, leaving undefined');
            $title=undef;
        }
        else {
            #  No title attr at all, use default
            #
            debug('title attr not present, using default title');
            $title_html=$self->title($title=$WEBDYNE_HTML_DEFAULT_TITLE);
        }
    }
    debug('title: %s', $title || '*undef*');
    
    
    #  Add title as introductory heading if wanted
    #
    my $heading_html='';
    if (my ($heading_tag)=grep {$attr_page{$_}} qw(h1 h2 h3 h4 h5 h6)) {
        $heading_html=$self->$heading_tag($title) if $title;
        if ($attr_page{'hr'}) {
            $heading_html.=$self->hr();
        }
    }
        

    #  Build head, adding a title section, empty if none specified
    #
    my $head=$self->SUPER::head(
        join(
            $/,
            grep {$_} (
                $title_html,
                @meta,
                @base,
                @link,
                @script,
                @include
            )
        ));


    #  Put all together and return
    #
    #push @html, $self->open('html', $attr_hr), $head . $self->open('body');
    push @html, $self->open('html', \%attr), $head . $self->open('body') . $heading_html;
    debug('html: %s', Dumper(\@html));
    return join($/, @html);

}


sub _start_html_tag {

    my ($self, $tag, $attr, $param_ar, $attr_hr)=@_;
    my @html;
    unless (ref($param_ar) eq 'ARRAY') {
        $param_ar=[$param_ar];
    }
    if ($WEBDYNE_START_HTML_PARAM_STATIC) {
        $attr_hr->{'static'}=1;
    }
    foreach my $param (@{$param_ar}) {
        my $html_or=HTML::Element->new($tag, $attr=>$param, %{$attr_hr} );
        push @html, $html_or->as_HTML();
    }
    return join('', @html);
    
}
        

sub _end_html0 { # No longer needed

    #  Stub for WebDyne UNIVERSAL::can to find
    #
    #shift()->SUPER::end_html(@_);
    my ($self, $attr_hr)=@_;
    debug("$self _start_html, attr: %s, param: %s", Dumper($attr_hr, \@_));

    #return $self->SUPER::end_html($attr_hr) if $self->{'_passthrough'};
    my @html;
    push @html, $self->close('body'), $self->close('html');
    return join($/, @html);

    #return shift()->close('html', @_);

}


sub html {

    my $self=shift();
    debug("$self html() param: %s", Dumper(\@_));
    #  Move default attributes into <html> tag unless user has explicitely supplied
    unshift (@_, $WEBDYNE_HTML_PARAM) unless (ref $_[0] eq 'HASH');
    return $WEBDYNE_DTD . $self->SUPER::html(@_);

}


sub head {

    my ($self, $html, @param)=@_;
    #debug("$self head, html:$html, attr:%s", Dumper(\@_));
    debug("$self head, param:%s", Dumper($_[2]));
    $html.=$WEBDYNE_HEAD_INSERT;
    return $self->SUPER::head(grep {$_} ($html, @param));
    
}


sub _start_html_bare {

    #  Special. Called by optimise_two in WebDybe compile instead of start_html above
    #
    my $self=shift();
    debug("$self _start_html_bare param:%s", Dumper(\@_));
    return $WEBDYNE_DTD . $self->SUPER::open('html', @_);
    #return $WEBDYNE_DTD

}


#  Start_form shortcut
#
sub _start_form {

    my ($self, $attr_hr, @param)=@_;
    debug("$self _start_form, attr_hr:%s param:%s", Dumper($attr_hr, \@param));
    my %default=(
        method  => 'post',
        # Redundant
        # enctype => +URL_ENCODED
    );
    map {$attr_hr->{$_} ||= $default{$_}}
        keys %default;
    return $self->start('form', $attr_hr, @param);

}


#  Start multi-part form shortcut
#
sub _start_multipart_form {
    debug("$_[0] _start_multipart_form");
    return shift()->start_form({enctype => +MULTIPART, %{$_[0] ? shift() : {}}}, @_);
}


sub end_multipart_form {
    debug("$_[0] _end_multipart_form");
    return shift()->end_form(@_);
}


#  Support CGI comment syntax. See aliasing to ~comment in top section
#
sub _comment {

    my ($self, $attr_hr)=@_;
    debug("$self comment, attr:%s", Dumper($attr_hr));
    #return sprintf("\n<!-- %s -->\n", $attr_hr->{'text'});
    my $html=sprintf('<!-- %s -->', $attr_hr->{'text'});
    if (WEBDYNE_HTML_NEWLINE) {
        $html="\n${html}\n";
    }
    return $html;

}


#  Meta tag
#
sub meta {

    my ($self, $attr_hr)=@_;
    debug("$self in meta, attr %s", Dumper($attr_hr));
    my @html;
    if (ref(my $meta_hr=$attr_hr->{'content'}) eq 'HASH') {
        debug('meta is HASH');
        
        #  Want to be determenistic so sort keys unless tied
        #
        my @name=keys(%{$meta_hr});
        unless(my $or=tied(%{$meta_hr})) {
            #  Not tied hash to sort keys
            #
            debug('meta hash not tied, sorting');
            @name=sort { $a cmp $b } @name;
        }
        else {
            debug("meta_hr is tied to $or");
        }
        
        #while (my ($name, $content)=each %{$attr_hr->{'content'}}) {
        foreach my $name (@name) {
            my $content=$meta_hr->{$name};
            if ((my ($key, $value)=split(/=/, $name)) == 2) {

                #  Self contained
                #
                debug("split to $key: $value");
                if ($content) {
                    push @html, $self->SUPER::meta({$key => $value, content => $content});
                }
                else {
                    push @html, $self->SUPER::meta({$key => $value});
                }
            }
            else {
                push @html, $self->SUPER::meta({name => $name, content => $content});
            }
        }
    }
    else {
        debug('meta is plain');
        push @html, $self->SUPER::meta($attr_hr)
    }
    return join($/, @html);

}


#  Link tag - expand array into multiple if needed
#
sub link {

    my ($self, $attr_hr)=@_;
    debug("$self link, attr %s", Dumper($attr_hr));
    my @html;
    if (ref($attr_hr->{'href'}) eq 'ARRAY') {
        my %attr=%{$attr_hr};
        my $href_ar=delete $attr{'href'};
        map {push @html, $self->SUPER::link({%attr, href => $_})} @{$href_ar}
    }
    else {
        push @html, $self->SUPER::link($attr_hr)
    }
    return join($/, @html);

}


#  Script tag - same deal
#
sub script {

    my ($self, $attr_hr, @param)=@_;
    debug("$self script, attr %s", Dumper($attr_hr));
    
    
    #  Take copy of attribute hash ref so we don't alter original
    #
    my @html;
    my %attr=%{$attr_hr};
    if ($attr{'src'}) {
    
    
	    #  Convert to array
	    #
        my $script_ar;
        unless (ref($script_ar=$attr{'src'}) eq 'ARRAY') {
            $script_ar=[$script_ar]
        }
        debug('attr_hr: %s, script_ar: %s', Dumper($attr_hr, $script_ar));
        
        #  Iterate over each one
        #
        foreach my $src (@{$script_ar}) {
            debug("src: $src");
            my %src_attr=%attr;
            
            #  Split off any fragments and use them as attributes, e.g. #defer becomes defer, ?foo=bar becomes foo=bar in attr
            my @src=split(/#/, $src);
            $src=$src[0];
            debug("src post split: $src");
            if ($src[1]) {
                debug('split src: %s', Dumper(\@src));
                foreach my $kv (split /&/, $src[1]) {
                    next unless length($kv);
                    if ( $kv =~ /^([^=]+)=(.*)$/ ) {
                        $src_attr{$1}=$2;
                    }
                    else {
                        # no “=” means flag parameter
                        $src_attr{$kv} = [];
                    }
                }
                debug("fragment attr: $src[1] decoded as %s from query_param: %s", Dumper(\%attr, \@src));
            }
            push @html, $self->SUPER::script({%src_attr, src => $src}, @param)
        }
    }
    else {
        push @html, $self->SUPER::script($attr_hr, @param)
    }
    debug('html: %s', Dumper(\@html));
    return join($/, @html);

}


sub _radio_checkbox {


    #  Return a radio or checkboxinput field, adding label tags if needed
    #
    my ($self, $tag, $attr_hr, $html)=@_;
    debug("$self _radio_checkbox, tag:$tag attr_hr:%s", Dumper($attr_hr));
    my %attr=%{$attr_hr};
    if (my $label=delete $attr{'label'}) {
        return $self->label($self->input({type => $tag, %attr}) . join('', grep {$_} $html, $label));
    }
    else {
        return $self->input({type => $tag, %attr}) . $html;
    }

}


#  Checkbox group
#
sub _radio_checkbox_group {


    #  Build a checkbox or radio group
    #
    my ($self, $tag, $attr_hr)=@_;
    debug("$self _radio_checbox_group tag:$tag attr: %s", Dumper($attr_hr));
    my %attr=%{$attr_hr};


    #  Get hash ref of any existing CGI param
    #
    my $param_hr=($self->{'_Vars'} ||= $self->Vars()) ||
        return err('unable able to CGI::Simple Vars');
        
        
    #  And CGI object
    #
    my $cgi_or=$self->CGI() ||
        return err('unable to get CGI object');


    #  Hold generated HTML in array until end
    #
    my @html;


    #  Convert arrays of default values (i.e checked/enabled) and any disabled entries into hash - easier to check
    #
    my %attr_group;
    foreach my $attr (qw(defaults checked disabled)) {
        map {$attr_group{$attr}{$_}=1} @{(ref($attr{$attr}) eq 'ARRAY') ? $attr{$attr} : [$attr{$attr}]}
            if $attr{$attr};
    }
    debug('attr_group: %s', Dumper(\%attr_group));


    #  If values is a hash not an array then convert to array and use hash as values
    #
    if (ref($attr{'values'}) eq 'HASH') {


        #  It's a hash - use as labels, and push keys to values
        #
        $attr{'labels'}=(my $hr=delete $attr{'values'});
        $attr{'values'}=[keys %{$hr}]

    }


    #  Make sure checked values persist by default unless "force" attribute used to override
    #
    #if ($attr_hr->{'name'} && (my $checked=$param_hr->{$attr_hr->{'name'}}) && !$attr_hr->{'force'}) {
    if ($attr_hr->{'name'} && (my @checked=$cgi_or->param($attr_hr->{'name'})) && !$attr_hr->{'force'}) {

        #  The tag has a name, and has some selected (checked) values from a form submision. Map the submitted values 
        #  into the checked attribute, splitting on \0 as per spec
        #
        #  UPDATE: changed to accommodate use of Hash::Multivalue params now
        #
        my @checked=$cgi_or->param($attr_hr->{'name'});
        debug('checked: %s', Dumper(\@checked));
        #$attr_group{'checked'} = { map { $_=>1 } (split(/\0/, $checked)) }
        $attr_group{'checked'} = { map { $_=>1 } @checked }

    }
    else {

        #  Convert 'defaults' key to 'selected'
        #
        do {$attr_group{'checked'} ||= (delete($attr_group{'default'}) || delete($attr_group{'defaults'}))}
            if ($attr_group{'default'} || $attr_group{'defaults'});
            
    }


    #  Radio groups can only have one option checked. If multiple discard and only use first one in alphabetical order
    #
    if ($tag eq 'radio') {
        #%{$attr_group{'defaults'}}=map {$_ => $attr_group{'defaults'}{$_}} ([sort keys %{$attr_group{'defaults'}}]->[0])
        #    if $attr_group{'defaults'};
        %{$attr_group{'checked'}}=map {$_ => $attr_group{'checked'}{$_}} ([sort keys %{$attr_group{'checked'}}]->[0])
            if $attr_group{'checked'};
    }


    #  Now iterate and build actual tag, push onto HTML array
    #
    foreach my $value (@{$attr{'values'}}) {
        my %attr_tag=$attr{'attributes'}{$value}
            ?
            (%{$attr{'attributes'}{$value}})
            :
            ();
        $attr_tag{'name'}=$attr{'name'} if $attr{'name'};
        $attr_tag{'value'}=$value;

        #  Note use of empty array for checked and disabled values as per HTML::Tiny specs
        #$attr_tag{'checked'}=[]  if $attr_group{'defaults'}{$value};
        $attr_tag{'checked'}=[]  if $attr_group{'checked'}{$value};
        $attr_tag{'disabled'}=[] if $attr_group{'disabled'}{$value};
        $attr_tag{'label'}=$attr{'labels'}{$value} ? $attr{'labels'}{$value} : $value;
        push @html, $self->_radio_checkbox($tag, \%attr_tag);
    }


    #  Return, separating with linebreaks if that is what is wanted.
    #
    return join($attr{'linebreak'} ? $self->br() : '', @html);

}


sub checkbox_group {
    debug("$_[0] checkbox_group");
    return shift()->_radio_checkbox_group('checkbox', @_)
}


sub radio_group {
    debug("$_[0] radio_group");
    return shift()->_radio_checkbox_group('radio', @_)
}


sub checkbox {
    

    #  Bit more complex
    #
    my ($self, $attr_hr, @html)=@_;
    debug("$self checkbox, attr_hr:%s", Dumper($attr_hr));
    
    
    #  Mirror attributes so if we change we don't alter originals
    #
    my %attr=%{$attr_hr};


    #  Get hash ref of any existing CGI param
    #
    my $param_hr=($self->{'_Vars'} ||= $self->Vars()) ||
        return err('unable able to CGI::Simple Vars');
        

    #  And CGI object
    #
    my $cgi_or=$self->CGI() ||
        return err('unable to get CGI object');
    

    #  Var to hold hidden tag
    #
    my $hidden='';

    
    #  Massage to set default value of "1" for checkboxes if no value
    #  attr found. If one is found assume user knows what they are doing
    #
    unless (my $value=$attr_hr->{'value'}) {
        if (my $name=$attr_hr->{'name'}) {
        
            #  Add hidden field with same name but 0 value
            #
            debug("using hidden field for checkbox: $name, setting checked value to 1 if selected");
            #push @html, $self->hidden({ name=>$name, value=>0, force=>1 });
            $hidden=$self->hidden({ name=>$name, value=>0, force=>1 });
            
            
            #  Set value of this checkbox (if checked) to 1
            #
            $attr{'value'}=1;
            
            
            #  Add up all values for this checkbox now.
            #
            #  UPDATE: Changed to accommodate use of Hash::Multivalue params now.            
            #
            my $checked;
            #if (my $value=$param_hr->{$name}) {
            #    map { $checked+=int($_) } split(/\0/, $value);
            #}
            if (my @value=$cgi_or->param($name)) {
                map { $checked+=int($_) } @value;
            }
            
            
            #  Run checkbox logic
            #
            if(exists($param_hr->{$name}) && $checked) {
            
                debug("param name:$name exists and is checked, setting checked to true");
                $attr{'checked'}=[];
                
            }
            elsif(exists($param_hr->{$name}) && !$checked) {
                
                debug("param name:$name exists but is not defined, clearing checked attribute");
                delete $attr{'checked'};
                
            }
            else {
                
                debug("no $name param, using tag default: %s", $attr{'checked'} ? 'checked=1' : '<unchecked>');
                
            }
        }
        else {
        
            debug('no name attr');
            
        }
    }
    else {
    
        #  Custom value
        #
        debug("custom value: $value, checkbox logic bypassed");
        
    }
    
    
    #  Done, return result
    #
    #return shift()->_radio_checkbox('checkbox', @_)
    #return $self->_radio_checkbox('checkbox', grep {$_} $attr_hr, @_) . join(undef, grep {$_} @html);
    debug('calling radio_checkbox');
    return $hidden.$self->_radio_checkbox('checkbox', \%attr, join('', @html))
}


#  Popup menu or scrolling list
#
sub popup_menu {


    #  Build a checkbox or radio group
    #
    my ($self, $attr_hr)=@_;
    my %attr_select=%{$attr_hr};
    debug("$self popup_menu, attr_hr:%s", Dumper($attr_hr));
    
    
    #  Get hash ref of any existing CGI param
    #
    my $param_hr=($self->{'_Vars'} ||= $self->Vars()) ||
        return err('unable able to CGI::Simple Vars');


    #  And CGI object
    #
    my $cgi_or=$self->CGI() ||
        return err('unable to get CGI object');


    #  Hold generated HTML in array until end
    #
    my @html;
    
    
    #  Pull off any label
    #
    my $label=delete $attr_select{'label'};    


    #  If values is a hash not an array then convert to array and use hash as values
    #
    if (ref($attr_select{'values'}) eq 'HASH') {


        #  It's a hash - use as labels, and push keys to values
        #
        $attr_select{'labels'}=(my $hr=delete $attr_select{'values'});
        $attr_select{'values'}=[keys %{$hr}]

    }

    #  Convert arrays of default values (i.e checked/enabled) and any disabled entries into hash - easier to check
    #
    my %attr_option=(
        values     => delete $attr_select{'values'},
        attributes => delete $attr_select{'attributes'},
        labels     => delete $attr_select{'labels'}
    );


    #  Carefully handle options
    #
    foreach my $attr (qw(default selected disabled)) {

        next unless exists $attr_select{$attr};
        my @values;
        if (ref($attr_select{$attr}) eq 'ARRAY') {
            @values=@{$attr_select{$attr}}
        }
        else {
            #  Single value
            @values=(grep {$_} $attr_select{$attr})
        }

        unless ($attr eq 'disabled') {
            foreach my $value (@values) {
                debug("value $value");
                $attr_option{$attr}{$value}=1;
            }
            delete $attr_select{$attr};
        }
        else {    # handle disabled attr carefully
            if (@values) {
                foreach my $value (@values) {
                    $attr_option{$attr}{$value}=1;
                }
                delete $attr_select{$attr};
            }
            else {
                $attr_select{$attr}=[];
            }
        }
    }


    #  Debug
    #
    debug('in popup_menu attr_option: %s', Dumper(\%attr_option));
    
    
    #  Make sure selected values persist by default unless "force" attribute used to override
    #
    #if ($attr_hr->{'name'} && (my $selected=$param_hr->{$attr_hr->{'name'}}) && !$attr_hr->{'force'}) {
    if ($attr_hr->{'name'} && (my @selected=$cgi_or->param($attr_hr->{'name'})) && !$attr_hr->{'force'}) {

        #  The tag has a name, and has some selected (checked) values from a form submision. Map the submitted values 
        #  into the selected field, splitting on \0 as per spec
        #
        #  UPDATE: changed to accommodate use of Hash::Multivalue params now
        #
        #$attr_option{'selected'} = { map { $_=>1 } (split(/\0/, $selected)) }
        $attr_option{'selected'} = { map { $_=>1 } @selected }

    }
    else {

        #  Convert 'defaults' key to 'selected'
        #
        do {$attr_option{'selected'} ||= (delete($attr_option{'default'}) || delete($attr_option{'defaults'}))}
            if ($attr_option{'default'} || $attr_option{'defaults'});
            
    }

    #  If disabled option is an array but is empty then it is meant for the parent tag
    #
    #if ($attr_option{'disabled'} && !@{$attr_option{'disabled'}}) {
    #if ($attr_option{'disabled'} && !@{$attr_options{'disabled'}}) {
    #if (exists $attr_option{'disabled'} && !(keys %{$attr_option{'disabled'}})) {

    #  Yes, it is empty, so user wants whole option disabled
    #
    #    debug('disable entire popup_menu');
    #    $attr_select{'disabled'}=[]

    #}
    #else {

    #    debug('deleting attr_select disabled attr');
    #    delete $attr_select{'disabled'};

    #}

    #map { delete $attr_select{$_} } (qw(default selected disabled));


    #  Fix multiple tag if true
    #
    $attr_select{'multiple'}=[] if $attr_select{'multiple'};
    #map { delete $attr_select{$_} } (qw(default selected disabled));
    debug('in popup_menu attr_select: %s', Dumper(\%attr_select));


    #  Now iterate and build actual tag, push onto HTML array
    #
    foreach my $value (@{$attr_option{'values'}}) {
        my %attr_tag=$attr_option{'attributes'}{$value}
            ?
            (%{$attr_option{'attributes'}{$value}})
            :
            ();
        $attr_tag{'value'}=$value;

        #  Note use of empty array for checked and disabled values as per HTML::Tiny specs
        $attr_tag{'selected'}=[] if $attr_option{'selected'}{$value};
        $attr_tag{'disabled'}=[] if $attr_option{'disabled'}{$value};
        my $label=$attr_option{'labels'}{$value} ? $attr_option{'labels'}{$value} : $value;
        #debug("attr_option label: %s, value: $value, label: $label", Dumper($attr_option{'labels'}));

        #if ($label) {
        #    push @html, $self->label($self->option(\%attr_tag) . $label);
        #}
        #else {
        debug("pushing option tag with label: $label, attr_tag: %s", Dumper(\%attr_tag));
        push @html, $self->option(\%attr_tag, $label)

        #}
    }
    
    
    #  Now wrap in label if needed
    #
    debug('creating select group with attr: %s, options:%s, label: %s', Dumper(\%attr_select, \@html), $label);
    if ($label) {
        return $self->label($label . $self->select(\%attr_select, join($/, @html)));
    }
    else {
        return $self->select(\%attr_select, join($/, @html));
    }
    

    #  Return
    #
    #return $self->select(\%attr_select, join($/, @html));

}


sub scrolling_list {

    #  Only difference between popup_menu and scrolling list is size attrribute, which we calculate  -if
    #  supplied will overwrite calculated value
    #
    my ($self, $attr_hr, @param)=@_;
    debug("self $self scrolling_list, attr_hr: %s", Dumper($attr_hr));
    my $size=(ref($attr_hr->{'values'}) eq 'ARRAY') ? scalar @{$attr_hr->{'values'}} : scalar keys %{$attr_hr->{'values'}};
    #return shift()->popup_menu({size => scalar @{$_[0]->{'values'}}, %{shift()}}, @_);
    return $self->popup_menu({size => $size, %{$attr_hr}}, @param);

}


sub textarea {

    #  Slightly different handling for textarea
    #
    my ($self, $attr_hr, @param)=@_;
    debug("self $self textarea, attr_hr: %s", Dumper($attr_hr));


    #  Get hash ref of any existing CGI param
    #
    my $param_hr=($self->{'_Vars'} ||= $self->Vars()) ||
        return err('unable able to CGI::Simple Vars');
        
        
    #  Copy attr_hr so don't mangle original
    #
    my %attr=%{$attr_hr};
    
    
    #  Label ?
    #
    my $label=delete $attr{'label'};
        

    #  Make sure entered text persists unless force in effect
    #
    my $content=delete($attr{'default'});
    if ($attr{'name'} && (my $entered=$param_hr->{$attr{'name'}}) && !$attr{'force'}) {

        #  The tag has a name, and has some already entered text. That wins
        #
        $content=$entered

    }
    
    
    #  Wrap in label if needed
    #
    if ($label) {
        return $self->label( $label . $self->SUPER::textarea(grep {$_} \%attr, $content));
    }
    else {
        #  Have enough to build now
        #
        return $self->SUPER::textarea(grep {$_} \%attr, $content);
    }
    
}


sub AUTOLOAD {
    debug("AUTOLOAD: $AUTOLOAD");
    if (my ($action, $tag)=($AUTOLOAD=~/\:\:(start|end|open|close)_([^:]+)$/)) {
        debug("action: $action, tag: $tag");
        *{$AUTOLOAD}=sub {shift()->$action($tag, @_)};
        return &{$AUTOLOAD}(@_);
    }
}
