File Coverage

blib/lib/DBIx/HTML/PopupRadio.pm

Criterion	Covered	Total	%
statement	12	87	13.7
branch	0	28	0.0
condition	0	6	0.0
subroutine	4	14	28.5
pod	6	6	100.0
total	22	141	15.6

package DBIx::HTML::PopupRadio;

# Name:
#	DBIx::HTML::PopupRadio.
#
# Purpose:
#	Allow caller to specify a database handle, an sql statement,
#	and a name for the menu, and from that build the HTML for the menu.
#	Menu here means either popup menu or radio group.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
# Note:
#	o tab = 4 spaces || die
#
# V 1.00 1-Oct-2002
# -----------------
# o Original version
#
# Author:
#	Ron Savage
#	Home page: http://www.deakin.edu.au/~rons

use strict;
use warnings;

require 5.005_62;

require Exporter;

use Carp;
use HTML::Entities::Interpolate;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Image::MagickWrapper ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '1.16';

# -----------------------------------------------

# Preloaded methods go here.

# -----------------------------------------------

# Encapsulated class data.

{
	my(%_attr_data) =
	(	# Alphabetical order.
		_dbh		=> '',
		_default	=> '',			# For popup_menu or radio_group.
		_javascript	=> '',
		_linebreak	=> 0,			# For radio_group.
		_name		=> 'dbix_menu',
		_options	=> {},
		_prompt		=> '',			# For popup_menu.
		_sql		=> '',
	);

	sub _default_for
	{
		my($self, $attr_name) = @_;

		$_attr_data{$attr_name};
	}

	sub _read_data
	{
		my($self)		= @_;
		my($sth)		= $$self{'_dbh'} -> prepare($$self{'_sql'});
		$$self{'_data'}	= {};
		my($order)		= 0;

		$sth -> execute();

		my($data);

		while ($data = $sth -> fetch() )
		{
			$$self{'_data'}{$$data[0]} =
			{
				order	=> $order++,
				value	=> $$data[1],
			};
		}

		$$self{'_size'} = $order;

	}	# End of _read_data.

	sub _standard_keys
	{
		sort keys %_attr_data;
	}

	sub _validate_options
	{
		my($self) = @_;

		croak(__PACKAGE__ . ". You must supply values for these parameters: dbh, name and sql") if (! $$self{'_dbh'} || ! $$self{'_name'} || ! $$self{'_sql'});

#		# Reset empty parameters to their defaults.
#		# This could be optional, depending on another option.
#
#		for my $attr_name ($self -> _standard_keys() )
#		{
#			$$self{$attr_name} = $self -> _default_for($attr_name) if (! $$self{$attr_name});
#		}

	}	# End of _validate_options.

}	# End of Encapsulated class data.

# -----------------------------------------------

sub new
{
	my($class, %arg)	= @_;
	my($self)			= bless({}, $class);

	for my $attr_name ($self -> _standard_keys() )
	{
		my($arg_name) = $attr_name =~ /^_(.*)/;

		if (exists($arg{$arg_name}) )
		{
			$$self{$attr_name} = $arg{$arg_name};
		}
		else
		{
			$$self{$attr_name} = $self -> _default_for($attr_name);
		}
	}

	# This is the size (# if items) in the menu.
	# Ie, it is the number of rows returned by the SQL.

	$$self{'_size'} = 0;

	return $self;

}	# End of new.

# -----------------------------------------------

sub param
{
	my($self, $id) = @_;

	$id ? $$self{'_data'}{$id}{'value'} : '';

}	# End of param.

# -----------------------------------------------

sub popup_menu
{
	my($self, %arg) = @_;

	# Give the user one last chance to set some parameters.

	$self -> set(%arg);
	$self -> _validate_options();
	$self -> _read_data() if (! $$self{'_data'});

	my(@html, $s);

	$s = qq|
	$s .= qq|$_="$Entitize{$$self{'_options'}{$_} }" | for sort keys %{$$self{'_options'} };
	$s .= $$self{'_javascript'} if ($$self{'_javascript'});
	$s .= '>';

	push(@html, '', $s);

	my($prompt) = $$self{'_prompt'};

	if ($prompt)
	{
		if (ref($prompt) eq 'HASH')
		{
			push @html, qq|$Entitize{$$prompt{$_} }| for sort keys %$prompt;
		}
		else
		{
			push @html, qq|$Entitize{$prompt}|;
		}
	}

	for (sort{$$self{'_data'}{$a}{'order'} <=> $$self{'_data'}{$b}{'order'} } keys %{$$self{'_data'} })
	{
		$s = qq|
		$s .= qq| selected="selected"| if (defined($$self{'_default'}) && (lc $$self{'_default'} eq lc $$self{'_data'}{$_}{'value'}) );
		$s .= qq|>$Entitize{$$self{'_data'}{$_}{'value'} }|;

		push @html, $s;
	}

	push @html, '', '';

	join "\n", @html;

}	# End of popup_menu.

# -----------------------------------------------

sub radio_group
{
	my($self, %arg) = @_;

	# Give the user one last chance to set some parameters.

	$self -> set(%arg);
	$self -> _validate_options();
	$self -> _read_data() if (! $$self{'_data'});

	my($count) = 0;

	my(@html, $s);

	push @html, '';

	for (sort{$$self{'_data'}{$a}{'order'} <=> $$self{'_data'}{$b}{'order'} } keys %{$$self{'_data'} })
	{
		$s = qq|

		if ($$self{'_default'})
		{
			$s .= qq| checked="checked"| if (lc $$self{'_default'} eq lc $$self{'_data'}{$_}{'value'});
		}
		else
		{
			$count++;

			$s .= qq| checked="checked"| if ($count == 1);
		}

		$s .= qq| />$Entitize{$$self{'_data'}{$_}{'value'} }|;
		$s .= '' if ($$self{'_linebreak'});

		push @html, $s;
	}

	push @html, '';

	join "\n", @html;

}	# End of radio_group.

# -----------------------------------------------

sub set
{
	my($self, %arg) = @_;

	for my $arg (keys %arg)
	{
		$$self{"_$arg"} = $arg{$arg} if (exists($$self{"_$arg"}) );
	}

}	# End of set.

# -----------------------------------------------

sub size
{
	my($self) = @_;

	$$self{'_size'};

}	# End of size.

# -----------------------------------------------

1;

__END__