view release on metacpan or  search on metacpan

lib/CGI/FormBuilder/Util.pm  view on Meta::CPAN

    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<warn> 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<die> 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!&!&amp;!g;
    $toencode =~ s!<!&lt;!g;
    $toencode =~ s!>!&gt;!g;
    $toencode =~ s!"!&quot;!g;
    return $toencode;
}

=head2 escapejs($string)

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

lib/CGI/FormBuilder/Util.pm  view on Meta::CPAN

Returns true if C<$el> is in C<@array>

=cut

sub ismember ($@) {
    # returns 1 if is in set, undef otherwise
    # do so case-insensitively
    my $test = lc shift;
    for (@_) {
        return 1 if $test eq lc $_;
    }
    return;
}

=head1 USELESS FUNCTIONS

These are totally useless outside of B<FormBuilder> internals.

=head2 autodata($ref)

This dereferences C<$ref> and returns the underlying data. For example:

    %hash  = autodata($hashref);
    @array = autodata($arrayref);

=cut

sub autodata ($) {
    # auto-derefs appropriately
    my $data = shift;
    return unless defined $data;
    if (my $ref = ref $data) {
        if ($ref eq 'ARRAY') {
            return wantarray ? @{$data} : $data;
        } elsif ($ref eq 'HASH') {
            return wantarray ? %{$data} : $data;
        } else {
            puke "Sorry, can't handle odd data ref '$ref' (only ARRAY or HASH)";
        }
    }
    return $data;   # return as-is
}

=head2 arghash(@_)

This returns a hash of options passed into a sub:

    sub field {
        my $self = shift;
        my %opt  = arghash(@_);
    }

It will return a hashref in scalar context.

=cut

sub arghash (;@) {
    return $_[0] if ref $_[0] && ! wantarray;

    belch "Odd number of arguments passed into ", (caller(1))[3]
       if @_ && @_ % 2 != 0;

    return wantarray ? @_ : { @_ };   # assume scalar hashref
}

=head2 arglist(@_)

This returns a list of args passed into a sub:

    sub value {
        my $self = shift;
        $self->{value} = arglist(@_);

It will return an arrayref in scalar context.

=cut

sub arglist (;@) {
    return $_[0] if ref $_[0] && ! wantarray;
    return wantarray ? @_ : [ @_ ];   # assume scalar arrayref
}

=head2 indent($num)

A simple sub that returns 4 spaces x C<$num>. Used to indent code.

=cut

sub indent (;$) {
    # return proper spaces to indent x 4 (code prettification)
    return '    ' x shift();
}

=head2 optalign(\@opt)

This returns the options specified as an array of arrayrefs, which
is what B<FormBuilder> expects internally.

=cut

sub optalign ($) {
    # This creates and returns the options needed based
    # on an $opt array/hash shifted in
    my $opt = shift;

    # "options" are the options for our select list
    my @opt = ();
    if (my $ref = ref $opt) {
        if ($ref eq 'CODE') {
            # exec to get options
            $opt = &$opt;
        }
        # we turn any data into ( ['key', 'val'], ['key', 'val'] )
        # have to check sub-data too, hence why this gets a little nasty
        @opt = ($ref eq 'HASH')
                  ? map { (ref $opt->{$_} eq 'ARRAY')
                            ? [$_, $opt->{$_}[0]] : [$_, $opt->{$_}] } keys %{$opt}
                  : map { (ref $_ eq 'HASH')  ? [ %{$_} ] : $_ } autodata $opt;
    } else {
        # this code should not be reached, but is here for safety