From: Mischa Poslawsky <mischa@mediadesign.nl>
Date: Thu, 17 Jul 2008 19:01:06 +0000 (+0200)
Subject: basic HTML::Form::Simple module setup
X-Git-Url: http://git.shiar.net/perl/html-form-simple.git/commitdiff_plain/07e0ed545852a3c579b3475786c02d84a48eb3f2

basic HTML::Form::Simple module setup

Initial module setup for basic form-related HTML output.  Meant to
replace various ad-hoc subroutines.  Start with a decent input() method
and work from here.  Test suite provided for current functionality.
---

07e0ed545852a3c579b3475786c02d84a48eb3f2
diff --git a/lib/HTML/Form/Simple.pm b/lib/HTML/Form/Simple.pm
new file mode 100644
index 0000000..b4e42aa
--- /dev/null
+++ b/lib/HTML/Form/Simple.pm
@@ -0,0 +1,138 @@
+package HTML::Form::Simple;
+
+use strict;
+use warnings;
+
+use XML::Quote;
+
+our $VERSION = '1.00';
+
+
+sub new {
+	bless {}, $_[0];
+}
+
+sub quote {
+	my $self = shift;
+	return XML::Quote::xml_quote_min($_[0]);
+}
+
+sub tag {
+	my ($self, $tag, $attr) = @_;
+
+	# strip empty if it shouldn't be
+	defined $attr->{$_} and $attr->{$_} eq '' and delete $attr->{$_}
+		for qw(id type);
+
+	my $return = '<' . $tag;
+
+	# add booleans
+	delete $attr->{$_} and $return .= ' '.$_
+		for qw(disabled readonly);
+
+	$return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
+		for sort grep { defined $attr->{$_} } keys %$attr;
+
+	return $return . '>';
+}
+
+
+sub start {
+	my ($self, $attr) = @_;
+
+	return $self->tag(form => $attr);
+}
+
+sub stop {
+	return '</form>';
+}
+
+
+sub submit {
+	my ($self, $value, $attr) = @_;
+
+	if (ref $value eq 'HASH') {
+		$attr = $value;
+	}
+	else {
+		$attr ||= {};
+		$attr->{value} = $value;
+	}
+
+	$attr->{type} = 'submit' unless defined $attr->{type};
+
+	return $self->tag(input => $attr);
+}
+
+sub hidden {
+	my ($self, $name, $value) = @_;
+
+	#TODO: $attr
+
+	return $self->tag(input => {type => 'hidden', name => $name, value => $value});
+}
+
+sub input {
+	my ($self, $name, $value, $attr) = @_;
+
+	if (ref $name eq 'HASH') {
+		# only attributes provided (first argument)
+		$attr = $name;
+	}
+	elsif (ref $value eq 'HASH') {
+		# name shorthand (attributes in value parameter)
+		$attr = $value;
+		$attr->{name} = $name;
+	}
+	else {
+		# name and value shorthands (all vars keep their assigned values)
+		$attr ||= {};
+		$attr->{name} = $name;
+		$attr->{value} = $value;
+	}
+
+	$attr->{id}   = $attr->{name} unless defined $attr->{id};
+	$attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
+	$value = delete $attr->{value} if defined $attr->{rows};
+
+	return defined $attr->{rows} ? sprintf(
+		'%s%s</textarea>',
+		$self->tag(textarea => $attr),
+		$self->quote(defined $value ? $value : '')
+	) : $self->tag(input => $attr);
+}
+
+sub select {
+	my ($self, $name, $rows, $value, $attr) = @_;
+
+	if (ref $value eq 'HASH') {
+		$attr = $value;
+	}
+	else {
+		$attr ||= {};
+	}
+	$attr->{name} = $name;
+
+	return $self->tag(select => $attr) . join('',
+		map { $self->tag(option => (ref $_ ? $_ : {value => $_})) } @$rows
+	) . '</select>';
+}
+
+1;
+
+=head1 NAME
+
+HTML::Form::Simple
+
+=head1 SYNOPSIS
+
+	my $input = HTML::Form::Simple->new;
+	say $input->start; # <form>
+	printf "<label>%s: %s</label>\n", @$_ for (
+		[ 'Your Name' => $input->text(username => 'Mr. Default') ],
+		[ Colour => $input->select(
+			favcolour => [qw(Blue Green Red)], 'Green'
+		) ],
+	);
+	say $input->stop; # </form>
+
diff --git a/t/html.t b/t/html.t
new file mode 100644
index 0000000..0535da9
--- /dev/null
+++ b/t/html.t
@@ -0,0 +1,204 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 31;
+
+use_ok('HTML::Form::Simple');
+
+my $form = HTML::Form::Simple->new;
+ok($form, 'new form');
+
+# form
+
+is(
+	$form->start,
+	'<form>',
+	'empty start'
+);
+
+is(
+	$form->start({method => 'get', action => '', ignore => undef}),
+	'<form action="" method="get">',
+	'start with attributes'
+);
+
+is(
+	eval { $form->start('should be a hashref') },
+	undef,
+	'invalid attributes'
+);
+
+is(
+	$form->stop,
+	'</form>',
+	'stop'
+);
+
+# hidden
+
+is(
+	$form->hidden,
+	'<input type="hidden">',
+	'empty hidden'
+);
+
+is(
+	$form->hidden(foo => 'bar'),
+	'<input name="foo" type="hidden" value="bar">',
+	'hidden'
+);
+
+#TODO: hidden options
+
+# submit
+
+is(
+	$form->submit,
+	'<input type="submit">',
+	'empty submit'
+);
+
+is(
+	$form->submit('<OK>'),
+	'<input type="submit" value="&lt;OK>">',
+	'submit value'
+);
+
+is(
+	$form->submit({disabled => 1, id => 'test', type => 'button'}),
+	'<input disabled id="test" type="button">',
+	'submit attributes'
+);
+
+is(
+	$form->submit('<OK>', {type => '', value => 'override', id => ''}),
+	'<input value="&lt;OK>">',
+	'submit overrides'
+);
+
+# input
+
+is(
+	$form->input,
+	'<input type="text">',
+	'empty input'
+);
+
+is(
+	$form->input(undef, undef, undef),
+	'<input type="text">',
+	'explicit empty input'
+);
+
+is(
+	$form->input('test'),
+	'<input id="test" name="test" type="text">',
+	'input with name'
+);
+
+is(
+	$form->input(undef, 'test'),
+	'<input type="text" value="test">',
+	'input with value'
+);
+
+is(
+	$form->input(undef, {value => 'test'}),
+	'<input type="text" value="test">',
+	'input with attribute value'
+);
+
+is(
+	$form->input({name => 'test', value => ''}),
+	'<input id="test" name="test" type="text" value="">',
+	'input with only attributes'
+);
+
+is(
+	$form->input('', '', {disabled => 0, something => undef}),
+	'<input name="" type="text" value="">',
+	'input with empty attributes'
+);
+
+is(
+	$form->input(undef, undef, {name => 'override', value => 'override'}),
+	'<input type="text">',
+	'ignore input overrides'
+);
+
+is(
+	$form->input('name', {id => ''}),
+	'<input name="name" type="text">',
+	'input with id override'
+);
+
+is(
+	$form->input('<">', '<">', {id => '>"<'}),
+	'<input id=">&quot;&lt;" name="&lt;&quot;>" type="text" value="&lt;&quot;>">',
+	'input quoting'
+);
+
+is(
+	$form->input(undef, {disabled => 'something'}),
+	'<input disabled type="text">',
+	'disabled input'
+);
+
+is(
+	$form->input({type => 'password'}),
+	'<input type="password">',
+	'password'
+);
+
+# textarea
+
+is(
+	$form->input({rows => 0}),
+	'<textarea rows="0"></textarea>',
+	'minimal textarea'
+);
+
+is(
+	$form->input(foo => 'bar', {cols => 42, rows => 1, disabled => 1}),
+	'<textarea disabled cols="42" id="foo" name="foo" rows="1">bar</textarea>',
+	'textarea'
+);
+
+is(
+	$form->input(undef, qq{<foo>&bl'a"\n    .}, {cols => undef, rows => '<">'}),
+	qq{<textarea rows="&lt;&quot;>">&lt;foo>&amp;bl'a&quot;\n    .</textarea>},
+	'textarea quoting'
+);
+
+# select
+
+is(
+	$form->select,
+	'<select></select>', # malformed html: at least 1 option required
+	'empty select'
+);
+
+is(
+	$form->select(undef, [], '', {name => ''}),
+	'<select></select>',
+	'explicit empty select'
+);
+
+is(
+	$form->select(undef, [undef]),
+	'<select><option></select>',
+	'minimal select'
+);
+
+is(
+	$form->select(foo => [1..2]),
+	'<select name="foo"><option value="1"><option value="2"></select>',
+	'select contents'
+);
+
+#TODO
+