use
vars
qw ($AUTOLOAD
@ISA
@EXPORT
$VERSION
);
@ISA
=
qw(Exporter AutoLoader)
;
@EXPORT
=
qw()
;
$VERSION
=
"1.2"
;
sub
new
{
my
$that
=
shift
;
my
$class
=
ref
(
$that
) ||
$that
;
my
$self
=
bless
{},
$class
;
my
%args
= (
periodNames
=>
undef
,
@_
);
my
$errStr
=
"Business::Payroll::XML::OutData->new() - Error:"
;
$self
->{periodNames} =
$args
{periodNames};
if
(!
defined
$args
{periodNames})
{
die
"$errStr periodNames not defined!\n"
;
}
$self
->{version} =
"1.1"
;
$self
->{type} =
"cooked"
;
$self
->{dataFile} =
""
;
$self
->{date} =
""
;
$self
->{period} =
""
;
$self
->{startPeriod} =
""
;
$self
->{endPeriod} =
""
;
$self
->{genSysId} =
""
;
$self
->{persons} = [];
$self
->{errorCodes} = {
0
=>
"version = '%s' is invalid"
,
1
=>
"type = '%s' is invalid"
,
2
=>
"date must be specified"
,
3
=>
"date = '%s' is invalid"
,
4
=>
"period = '%s' is invalid"
,
5
=>
"no persons defined"
,
6
=>
"person: %s = '%s' is invalid"
,
7
=>
"person id='%s', %s does not exist"
,
8
=>
"person id='%s', %s='%s' is invalid"
,
9
=>
"person id='%s' duplicated!"
,
10
=>
"person id='%s', item name='%s' duplicated!"
,
11
=>
"genSysId = '%s' is invalid"
,
12
=>
"%s = '%s' is invalid"
,
};
return
$self
;
}
sub
AUTOLOAD
{
my
$self
=
shift
;
my
$type
=
ref
(
$self
) ||
die
"$self is not an object"
;
my
$name
=
$AUTOLOAD
;
$name
=~ s/.*://;
unless
(
exists
$self
->{
$name
})
{
die
"Can't access `$name' field in object of class $type"
;
}
if
(
@_
)
{
return
$self
->{
$name
} =
shift
;
}
else
{
return
$self
->{
$name
};
}
}
sub
DESTROY
{
my
$self
=
shift
;
}
sub
isValid
{
my
$self
=
shift
;
my
@errors
= ();
if
(
$self
->{version} !~ /^(1.1)$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{0},
$self
->{version});
}
if
(
$self
->{type} ne
"cooked"
)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{1},
$self
->{type});
}
if
(
length
$self
->{date} == 0)
{
push
@errors
,
$self
->{errorCodes}->{2};
}
elsif
(
$self
->{date} !~ /^(\d{8})$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{3},
$self
->{date});
}
if
(
length
$self
->{startPeriod} == 0)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{12},
"startPeriod"
,
$self
->{startPeriod});
}
elsif
(
$self
->{startPeriod} !~ /^(\d{8})$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{12},
"startPeriod"
,
$self
->{startPeriod});
}
if
(
length
$self
->{endPeriod} == 0)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{12},
"endPeriod"
,
$self
->{endPeriod});
}
elsif
(
$self
->{endPeriod} !~ /^(\d{8})$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{12},
"endPeriod"
,
$self
->{endPeriod});
}
if
(!
exists
$self
->{periodNames}->{
$self
->{period}})
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{4},
$self
->{period});
}
if
(
length
$self
->{genSysId} == 0)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{11},
$self
->{genSysId});
}
if
(
scalar
@{
$self
->{persons}} == 0)
{
push
@errors
,
$self
->{errorCodes}->{5};
}
else
{
my
%encounteredPersons
= ();
foreach
my
$person
(@{
$self
->{persons}})
{
if
(
$person
->{id} !~ /^.+$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{6},
'id'
,
$person
->{id});
}
if
(
length
$person
->{name} == 0)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{6},
'name'
,
$person
->{name});
}
my
%encounteredItems
= ();
foreach
my
$item
(@{
$person
->{items}})
{
if
(!
exists
$item
->{name})
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{7},
$person
->{id},
'name'
);
}
elsif
(
$item
->{name} !~ /^(.+)$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{8},
$person
->{id},
'name'
,
$item
->{name});
}
if
(!
exists
$item
->{value})
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{7},
$person
->{id},
'value'
);
}
elsif
(
$item
->{value} !~ /^(-?\d+(\.\d+)?)$/)
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{8},
$person
->{id},
'value'
,
$item
->{value});
}
if
(!
exists
$item
->{comment})
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{7},
$person
->{id},
'comment'
);
}
}
if
(
exists
$encounteredPersons
{
$person
->{id}})
{
push
@errors
,
sprintf
(
$self
->{errorCodes}->{9},
$person
->{id});
}
else
{
$encounteredPersons
{
$person
->{id}} = 1;
}
}
}
return
((
scalar
@errors
> 0 ? 0 : 1), \
@errors
);
}
sub
generateXML
{
my
$self
=
shift
;
my
$result
=
""
;
my
$errStr
=
"Business::Payroll::XML::OutData->generateXML() - Error:"
;
my
@valid
=
$self
->isValid();
if
(
$valid
[0])
{
$result
.=
<<"END_OF_XML";
<?xml version="1.0" encoding="ISO-8859-1"?>
<payroll type="cooked" version="$self->{version}" date="$self->{date}" period="$self->{period}" genSysId="$self->{genSysId}" startPeriod="$self->{startPeriod}" endPeriod="$self->{endPeriod}">
END_OF_XML
for
(
my
$i
=0;
$i
<
scalar
@{
$self
->{persons}};
$i
++)
{
$result
.=
" <person id=\"$self->{persons}[$i]->{id}\" name=\"$self->{persons}[$i]->{name}\">\n"
;
foreach
my
$item
(@{
$self
->{persons}[
$i
]->{items}})
{
my
$tmpName
=
$self
->encodeEntities(
string
=>
$item
->{name});
my
$tmpComment
=
$self
->encodeEntities(
string
=>
$item
->{comment});
$result
.=
" <item name=\"$tmpName\" value=\"$item->{value}\""
. (
$item
->{comment} ?
" comment=\"$tmpComment\""
:
""
) .
"/>\n"
;
}
$result
.=
" </person>\n"
;
}
$result
.=
<<"END_OF_XML";
</payroll>
END_OF_XML
}
else
{
$result
.=
"$errStr Data not valid!\n\n"
;
$result
.=
join
(
"\n"
, @{
$valid
[1]}) .
"\n"
;
die
$result
;
}
return
$result
;
}
sub
encodeEntities
{
my
$self
=
shift
;
my
%args
= (
string
=>
""
,
@_
);
my
$string
=
$args
{string};
my
@entities
= (
'&'
,
'"'
,
'<'
,
'>'
,
'\n'
);
my
%entities
= (
'&'
=>
'&'
,
'"'
=>
'"'
,
'<'
=>
'<'
,
'>'
=>
'>'
,
'\n'
=>
'\\n'
);
return
$string
if
(
length
$string
== 0);
foreach
my
$entity
(
@entities
)
{
$string
=~ s/
$entity
/
$entities
{
$entity
}/g;
}
return
$string
;
}
1;