view release on metacpan or  search on metacpan

lib/App/Widget.pm  view on Meta::CPAN

    * Throws:    App::Exception::Widget
    * Since:     0.01

    Sample Usage:

    $name = $self->user_event_name("open","folder","1.1");
    $html .= "<input type='submit' name='$name' value='Push Me'>\n";

=cut

# Creates a name suitable for use in <input type=submit> and
# <input type=image> tags that will cause an event to be
# handled when the form is posted back to the web server.
# i.e.

sub user_event_name {
    &App::sub_entry if ($App::trace);
    my ($self, $event, @args) = @_;
    my ($name, $args);
    $name = $self->{name};
    $args = "";
    $args = "(" . join(",",@args) . ")" if ($#args > -1);
    my $result = "app.event.{${name}}.${event}${args}";
    &App::sub_exit($result) if ($App::trace);
    return($result);
}

#############################################################################
# callback_event_tag()
#############################################################################

=head2 callback_event_tag()

    * Signature: $text = $widget->callback_event_tag($event,@args);
    * Param:     void
    * Return:    $text              text
    * Throws:    App::Exception::Widget
    * Since:     0.01

    Sample Usage:

    $html .= $self->callback_event_tag("open","folder","1.1");

=cut

# Creates an <input type=hidden> tag that will cause an event to be
# automatically handled when the form is posted back to the web server.

sub callback_event_tag {
    &App::sub_entry if ($App::trace);
    my ($self, $event, @args) = @_;
    my ($name, $args);
    $name = $self->{name};
    $args = "";
    $args = "(" . join(",",@args) . ")" if ($#args > -1);
    my $result = "<input type=hidden name='app.event' value='${name}.${event}${args}'/>";
    &App::sub_exit($result) if ($App::trace);
    return($result);
}

# unescape URL-encoded data
sub url_unescape {
   my $self = shift;
   my($todecode) = @_;
   $todecode =~ tr/+/ /;       # pluses become spaces
   $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
   return $todecode;
}

# URL-encode data
sub url_escape {
   my $self = shift;
   my ($toencode,$charset) = @_;
   if ($charset) {
      $toencode=~s/($charset)/uc sprintf("%%%02x",ord($1))/eg;
   }
   else {
      $toencode=~s/([^a-zA-Z0-9_\-. ])/uc sprintf("%%%02x",ord($1))/eg;
      $toencode =~ tr/ /+/;       # spaces become pluses
   }
   return $toencode;
}

# HTML-escape data
sub html_escape {
    &App::sub_entry if ($App::trace);
    my ($self, $text) = @_;
    if (!defined $text) {
        $text = "";
    }
    elsif ($text) {
        $text =~ s{&}{&amp;}gso;
        $text =~ s{<}{&lt;}gso;
        $text =~ s{>}{&gt;}gso;
        $text =~ s{\"}{&quot;}gso;
        $text =~ s{\'}{&#039;}gso;   # support for single quote
    }
    &App::sub_exit($text) if ($App::trace);
    return $text;
}

sub html_attribs {
    my ($self) = @_;
    my $html_attribs = "";
    if ($self->{attrib}) {
        my $attrib_value = $self->{attrib};
        foreach my $attrib (keys %$attrib_value) {
            $html_attribs .= " $attrib=\"$attrib_value->{$attrib}\"";
        }
    }
    return($html_attribs);
}

sub get_theme_value {
    &App::sub_entry if ($App::trace);
    my ($self, $var, $default) = @_;

    my $theme_values = $self->{theme_values};
    if (!defined $theme_values) {
        my $context = $self->{context};
        my $theme = $self->{theme};
        if (!$theme) {
            $theme = $context->get_user_option("theme") || "default";
            $self->{theme} = $theme if ($theme);
        }

        my $theme_domain = $context->value_domain("theme.$theme",
            class => "App::ValueDomain::Repository",
            repository => "default",
            table => "value_domain",
            params => { name => "theme.$theme" },
            valuecolumn => "value",
            labelcolumn => "label");
        $theme_values = $theme_domain->labels();
        $self->{theme_values} = $theme_values;
    }
    my $name  = $self->{name};
    my $class = ref($self);
    my $value = $theme_values->{"$name.$var"};
    $value = $theme_values->{"$class.$var"} if (!defined $value);
    $value = $theme_values->{$var} if (!defined $value);
    $value = $default if (!defined $value && defined $default);

    &App::sub_exit($value) if ($App::trace);
    return($value);
}

sub html {
    my ($self) = @_;
    return $self->html_escape($self->{name});
}

# get the URL of the host
sub host_url {
   my ($url, $protocol, $server, $port, $port_str);

   $protocol = "http";                            # assume it's vanilla HTTP
   $protocol = "https" if (defined $ENV{HTTPS});  # this is how Apache does it

   $server = $ENV{SERVER_NAME};
   $server = "localhost" if (!$server);

   $port = $ENV{SERVER_PORT};
   $port = "80" if (!$port);

   $port_str = "";
   if ($protocol eq "http") {
      $port_str = ($port == 80) ? "" : ":$port";
   }
   elsif ($protocol eq "https") {
      $port_str = ($port == 443) ? "" : ":$port";
   }

   $url = "${protocol}://${server}${port_str}";
   $url;
}

sub format {
    &App::sub_entry if ($App::trace);
    my ($self, $value, $format_options, $values) = @_;

    if ($format_options->{relationship} eq "rank") {
        return $value; 
    }

    my $formatted_value = $value;

    if (! defined $formatted_value) {
        $formatted_value = " ";
    }
    else {
        if ($format_options->{scale_factor}) {
            $formatted_value *= $format_options->{scale_factor};
        }
        if ($format_options->{format}) {
            my $format = $format_options->{format};
            if ($format =~ /%-?[0-9\.]*[sdf]/) {  # just a sprintf() type format
                $formatted_value = sprintf($format, $formatted_value);
            }
            # This {format} style supports the following:
            #     #.#%          percentage. multiply by 100, 1 digit precision.
            #     +#.##%        percentage change. multiply by 100, 2 digit precision. add + sign at front if positive.
            #     #,###         integer. add commas as necessary.
            #     #,###.#       float. 1 digit precision. add commas as necessary.
            #     $#,###.##     currency. 2 digits precision. add commas as necessary.
            #     +$#,###.##    currency. 2 digits precision. add commas as necessary. add + sign at front if positive.
            #     ($#,###.##)   currency. 2 digits precision. add commas as necessary. negatives in parentheses.
            #     (#)           integer. negatives in parentheses.
            #     (#.###)       float. 3 digits precision. negatives in parentheses.
            #     #,### (/00)   integer. scaled up by 100 (i.e. the number of one-hundredths)