view release on metacpan or  search on metacpan

lib/DBI/Shell/SQLMinus.pm  view on Meta::CPAN

#  
#  
# 
# The MI and PR format elements can only appear in the last position of
# a number format model. The S format element can only appear in the
# first or last position.
# 
# If a number format model does not contain the MI, S or PR format
# elements, negative return values automatically contain a leading
# negative sign and positive values automatically contain a
# leading space.
# 
# A number format model can contain only a single decimal character (D)
# or period (.), but it can contain multiple group separators (G) or
# commas (,). A group separator or comma cannot appear to the right of a
# decimal character or period in a number format model.
# 
# SQL*Plus formats NUMBER data right-justified. A NUMBER column's width
# equals the width of the heading or the width of the FORMAT plus one
# space for the sign, whichever is greater. If you do not explicitly use
# FORMAT, then the column's width will always be at least the value of
# SET NUMWIDTH.
# 
# SQL*Plus may round your NUMBER data to fit your format or field width.
# 
# If a value cannot fit within the column width, SQL*Plus indicates
# overflow by displaying a pound sign (#) in place of each digit the
# width allows.
# 
# If a positive value is extremely large and a numeric overflow occurs
# when rounding a number, then the infinity sign (~) replaces the value.
# Likewise, if a negative value is extremely small and a numeric
# overflow occurs when rounding a number, then the negative infinity
# sign replaces the value (-~).

# Commify used from the Perl CookBook
sub commify($) {
        my $num = reverse $_[0];
		$num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
        return scalar reverse $num;
}

sub dollarsign($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
        my $formatted = sprintf "\$%${fmtnum}.${dlen}lf", $num;
        return ($commify ? commify($formatted) : $formatted);
}

sub zerofill($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
        my $formatted = sprintf "%0${fmtnum}.${dlen}lf", $num;
        return ($commify ? commify($formatted) : $formatted);
}

sub signednum($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
        my $formatted = sprintf "%+${fmtnum}.${dlen}lf", $num;
        return ($commify ? commify($formatted) : $formatted);
}

sub leadsign($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
        my $formatted = sprintf "%+${fmtnum}.${dlen}lf", $num;
        return ($commify ? commify($formatted) : $formatted);
}

sub trailsign($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
		$dlen--;
        my $formatted = sprintf "%${fmtnum}.${dlen}lf", abs($num);
		$formatted .= ($num > 0 ? '+' : '-');
        return ($commify ? commify($formatted) : $formatted);
}

sub ltgtsign($$$$) {
        my ($num, $fmtnum, $dlen, $commify) = @_;
		$dlen--;
        my $formatted = sprintf "%s%${fmtnum}.${dlen}lf%s" 
			,($num > 0 ? '' : '<')
			,abs($num),
			,($num > 0 ? '' : '>');
        return ($commify ? commify($formatted) : $formatted);
}

#
# Private methods.
#

sub _me {
        my $pi   = shift;
        my $self = shift;
        return ${$self}->print_buffer("show me what???")
                unless @_;
        return ${$self}->do_show(@_);
}

sub _all {
        my $pi = shift;
        my $self = shift;
        return ${$self}->print_buffer("show all of what???")
                unless @_;
        return ${$self}->do_show(@_);
}

sub _show_all_commands {
        my $pi = shift;
        my $self = shift;
return
        ${$self}->print_buffer("Show supports the following commands:\n\t" .
                join( "\n\t", keys %{$pi->{show}}));
}

sub _unimp {
        my $pi = shift;
        my $self = shift;
        return ${$self}->print_buffer("unimplemented");
}

sub _obsolete {
        my $pi = shift;
        my $self = shift;