view release on metacpan or  search on metacpan

lib/CGI/FormMagick/TagMaker.pm  view on Meta::CPAN

=cut

package CGI::FormMagick::TagMaker;
require 5.004;

use strict;
use vars qw($VERSION @ISA $AUTOLOAD);
$VERSION = '1.01';

use Class::ParamParser;
@ISA = qw( Class::ParamParser );

=head1 SYNOPSIS

    use CGI::FormMagick::TagMaker;

    my $html = CGI::FormMagick::TagMaker->new();
    $html->input( type => 'submit' ),

=head1 DESCRIPTION

This Perl 5 object class can be used to generate any HTML tags in a format that
is consistent with the W3C HTML 4.0 standard.  There are no restrictions on what
tags are named, however; you can ask for any new or unsupported tag that comes
along from Netscape or Microsoft, and it will be made.  Additionally, you can
generate lists of said tags with one method call, or just parts of said tags (but
not both at once).

In this implementation, "standard format" means that tags are made as pairs
(<TAG></TAG>) by default, unless they are known to be "no pair" tags.  Tags that
I know to be "no pair" are [basefont, img, area, param, br, hr, input, option,
tbody, frame, comment, isindex, base, link, meta].  However, you can force any
tag to be "pair" or "start only" or "end only" by appropriately modifying your
call to the tag making method.

Also, "standard format" means that tag modifiers are formatted as "key=value" by
default, unless they are known to be "no value" modifiers.  Modifiers that I know
to be "no value" are [ismap, noshade, compact, checked, multiple, selected,
nowrap, noresize, param].  These are formatted simply as "key" because their very
presence indicates positive assertion, while their absense means otherwise.  For
modifiers with values, the values will always become bounded by quotes, which
ensures they work with both string and numerical quantities (eg: key="value").

Note that this class is a subclass of Class::ParamParser, and inherits
all of its methods, "params_to_hash()" and "params_to_array()".

=for testing
TODO: {
    local $TODO = "Write tests for TagMaker!";
    ok(0, "Fake test just to keep 'make test' happy");
}

=cut


# Names of properties for objects of this class are declared here:
my $KEY_AUTO_GROUP = 'auto_group';  # do we make tag groups by default?
my $KEY_AUTO_POSIT = 'auto_posit';  # with methods whose parameters 
	# could be either named or positional, when we aren't sure what we 
	# are given, do we guess positional?  Default is named.

# These extra tag properties work only with AUTOLOAD:
my $PARAM_TEXT = 'text';  #tag pair is wrapped around this
my $PARAM_LIST = 'list';  #force tag groups to be returned in ARRAY ref

# Constant values used in this class go here:

my $TAG_GROUP = 'group';  # values that "what_to_make" can have
my $TAG_PAIR  = 'pair'; 
my $TAG_START = 'start';
my $TAG_END   = 'end';

my %NO_PAIR_TAGS = (  # comments correspond to Bare Bones sections
	basefont => 1,   # PRESENTATION FORMATTING
	img => 1,   # LINKS, GRAPHICS, AND SOUNDS
	area => 1,   # LINKS, GRAPHICS, AND SOUNDS
	param => 1,   # LINKS, GRAPHICS, AND SOUNDS
	br => 1,   # DIVIDERS
	hr => 1,   # DIVIDERS
	input => 1,   # FORMS
	option => 1,   # FORMS
	tbody => 1,   # TABLES
	frame => 1,   # FRAMES
	comment => 1,   # MISCELLANEOUS
	isindex => 1,   # MISCELLANEOUS
	base => 1,   # MISCELLANEOUS
	'link' => 1,   # MISCELLANEOUS
	meta => 1,   # MISCELLANEOUS
);

my %NO_VALUE_PARAMS = (  # comments correspond to Bare Bones sections
	ismap => 1,   # LINKS, GRAPHICS, AND SOUNDS
	noshade => 1,   # DIVIDERS
	compact => 1,   # LISTS
	checked => 1,   # FORMS
	multiple => 1,   # FORMS
	selected => 1,   # FORMS
	nowrap => 1,   # TABLES
	noresize => 1,   # FRAMES
	param => 1,   # SCRIPTS AND JAVA
);

my %PARAMS_PRECEDENCE = (   # larger number means goes first; undef last
	method => 190,
	action => 185,
	type => 180,
	name => 175,
	width => 170,
	height => 165,
	rows => 160,
	cols => 155,
	border => 150,
	cellspacing => 145,
	cellpadding => 140,
	multiple => 135,
	checked => 130,
	selected => 125,
	value => 120,
	target => 115,
	rev => 113,

lib/CGI/FormMagick/TagMaker.pm  view on Meta::CPAN

	}

	my $rh_params = $self->params_to_hash( \@_, 0, $PARAM_TEXT, 
		{}, $PARAM_TEXT );
	my $ra_text = delete( $rh_params->{$PARAM_TEXT} );
	my $force_list = delete( $rh_params->{$PARAM_LIST} );

	if( lc($what_to_make) eq $TAG_GROUP ) {
		return( $self->make_html_tag_group( 
			$tag_name, $rh_params, $ra_text, $force_list ) );
	}

	return( $self->make_html_tag( 
		$tag_name, $rh_params, $ra_text, $what_to_make ) );
}

# This is provided so AUTOLOAD isn't called instead.
sub DESTROY {
}

sub by_params_precedence {
    local $PARAMS_PRECEDENCE{$a} ||= 0;
    local $PARAMS_PRECEDENCE{$b} ||= 0;
    return $PARAMS_PRECEDENCE{$a} <=> $PARAMS_PRECEDENCE{$b};
}

=head1 FUNCTIONS AND METHODS

Note that all the methods defined below are static, so information specific to
autoloaded methods won't likely apply to them.  All of these methods take
positional arguments unless otherwise specified.

=head2 new()

This function creates a new HTML::TagMaker object (or subclass thereof) and 
returns it.

=for testing
BEGIN: { 
    use_ok('CGI::FormMagick::TagMaker'); 
}
my $t = CGI::FormMagick::TagMaker->new();
isa_ok($t, 'CGI::FormMagick::TagMaker');

=cut

sub new {
	my $class = shift( @_ );
	my $self = bless( {}, ref($class) || $class );
	$self->{$KEY_AUTO_GROUP} = 0;
	$self->{$KEY_AUTO_POSIT} = 0;
	return( $self );
}

=head2 groups_by_default([ VALUE ])

This method is an accessor for the boolean "automatic grouping" property of this
object, which it returns.  If VALUE is defined, this property is set to it.  In
cases where we aren't told explicitely that autoloaded methods are making a
single or multiple tags (using ['_start', '_end', '_pair'] and '_group'
respectively), we look to this property to determine what operation we guess. 
The default is "single".  When this property is true, we can make both single and
groups of tags by using a suffix-less method name; however, making single tags
this way is slower than when this property is false.  Also, be aware that when we
are making a "group", arguments that are ARRAY refs are always flattened, and
when we are making a "single", ARRAY ref arguments are always used literally.

=cut

sub groups_by_default {
	my $self = shift( @_ );
	if( defined( my $new_value = shift( @_ ) ) ) {
		$self->{$KEY_AUTO_GROUP} = $new_value;
	}
	return( $self->{$KEY_AUTO_GROUP} );
}

=head2 positional_by_default([ VALUE ])

This method is an accessor for the boolean "positional arguments" property of
this object, which it returns.  If VALUE is defined, this property is set to it. 
With methods whose parameters could be either named or positional, when we aren't
sure what we are given, do we guess positional?  Default is named.

=cut

sub positional_by_default {
	my $self = shift( @_ );
	if( defined( my $new_value = shift( @_ ) ) ) {
		$self->{$KEY_AUTO_POSIT} = $new_value;
	}
	return( $self->{$KEY_AUTO_POSIT} );
}

=head2 make_html_tag( NAME[, PARAMS[, TEXT[, PART]]] )

This method is used internally to do the actual construction of single html tags.
 You can call it directly when you want faster code and/or more control over how
tags are made.  The first argument, NAME, is a scalar that defines the actual
name of the tag we are making (eg: 'br'); it is case-insensitive.  The optional
second argument, PARAMS, is a HASH ref containing attribute names and values for
the new tag; the names (keys) are case-insensitive.  The attribute values are all
printed literally, so they should be scalars.  The optional third argument, TEXT,
is a scalar containing the text that goes between the tag pairs; it is not a tag
attribute.  The optional fourth argument, PART, is a scalar which indicates we
should make just a certain part of the tag; acceptable values are ['pair',
'start', 'end'], and it is case-insensitive.  This method knows which HTML tags
are normally paired or not, which tag attributes take specified values or not,
and acts accordingly.

=cut

sub make_html_tag {
	my ($self, $tag_name, $rh_params, $text, $what_to_make) = @_; 
	$tag_name     = lc($tag_name);
	$what_to_make = lc($what_to_make);
	$text         = $text || '';

	my %tag_params = map { ( lc($_) => $rh_params->{$_} ) } 
		(ref($rh_params) eq 'HASH') ? (keys %{$rh_params}) : ();

	unless( $what_to_make =~ /^($TAG_PAIR|$TAG_START|$TAG_END)$/ ) {
		$what_to_make = 
			$NO_PAIR_TAGS{$tag_name} ? $TAG_START : $TAG_PAIR;
	}
	
	my $tag_name_uc = uc($tag_name);
	
	if( $what_to_make eq $TAG_END ) {
		return( "\n</$tag_name_uc>" );
	}
				
	my $param_str = '';
	foreach my $param ( sort by_params_precedence keys %tag_params ) {
		next if( $NO_VALUE_PARAMS{$param} and !$tag_params{$param} );
		$param_str .= ' '.uc( $param );
		unless( $NO_VALUE_PARAMS{$param} ) {
			if ($tag_params{$param}) {
				$param_str .= "=\"$tag_params{$param}\"";
			}
		}
	}