File Coverage

lib/CGI/FormBuilder/Util.pm

Criterion	Covered	Total	%
statement	115	134	85.8
branch	60	78	76.9
condition	55	85	64.7
subroutine	23	26	88.4
pod	20	20	100.0
total	273	343	79.5

###########################################################################
# Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
# Please visit http://formbuilder.org for tutorials, support, and examples.
###########################################################################

package CGI::FormBuilder::Util;

=head1 NAME

CGI::FormBuilder::Util - Utility functions for FormBuilder

=head1 SYNOPSIS

    use CGI::FormBuilder::Util;

    belch "Badness";
    puke "Egads";
    debug 2, "Debug message for level 2";

=head1 DESCRIPTION

This module exports some common utility functions for B.
These functions are intended for internal use, however I must admit
that, from time to time, I just import this module and use some of
the routines directly (like C to generate HTML).

=head1 USEFUL FUNCTIONS

These can be used directly and are somewhat useful. Don't tell anyone
I said that, though.

=cut

use strict;
use warnings;
no  warnings 'uninitialized';
use Carp;

# Don't "use" or it collides with our basename()
require File::Basename;

our $VERSION = '3.10';

# Place functions you want to export by default in the
# @EXPORT array. Any other functions can be requested
# explicitly if you place them in the @EXPORT_OK array.
use Exporter;
use base 'Exporter';
our @EXPORT = qw(
    debug belch puke indent escapeurl escapehtml escapejs
    autodata optalign optsort optval arglist arghash
    htmlattr htmltag toname tovar ismember basename rearrange
);
our $DEBUG = 0;
our %TAGNAMES = ();     # holds translated tag names (experimental)

# To clean up the HTML, instead of just allowing the HTML tags that
# we interpret are "valid", instead we yank out all the options and
# stuff that we use internally. This allows arbitrary tags to be
# specified in the generation of HTML tags, and also means that this
# module doesn't go out of date when the HTML spec changes next week.
our @OURATTR = qw(
    add_before_option add_after_option attr autofill autofillshow body bodyname
    buttonname caller checknum cleanopts columns cookies comment debug delete
    disable_enter dtd errorname extraname fields fieldattr fieldsubs fieldtype fieldname
    fieldopts fieldset fieldsets font force formname growable growname header
    idprefix inputname invalid javascript jsmessage jsname jsprefix jsfunc jshead
    jserror jsvalid keepextras labels labelname lalign
    linebreaks message messages nameopts newline NON_EMPTY_SCRIPT other othername
    optgroups options override page pages pagename params render required
    reset resetname rowname selectname selectnum sessionidname sessionid
    smartness source sortopts static statename sticky stylesheet styleclass submit
    submitname submittedname table tabname template validate values
);

# trick for speedy lookup
our %OURATTR = map { $_ => 1 } @OURATTR;

# Have to populate ourselves to avoid carp'ing with bad information.
# This makes it so deeply-nested calls throw top-level errors, rather
# than referring to a sub-module that probably didn't do it.
our @CARP_NOT = qw(
    CGI::FormBuilder
    CGI::FormBuilder::Field
    CGI::FormBuilder::Field::button
    CGI::FormBuilder::Field::checkbox
    CGI::FormBuilder::Field::file
    CGI::FormBuilder::Field::hidden
    CGI::FormBuilder::Field::image
    CGI::FormBuilder::Field::password
    CGI::FormBuilder::Field::radio
    CGI::FormBuilder::Field::select
    CGI::FormBuilder::Field::static
    CGI::FormBuilder::Field::text
    CGI::FormBuilder::Field::textarea
    CGI::FormBuilder::Messages
    CGI::FormBuilder::Multi
    CGI::FormBuilder::Source
    CGI::FormBuilder::Source::File
    CGI::FormBuilder::Template
    CGI::FormBuilder::Template::Builtin
    CGI::FormBuilder::Template::Fast
    CGI::FormBuilder::Template::HTML
    CGI::FormBuilder::Template::TT2
    CGI::FormBuilder::Template::Text
    CGI::FormBuilder::Template::CGI_SSI
    CGI::FormBuilder::Util
);

=head2 debug($level, $string)

This prints out the given string only if C<$DEBUG> is greater than
the C<$level> specified. For example:

    $CGI::FormBuilder::Util::DEBUG = 1;
    debug 1, "this is printed";
    debug 2, "but not this one";

A newline is automatically included, so don't provide one of your own.

=cut

sub debug ($;@) {
    return unless $DEBUG >= $_[0];  # first arg is debug level
    my $l = shift;  # using $_[0] directly above is just a little faster...
    my($func) = (caller(1))[3];
    #$func =~ s/(.*)::/$1->/;
    warn "[$func] (debug$l) ", @_, "\n";
}

=head2 belch($string)

A modified C that prints out a better message with a newline added.

=cut

sub belch (@) {
    my $i=1;
    carp "[FormBuilder] Warning: ", @_;
}

=head2 puke($string)

A modified C that prints out a useful message.

=cut

sub puke (@) {
    my $i=1;
    $DEBUG ? Carp::confess("Fatal: ", @_)
           : croak "[FormBuilder] Fatal: ", @_
}

=head2 escapeurl($string)

Returns a properly escaped string suitable for including in URL params.

=cut

sub escapeurl ($) {
    # minimalist, not 100% correct, URL escaping
    my $toencode = shift;
    $toencode =~ s!([^a-zA-Z0-9_,.-/])!sprintf("%%%02x",ord($1))!eg;
    return $toencode;
}

=head2 escapehtml($string)

Returns an HTML-escaped string suitable for embedding in HTML tags.

=cut

sub escapehtml ($) {
    my $toencode = shift;
    return '' unless defined $toencode;
    # use very basic built-in HTML escaping
    $toencode =~ s!&!&!g;
    $toencode =~ s!
    $toencode =~ s!>!>!g;
    $toencode =~ s!"!"!g;
    return $toencode;
}

=head2 escapejs($string)

Returns a string suitable for including in JavaScript. Minimal processing.

=cut

sub escapejs ($) {
    my $toencode = shift;
    $toencode =~ s#'#\\'#g;
    return $toencode;
}

=head2 htmltag($name, %attr)

This generates an XHTML-compliant tag for the name C<$name> based on the
C<%attr> specified. For example:

    my $table = htmltag('table', cellpadding => 1, border => 0);

No routines are provided to close tags; you must manually print a closing
C<<