view release on metacpan or  search on metacpan

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

    $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)
            #     #,### (000)   integer. scaled down by 1000 (i.e. the number of thousands)
            #     #,### (K)     integer. scaled down by 1,000 (i.e. the number of thousands)
            #     #,### (M)     integer. scaled down by 1,000,000 (i.e. the number of millions)
            elsif ($format =~ /^(\(?)(\+?)(\$?)([#,]*)\.?(#*)(%?)[\)]*\s*(?:\((\/?)([^\(\)]+)\))?$/) {
                my %scale_abbr = ( K => "000", M => "000000", G => "000000000", );
                my $paren      = $1;
                my $sign       = $2;
                my $curr       = $3;
                my $int        = $4;
                my $frac       = $5;
                my $pct        = $6;
                my $scale_up   = $7;
                my $scale      = $8;
                if ($scale ne "") {
                    if (defined $scale_abbr{$scale}) {
                        $scale = $scale_abbr{$scale};
                    }
                    if ($scale =~ /^0+$/) {
                        $scale = "1$scale";
                        if ($scale_up) {
                            $formatted_value *= $scale;
                        }
                        else {
                            $formatted_value /= $scale;
                        }
                    }
                }
                my $negated = (($paren || $sign) && $value < 0);
                if ($negated) {
                    $formatted_value = -$formatted_value;
                }
                $formatted_value *= 100 if ($pct);  # an implied scale_factor of 100
                my $precision = length($frac);
                if ($precision > 0) {
                    $formatted_value = sprintf("%.${precision}f", $formatted_value);
                    if ($int =~ /,/) {
                        $formatted_value =~ s/([0-9])([0-9][0-9][0-9])\./$1,$2./;
                        while ($formatted_value =~ s/([0-9])([0-9][0-9][0-9]),/$1,$2,/) {
                            # keep doing it until it's not found
                        }
                    }
                }
                else {
                    $formatted_value = int($formatted_value);
                    if ($int =~ /,/) {
                        $formatted_value =~ s/([0-9])([0-9][0-9][0-9])$/$1,$2/;
                        while ($formatted_value =~ s/([0-9])([0-9][0-9][0-9]),/$1,$2,/) {
                            # keep doing it until it's not found
                        }
                    }
                }
                if ($curr) {