File Coverage

blib/lib/Data/MaskPrint.pm

Criterion	Covered	Total	%
statement	157	173	90.7
branch	81	96	84.3
condition	43	60	71.6
subroutine	6	6	100.0
pod	2	2	100.0
total	289	337	85.7

#!/usr/local/bin/perl -wc

package Data::MaskPrint;
use vars qw($myself @ISA $VERSION);
$VERSION = "1.0";
use Exporter();
@ISA = qw(Exporter);


use strict;
use Carp;

sub new ()
{
	my $class = shift;
	my $self=[];
	bless $self, $class;
}

sub num_mask_print($$$)
{
	my $this = shift;
	my $data = shift;
	my $mask = shift;


	#defines follow
	my $PAREN  = 0;
	my $PLUS   = 0;
	my $MINUS  = 0;
	my $DOLLAR = 0;
	my $DECIMAL= 0;
	my $NEGATIVE = 0;
	my $SUPRESS_LEAD_SPACE = 0;


	my @fmt_pic;

	$DOLLAR = 1 if ($mask =~ /\$/);
	$MINUS = 1 if (($mask =~ /-/) || ($mask =~ /\+/));
	$PLUS = 1 if ($mask =~ /\+/);

	if ($mask =~ /
	{
		$mask =~ s/
		$SUPRESS_LEAD_SPACE = 1;
	}

	if ($mask =~ /\..*\./)
	{
		croak "Only one decimal point is permitted in the mask (Picture)";
	}
	elsif ($mask =~ /\./)
	{
		$DECIMAL = 1;
	}

	if ($mask =~ /\).*\)/)
	{
		croak "Only one ) is permitted in the mask (Picture)";
	}
	elsif ($mask =~ /\)/)
	{
		$PAREN = 1;
	}

	if ((($mask =~ /\(/) && !$PAREN) || ($PAREN && !($mask =~ /\(/)))
	{
		croak "Parenthesis does not match in the mask (Picture)";
	}

	if (($PAREN) && ($MINUS || $PLUS))
	{
		croak "Mask (Picture) formatted incorrectly cannot have both parenthesis and -/+ sign";
	}


	if ($data >= 0)
	{
		if ($PAREN)
		{
			$mask =~ s/\)//g;
			$mask = '#' . $mask;
			$mask =~ s/\(/\#/g;
			$SUPRESS_LEAD_SPACE = 1;
		}
		$mask =~ s/-/\#/g;
	}
	else
	{
		$NEGATIVE = 1;
		if ($PLUS)
		{
			$mask =~ s/\+/-/g;
		}
		$data =~ s/-//;
	}

	if (!$DECIMAL)
	{
		$data =~ s/\..*$//;
	}

	#preparing mask array
	for(my $i = 0; $i < length($mask); $i++)
	{
		$fmt_pic[$i] = substr($mask, $i, 1);
	}

	#checking if the data will fit into the space provided by the mask
	my @arr = split(/\./, $data);
	my @arr2 = split(/\./, $mask);
	$arr2[0] =~ s/,//g;
	my $count = length($arr2[0]);
	$count-- if ($PAREN || $MINUS || $PLUS);
	$count-- if ($DOLLAR);
	return '*' x length($mask) if (length($arr[0]) > $count);


	#processing right side of the mask
	my $DECIMAL_POS_MASK = length($mask);
	my $DECIMAL_POS_DATA = length($data);
	if ($DECIMAL)
	{
		$DECIMAL_POS_MASK = index($mask, '.');
		if ($data =~ /\./)
		{
			$DECIMAL_POS_DATA = index($data, '.');
		}
		else
		{
			$DECIMAL_POS_DATA = length($data);
		}
		for(my $i = $DECIMAL_POS_MASK, my $j = $DECIMAL_POS_DATA;
		    $i < scalar(@fmt_pic);
			$i++)
		{
			my $num = undef;
			if ($j < length($data))
			{
				$num = substr($data, $j, 1);
				$j++;
			}

			while(($fmt_pic[$i] eq ')') || ($fmt_pic[$i] eq ','))
			{
				$i++;
			}
			last if !defined($fmt_pic[$i]);

			foreach ($fmt_pic[$i])
			{
				/\*/ && do
					{
						if (defined($num))
						{
							$fmt_pic[$i] = $num;
						}
						else
						{
							$fmt_pic[$i] = '*';
						}
					};
				/\$|#|-|\&/ && do
					{
						if (defined($num))
						{
							$fmt_pic[$i] = $num;
						}
						else
						{
							$fmt_pic[$i] = 0;
						}
					};
			}
		}
	}

	#Processing left side of mask here(side to re left of .)
	#Right side should already be processed if there is no right side
	#just process the rest of mask
	my $i;
	for($i = $DECIMAL_POS_MASK - 1, my $j = $DECIMAL_POS_DATA - 1;
		$j >= 0 ;
		$j--, $i--)
	{
			my $num = substr($data, $j, 1);

			while(($fmt_pic[$i] eq ')') || ($fmt_pic[$i] eq ','))
			{
				$i--;
			}
			last if ($i < 0);

			if (($fmt_pic[$i] eq '$') ||
			    ($fmt_pic[$i] eq '('))
			{
				for(my $k = $i - 1; $k >= 0; $k--)
				{
					next if ($fmt_pic[$k] eq ',');
					$fmt_pic[$k] = $fmt_pic[$i];
					last;
				}
			}
			$fmt_pic[$i] = $num;
	}

	#Processing leftover string afetr all numbers have been processed
	my $HAD_DOLLAR = 0;
	my $HAD_SIGN   = 0;
	my $HAD_PAREN  = 0;
	my $HAD_STAR   = 0;

	for( ; $i >= 0; $i--)
	{
		foreach ($fmt_pic[$i])
		{
			if (($NEGATIVE) && !($HAD_SIGN) && !($PAREN) && !($MINUS))
			{
				$fmt_pic[$i] = '-';
				$HAD_SIGN = 1;
				next;
			}
			/\*/ && do
				{
					#Let it be
				};
			/\,/ && do
				{
					if ($i > 0)
					{
						$fmt_pic[$i] = $fmt_pic[$i - 1];
						$i++;
						next;
					}
					elsif ($fmt_pic[$i + 1] =~ /[0-9]/)
					{
						$fmt_pic[$i] = ' ';
					}
					else
					{
						$fmt_pic[$i] = $fmt_pic[$i + 1];
						$i++;
						next;
					}
				};
			/\&/ && do
				{
					$fmt_pic[$i] = 0;
				};
			/\$/ && do
				{
					if ($HAD_DOLLAR)
					{
						if ($i > 0)
						{
							my $symbol = '#';
							for(my $k = $i - 1; $k >= 0; $k--)
							{
								if (($fmt_pic[$k] eq '$') ||
								    ($fmt_pic[$k] eq ',') ||
									($fmt_pic[$k] eq '('))
								{
									next;
								}
								else
								{
									$symbol = $fmt_pic[$k];
									last;
								}
							}
							$fmt_pic[$i] = $symbol;
							#This is to reprocess this symbol again
							$i++;
							next;
						}
						else
						{
							$fmt_pic[$i] = ' ';
						}
					}
					else
					{
						$HAD_DOLLAR = 1;
						$fmt_pic[$i] = '$';
					}
				};
			/\#/ && do
				{
					$fmt_pic[$i] = ' ';
				};
			/\(/ && do
				{
					if ($HAD_PAREN)
					{
						$SUPRESS_LEAD_SPACE = 1;
						if ($i > 0)
						{
							my $symbol = '#';
							for(my $k = $i - 1; $k >= 0; $k--)
							{
								if (($fmt_pic[$k] eq '(') ||
								    ($fmt_pic[$k] eq ',') ||
									($fmt_pic[$k] eq '$'))
								{
									next;
								}
								else
								{
									$symbol = $fmt_pic[$k];
									last;
								}
							}
							$fmt_pic[$i] = $symbol;
							#This is to reprocess this symbol again
							$i++;
							next;
						}
						else
						{
							$fmt_pic[$i] = ' ';
						}
					}
					else
					{
						$HAD_PAREN = 1;
						$fmt_pic[$i] = '(';
					}
				};
			/-|\+/ && do
				{
					if ($HAD_SIGN)
					{
						if ($i > 0)
						{
							my $symbol = '#';
							for(my $k = $i - 1; $k >= 0; $k--)
							{
								if (($fmt_pic[$k] eq $_) ||
								    ($fmt_pic[$k] eq ',') ||
									($fmt_pic[$k] eq '$'))
								{
									next;
								}
								else
								{
									$symbol = $fmt_pic[$k];
									last;
								}
							}
							$fmt_pic[$i] = $symbol;
							#This is to reprocess this symbol again
							$i++;
							next;
						}
						else
						{
							$fmt_pic[$i] = ' ';
						}
					}
					else
					{
						$HAD_SIGN = 1;
						$fmt_pic[$i] = $_;
					}
				};
		}
	}

	my $pic = join("", @fmt_pic);
	$pic =~ s/^\s+// if ($SUPRESS_LEAD_SPACE);
	return $pic;
}

1;
__END__;