Hide Show 19 lines of Pod
use
vars
qw($AUTOLOAD $VERSION @ISA @EXPORT)
;
@ISA
=
qw(Business::Payroll::Base Exporter AutoLoader)
;
@EXPORT
=
qw()
;
$VERSION
=
'.3'
;
Hide Show 8 lines of Pod
sub
new
{
my
$class
=
shift
;
my
$self
=
$class
->SUPER::new(
@_
);
my
%args
= (
@_
);
if
(
$self
->error)
{
$self
->prefixError();
return
$self
;
}
$self
->{periodDays} = {
annual
=> 260,
semiannual
=> 130,
quarterly
=> 65,
monthly
=> 21.67,
semimonthly
=> 10.84,
biweekly
=> 10,
weekly
=> 5,
daily
=> 1
};
$self
->{debug} =
'no'
;
$self
->{dataTables} = {
'20010701'
=> {
tables
=> {},
dailyWithholdingAllowance
=> 11.15,
dailyTableRows
=> [
{
singleBottom
=>
'0.0'
,
percent
=>
'0'
,
marriedBottom
=>
'0.00'
},
{
singleBottom
=>
'10.20'
,
percent
=>
'.15'
,
marriedBottom
=>
'24.80'
},
{
singleBottom
=>
'110.40'
,
percent
=>
'.27'
,
marriedBottom
=>
'191.90'
},
{
singleBottom
=>
'239.20'
,
percent
=>
'.30'
,
marriedBottom
=>
'404.60'
},
{
singleBottom
=>
'532.30'
,
percent
=>
'.35'
,
marriedBottom
=>
'658.50'
},
{
singleBottom
=>
'1150.00'
,
percent
=>
'.386'
,
marriedBottom
=>
'1161.70'
},
]
},
'20020101'
=> {
tables
=> {},
dailyWithholdingAllowance
=> 11.54,
dailyTableRows
=> [
{
singleBottom
=>
'0.0'
,
percent
=>
'0'
,
marriedBottom
=>
'0.00'
},
{
singleBottom
=>
'10.20'
,
percent
=>
'.10'
,
marriedBottom
=>
'24.80'
},
{
singleBottom
=>
'32.90'
,
percent
=>
'.15'
,
marriedBottom
=>
'71.00'
},
{
singleBottom
=>
'114.00'
,
percent
=>
'.27'
,
marriedBottom
=>
'198.30'
},
{
singleBottom
=>
'249.30'
,
percent
=>
'.30'
,
marriedBottom
=>
'421.90'
},
{
singleBottom
=>
'549.80'
,
percent
=>
'.35'
,
marriedBottom
=>
'680.00'
},
{
singleBottom
=>
'1187.50'
,
percent
=>
'.386'
,
marriedBottom
=>
'1199.60'
},
]
},
'20030101'
=> {
tables
=> {},
dailyWithholdingAllowance
=> 11.73,
dailyTableRows
=> [
{
singleBottom
=>
'0.0'
,
percent
=>
'0'
,
marriedBottom
=>
'0.00'
},
{
singleBottom
=>
'10.20'
,
percent
=>
'.10'
,
marriedBottom
=>
'24.80'
},
{
singleBottom
=>
'32.90'
,
percent
=>
'.15'
,
marriedBottom
=>
'71.00'
},
{
singleBottom
=>
'115.80'
,
percent
=>
'.27'
,
marriedBottom
=>
'201.30'
},
{
singleBottom
=>
'253.50'
,
percent
=>
'.30'
,
marriedBottom
=>
'430.00'
},
{
singleBottom
=>
'558.50'
,
percent
=>
'.35'
,
marriedBottom
=>
'690.80'
},
{
singleBottom
=>
'1206.30'
,
percent
=>
'.386'
,
marriedBottom
=>
'1218.70'
},
]
},
'20030601'
=> {
tables
=> {},
dailyWithholdingAllowance
=> 11.92,
dailyTableRows
=> [
{
singleBottom
=>
'0.0'
,
percent
=>
'0'
,
marriedBottom
=>
'0.00'
},
{
singleBottom
=>
'10.20'
,
percent
=>
'.10'
,
marriedBottom
=>
'30.80'
},
{
singleBottom
=>
'37.30'
,
percent
=>
'.15'
,
marriedBottom
=>
'85.80'
},
{
singleBottom
=>
'118.50'
,
percent
=>
'.25'
,
marriedBottom
=>
'249.00'
},
{
singleBottom
=>
'263.50'
,
percent
=>
'.28'
,
marriedBottom
=>
'454.00'
},
{
singleBottom
=>
'571.90'
,
percent
=>
'.33'
,
marriedBottom
=>
'713.70'
},
{
singleBottom
=>
'1235.40'
,
percent
=>
'.35'
,
marriedBottom
=>
'1254.20'
},
]
},
'20040101'
=> {
tables
=> {},
dailyWithholdingAllowance
=> 11.92,
dailyTableRows
=> [
{
singleBottom
=>
'0.0'
,
percent
=>
'0'
,
marriedBottom
=>
'0.00'
},
{
singleBottom
=>
'10.20'
,
percent
=>
'.10'
,
marriedBottom
=>
'30.80'
},
{
singleBottom
=>
'37.30'
,
percent
=>
'.15'
,
marriedBottom
=>
'85.80'
},
{
singleBottom
=>
'118.50'
,
percent
=>
'.25'
,
marriedBottom
=>
'249.00'
},
{
singleBottom
=>
'263.50'
,
percent
=>
'.28'
,
marriedBottom
=>
'454.00'
},
{
singleBottom
=>
'571.90'
,
percent
=>
'.33'
,
marriedBottom
=>
'713.70'
},
{
singleBottom
=>
'1235.40'
,
percent
=>
'.35'
,
marriedBottom
=>
'1254.20'
},
]
},
};
return
$self
;
}
Hide Show 16 lines of Pod
sub
isValidArg
{
my
$self
=
shift
;
my
%args
= (
@_
);
if
(
exists
$args
{gross} )
{
if
(
$args
{gross} !~ /^\d+(\.\d+)?$/)
{
return
0; }
else
{
return
1; }
}
if
(
exists
$args
{marital} )
{
if
(
$args
{marital} ne
"married"
&&
$args
{marital} ne
"single"
)
{
return
0; }
else
{
return
1; }
}
if
(
exists
$args
{date} )
{
if
(
$args
{date} !~ /^\d{8}$/ )
{
return
0; }
else
{
return
1; }
}
if
(
exists
$args
{allowances} )
{
if
(
$args
{allowances} !~ /^\d+$/ )
{
return
0; }
else
{
return
1; }
}
if
(
exists
$args
{round} )
{
if
(
$args
{round} =~ /^(yes)|(
no
)$/i )
{
return
1; }
else
{
return
0; }
}
if
(
exists
$args
{period} )
{
if
(
exists
$self
->{periodDays}->{
$args
{period}} )
{
return
1; }
else
{
return
0; }
}
return
0;
}
Hide Show 11 lines of Pod
sub
calculate
{
my
$self
=
shift
;
my
%args
= (
gross
=>
""
,
date
=>
""
,
method
=>
""
,
allowances
=>
""
,
period
=>
""
,
marital
=>
""
,
periodDays
=>
undef
,
round
=>
"yes"
,
debug
=>
'no'
,
@_
);
my
$gross
=
$args
{gross};
my
$date
=
$args
{date};
my
$method
=
$args
{method};
my
$allowances
=
$args
{allowances};
my
$period
=
$args
{period};
my
$marital
=
$args
{marital};
my
$periodDays
=
$self
->{periodDays};
my
$round
=
$args
{round};
my
$withholdingAllowance
= 0;
my
$modifiedGross
= 0;
my
$foundDate
=
undef
;
my
$tax
= 0;
my
$base
= 0;
my
$bottom
= 0;
my
$percent
= 0;
$self
->{debug} =
$args
{debug};
if
(!
$self
->isValidArg(
gross
=>
$gross
))
{
$self
->error(
"Invalid gross: $gross\n"
);
return
undef
; }
if
(!
$self
->isValidArg(
allowances
=>
$allowances
))
{
$self
->error(
"Invalid allowances: $allowances\n"
);
return
undef
; }
if
(!
$self
->isValidArg(
marital
=>
$marital
) )
{
$self
->error(
"Invalid marital: $marital\n"
);
return
undef
; }
if
(
$round
=~ /^(yes)$/i)
{
$round
=
"yes"
; }
elsif
(
$round
=~ /^(
no
)$/i)
{
$round
=
"no"
; }
else
{
$self
->error(
"Invalid round: $round. Use 'yes' or 'no'\n"
);
return
undef
; }
if
(!
$self
->isValidArg(
period
=>
$period
) )
{
$self
->error(
"Invalid period: '$period'"
);
return
undef
; }
if
(!
$self
->isValidArg(
date
=>
$date
))
{
$self
->error(
"Invalid date: '$date'"
);
return
undef
; }
else
{
$foundDate
=
$self
->lookupDate(
date
=>
$date
); }
if
(not
defined
$foundDate
)
{
$self
->error(
"Could not lookup date: $date\n"
);
return
undef
; }
$withholdingAllowance
=
$self
->{periodDays}->{
$period
} *
$self
->{dataTables}->{
$foundDate
}->{dailyWithholdingAllowance};
$modifiedGross
=
$gross
- (
$allowances
*
$withholdingAllowance
);
if
(!
exists
$self
->{dataTables}->{
$foundDate
}->{tables}->{
$period
} || !
exists
$self
->{dataTables}->{
$foundDate
}->{tables}->{
$period
}->{
$marital
} )
{
my
$result
=
$self
->generateTable(
period
=>
$period
,
marital
=>
$marital
,
date
=>
$foundDate
);
if
(not
defined
$result
||
$result
!= TRUE)
{
$self
->error(
"Could not generate Table"
);
return
undef
; }
}
if
(not
defined
$self
->{dataTables}->{
$foundDate
}->{tables}->{
$period
}->{
$marital
} )
{
$self
->error(
"Error: calculate -- table $period->$marital is not defined!\n"
);
return
undef
; }
my
$table
=
$self
->{dataTables}->{
$foundDate
}->{tables}->{
$period
}->{
$marital
};
if
(
$self
->{debug} eq
"yes"
)
{
print
"\nfound: $foundDate\n"
;
print
"withHAllow: $withholdingAllowance\n"
;
print
"Gross $gross\n"
;
print
"period $period\n"
;
print
"mGross: $modifiedGross\n"
;
print
"marital: $marital\n"
;
print
"rows "
;
print
scalar
@{
$table
};
print
"\n"
;
for
(
my
$row
= 0 ;
$row
<
scalar
@{
$table
} ;
$row
++)
{
print
"$row"
;
print
"\t t \t"
.
$table
->[
$row
]->{bottom};
print
"\t b \t"
.
$table
->[
$row
]->{base};
print
"\t p \t"
.
$table
->[
$row
]->{percent};
print
"\n"
;
}
print
"mGross = $modifiedGross\n\n"
;
}
for
(
my
$row
=
scalar
@{
$table
} -1;
$row
>= 0 ;
$row
--)
{
if
(
$modifiedGross
>=
$table
->[
$row
]->{bottom})
{
$base
=
$table
->[
$row
]->{base};
$bottom
=
$table
->[
$row
]->{bottom};
$percent
=
$table
->[
$row
]->{percent};
last
;
}
}
if
(
$self
->{debug} eq
"yes"
)
{
print
"b $base, p $percent, t $bottom\n"
;
}
$tax
= (
$base
+ ((
$modifiedGross
-
$bottom
) *
$percent
) );
$tax
*= -1
if
(
$tax
!~ /^(0(\.00)?)$/);
if
(
$round
eq
"no"
)
{
return
sprintf
(
"%.2f"
,
$tax
); }
return
sprintf
(
"%.0f"
,
$tax
) .
".00"
;
}
Hide Show 7 lines of Pod
sub
generateTable
{
my
$self
=
shift
;
my
%args
= (
period
=>
""
,
marital
=>
""
,
date
=>
""
,
debug
=>
'no'
,
@_
);
my
$base
= 0;
my
$foundDate
=
$args
{date};
my
$bottom
;
my
$period
=
$args
{period};
my
$marital
=
$args
{marital};
if
(
$args
{debug} eq
"yes"
)
{
$self
->{debug} =
"yes"
; }
if
(!
$self
->isValidArg(
date
=>
$foundDate
) )
{
$self
->error(
"generateTable: Invalid date '$foundDate'"
);
return
undef
; }
if
(!
$self
->isValidArg(
period
=>
$period
) )
{
$self
->error(
"generateTable: Invalid period '$period'"
);
return
undef
; }
my
@dailyTableRows
= @{
$self
->{dataTables}->{
$foundDate
}->{dailyTableRows}};
my
$table
=
$self
->{dataTables}->{
$foundDate
}->{tables};
if
(not
defined
$dailyTableRows
[0])
{
$self
->error(
"Error: dailyTableRows is invalid\n"
);
return
undef
; }
my
$row
;
for
(
$row
= 0;
$row
<
scalar
(
@dailyTableRows
);
$row
++)
{
$bottom
=
$dailyTableRows
[
$row
]->{
$marital
.
'Bottom'
} *
$self
->{periodDays}->{
$period
} ;
$bottom
=
sprintf
(
"%.0f"
,
$bottom
);
if
(
$row
== 0)
{
$base
= 0; }
else
{
$base
= ( (
$dailyTableRows
[
$row
-1]->{percent} *
(
$bottom
-
$table
->{
$period
}->{
$marital
}->[
$row
-1]->{bottom}) )
+
$table
->{
$period
}->{
$marital
}->[
$row
-1]->{base} ) ;
}
my
%tempRow
= (
bottom
=>
$bottom
,
base
=>
$base
,
percent
=>
$dailyTableRows
[
$row
]->{percent} ) ;
push
(@{
$table
->{
$period
}->{
$marital
}}, \
%tempRow
);
}
if
(
$self
->{debug} eq
"yes"
)
{
print
"dataTables->\{"
.
$foundDate
.
"\}->\{tables\}->\{"
.
$period
.
"\}->\{"
.
$marital
.
"} with $row rows\n"
;
}
return
TRUE;
}
Hide Show 6 lines of Pod
sub
lookupDate
{
my
$self
=
shift
;
my
$found
=
undef
;
my
%args
= (
date
=>
""
,
@_
);
if
(
$args
{date} !~ /^\d{8}$/)
{
$self
->error(
"Invalid format for date:'$args{date}' in lookupDate\n"
);
return
undef
; }
foreach
my
$current
(
reverse
sort
keys
%{
$self
->{dataTables}} )
{
if
(
$current
<=
$args
{date})
{
$found
=
$current
;
last
;
}
}
return
$found
;
}
Hide Show 7 lines of Pod
sub
firstDate
{
my
$self
=
shift
;
return
(
sort
keys
%{
$self
->{dataTables}})[0] ;
}
Hide Show 7 lines of Pod
sub
lastDate
{
my
$self
=
shift
;
return
(
reverse
sort
keys
%{
$self
->{dataTables}})[0] ;
}
Hide Show 4 lines of Pod
1;
Hide Show 17 lines of Pod