File Coverage

blib/lib/HTML/StickyQuery/DoCoMoGUID.pm

Criterion	Covered	Total	%
statement	54	65	83.0
branch	25	32	78.1
condition	14	16	87.5
subroutine	7	7	100.0
pod	0	3	0.0
total	100	123	81.3

package HTML::StickyQuery::DoCoMoGUID;

use strict;
use warnings;
our $VERSION = '0.03';

use HTML::StickyQuery;

sub new {
    my ($class, %args) = @_;
    bless {
        sticky => HTML::StickyQuery->new( regexp => qr/./, %args ),
    }, $class;
}

sub sticky {
    my($self, %args) = @_;
    $args{param} ||= {};
    $args{param}->{guid} = 'ON' unless $args{disable_guid};

    local $self->{sticky}->{use_xhtml} = exists $args{xhtml} ? $args{xhtml} : 1;

    local *_start = *HTML::StickyQuery::start;
    local *HTML::StickyQuery::start = *start;
    $self->{sticky}->sticky( %args );
}

# sticky for FORM tag. original code is HTML::StickyQuery
sub start {
    my($self, $tagname, $attr, $attrseq, $orig) = @_;

    if ($tagname ne 'form') {
        # goto original code
        goto &_start;
    }

    unless(exists $attr->{action}) {
        $self->{output} .= $orig;
        return;
    }
    my $u = URI->new($attr->{action});

    # skip absolute URI
    if (!$self->{abs} && $u->scheme) {
        $self->{output} .= $orig;
        return;
    }

    # when URI has other scheme (ie. mailto ftp ..)
    if(defined($u->scheme) && $u->scheme !~ m/^https?/) {
        $self->{output} .= $orig;
        return;
    }

    if (!$self->{regexp} || $u->path =~ m/$self->{regexp}/) {
        # get method
        unless (($attr->{method} || '') =~ /^post$/i) {
            $self->{output} .= $orig;
            _sticky_input($self);
            return;
        }

        # post method
        if ($self->{keep_original}) {
            my %original;
            my @original = $u->query_form;
            while (my ($key, $val) = splice(@original, 0, 2)) {
                if (exists $original{$key}) {
                    if (ref $original{$key} eq 'ARRAY') {
                        push @{ $original{$key} }, $val;
                    } else {
                        $original{$key} = [ $original{$key}, $val ];
                    }
                } else {
                    $original{$key} = $val;
                }
            }
            $u->query_form( %original, (exists $self->{param}->{guid} ? (guid => $self->{param}->{guid}) : ()) );
        } else {
            $u->query_form(%{$self->{param}});
        }

        $self->{output} .= "<$tagname";
        # save attr order.
        for my $key (@{ $attrseq }) {
            if ($key eq 'action'){
                $self->{output} .= sprintf ' action="%s"', $self->escapeHTML($u->as_string);
            } elsif ($attr->{$key} eq '__BOOLEAN__') {
                $self->{output} .= " $key";
            } else {
                $self->{output} .= sprintf qq{ $key="%s"}, $self->escapeHTML($attr->{$key});
            }
        }
        $self->{output} .= '>';
        # add some params
        _sticky_input($self, 1);
        return;
    }

    $self->{output} .= $orig;
}

sub _sticky_input {
    my($self, $ignore_guid) = @_;
    while (my($key, $value) = each %{ $self->{param} }) {
        next if $ignore_guid && $key eq 'guid';
        $self->{output} .= sprintf '',
                               $key, $value, ($self->{use_xhtml} ? ' /' : '');
    }
}

1;
__END__