Revision 1522aeb7
Von Johannes Grassler vor etwa 1 Jahr hinzugefügt
| SL/XMLInvoice.pm | ||
|---|---|---|
| 1 | 1 |
package SL::XMLInvoice; |
| 2 | 2 |
|
| 3 |
use strict; |
|
| 4 |
use warnings; |
|
| 5 |
|
|
| 6 |
use XML::LibXML; |
|
| 7 |
|
|
| 8 |
use SL::XMLInvoice::UBL; |
|
| 9 |
use SL::XMLInvoice::CrossIndustryInvoice; |
|
| 10 |
|
|
| 11 |
use constant RES_OK => 0; |
|
| 12 |
use constant RES_XML_PARSING_FAILED => 1; |
|
| 13 |
use constant RES_UNKNOWN_ROOT_NODE_TYPE => 2; |
|
| 14 |
|
|
| 3 | 15 |
=head1 NAME |
| 4 | 16 |
|
| 5 | 17 |
SL::XMLInvoice - Top level factory class for XML Invoice parsers. |
| ... | ... | |
| 27 | 39 |
|
| 28 | 40 |
=cut |
| 29 | 41 |
|
| 30 |
use strict; |
|
| 31 |
use warnings; |
|
| 32 |
|
|
| 33 |
use XML::LibXML; |
|
| 34 |
|
|
| 35 | 42 |
=head1 ATTRIBUTES |
| 36 | 43 |
|
| 37 | 44 |
=over 4 |
| ... | ... | |
| 67 | 74 |
|
| 68 | 75 |
=cut |
| 69 | 76 |
|
| 70 |
use constant RES_OK => 0; |
|
| 71 |
use constant RES_XML_PARSING_FAILED => 1; |
|
| 72 |
use constant RES_UNKNOWN_ROOT_NODE_TYPE => 2; |
|
| 73 |
|
|
| 74 | 77 |
=head1 METHODS |
| 75 | 78 |
|
| 76 | 79 |
=head2 Data structure definition methods (only in C<SL::XMLInvoice>) |
| ... | ... | |
| 163 | 166 |
sub metadata {
|
| 164 | 167 |
my $self = shift; |
| 165 | 168 |
die "Children of $self must implement a metadata() method returning the bill's metadata as a hash."; |
| 166 |
}
|
|
| 169 |
} |
|
| 167 | 170 |
|
| 168 | 171 |
=item items() |
| 169 | 172 |
|
| ... | ... | |
| 178 | 181 |
sub items {
|
| 179 | 182 |
my $self = shift; |
| 180 | 183 |
die "Children of $self must implement a item() method returning the bill's items as a hash."; |
| 181 |
}
|
|
| 184 |
} |
|
| 182 | 185 |
|
| 183 | 186 |
=item parse_xml() |
| 184 | 187 |
|
| ... | ... | |
| 195 | 198 |
sub parse_xml {
|
| 196 | 199 |
my $self = shift; |
| 197 | 200 |
die "Children of $self must implement a parse_xml() method."; |
| 198 |
}
|
|
| 201 |
} |
|
| 199 | 202 |
|
| 200 | 203 |
=head2 Internal methods |
| 201 | 204 |
|
| ... | ... | |
| 213 | 216 |
|
| 214 | 217 |
=cut |
| 215 | 218 |
|
| 216 |
use SL::XMLInvoice::UBL; |
|
| 217 |
use SL::XMLInvoice::CrossIndustryInvoice; |
|
| 218 |
|
|
| 219 | 219 |
sub _document_nodenames {
|
| 220 | 220 |
return {
|
| 221 | 221 |
'rsm:CrossIndustryInvoice' => 'SL::XMLInvoice::CrossIndustryInvoice', |
| ... | ... | |
| 235 | 235 |
sub _data_keys {
|
| 236 | 236 |
my $self = shift; |
| 237 | 237 |
die "Children of $self must implement a _data_keys() method returning the keys an invoice item hash will contain."; |
| 238 |
}
|
|
| 238 |
} |
|
| 239 | 239 |
|
| 240 | 240 |
=item _item_keys() |
| 241 | 241 |
|
| ... | ... | |
| 253 | 253 |
sub _item_keys {
|
| 254 | 254 |
my $self = shift; |
| 255 | 255 |
die "Children of $self must implement a _item_keys() method returning the keys an invoice item hash will contain."; |
| 256 |
}
|
|
| 256 |
} |
|
| 257 | 257 |
|
| 258 | 258 |
|
| 259 |
sub new |
|
| 260 |
{
|
|
| 259 |
sub new {
|
|
| 261 | 260 |
my ($self, $xml_data) = @_; |
| 262 | 261 |
my $type = undef; |
| 263 | 262 |
$self = {};
|
| ... | ... | |
| 271 | 270 |
$self->{message} = $::locale->text("Parsing the XML data failed: $xml_data");
|
| 272 | 271 |
$self->{result} = RES_XML_PARSING_FAILED;
|
| 273 | 272 |
return $self; |
| 274 |
}
|
|
| 273 |
} |
|
| 275 | 274 |
|
| 276 | 275 |
# Determine parser class to use |
| 277 | 276 |
my $document_nodename = $self->{dom}->documentElement->nodeName;
|
| 278 | 277 |
if ( ${$self->_document_nodenames}{$document_nodename} ) {
|
| 279 | 278 |
$type = ${$self->_document_nodenames}{$document_nodename}
|
| 280 |
}
|
|
| 279 |
} |
|
| 281 | 280 |
|
| 282 | 281 |
unless ( $type ) {
|
| 283 | 282 |
$self->{result} = RES_UNKNOWN_ROOT_NODE_TYPE;
|
| ... | ... | |
| 286 | 285 |
$node_types, |
| 287 | 286 |
$document_nodename); |
| 288 | 287 |
return $self; |
| 289 |
}
|
|
| 288 |
} |
|
| 290 | 289 |
|
| 291 | 290 |
bless $self, $type; |
| 292 | 291 |
|
| 293 | 292 |
# Implementation sanity check for child classes: make sure they are aware of |
| 294 | 293 |
# the keys the hash returned by their metadata() method must contain. |
| 295 |
my @missing_data_keys = (); |
|
| 296 |
foreach my $data_key ( @{$self->data_keys} )
|
|
| 297 |
{
|
|
| 298 |
unless ( ${$self->_data_keys}{$data_key}) { push @missing_data_keys, $data_key; }
|
|
| 299 |
} |
|
| 294 |
my @missing_data_keys = grep { !${$self->_data_keys}{$data_key} } @{ $self->data_keys };
|
|
| 300 | 295 |
if ( scalar(@missing_data_keys) > 0 ) {
|
| 301 | 296 |
die "Incomplete implementation: the following metadata keys appear to be missing from $type: " . join(", ", @missing_data_keys);
|
| 302 | 297 |
} |
| ... | ... | |
| 304 | 299 |
# Implementation sanity check for child classes: make sure they are aware of |
| 305 | 300 |
# the keys the hashes returned by their items() method must contain. |
| 306 | 301 |
my @missing_item_keys = (); |
| 307 |
foreach my $item_key ( @{$self->item_keys} )
|
|
| 308 |
{
|
|
| 302 |
foreach my $item_key ( @{$self->item_keys} ) {
|
|
| 309 | 303 |
unless ( ${$self->_item_keys}{$item_key}) { push @missing_item_keys, $item_key; }
|
| 310 |
}
|
|
| 304 |
} |
|
| 311 | 305 |
if ( scalar(@missing_item_keys) > 0 ) {
|
| 312 | 306 |
die "Incomplete implementation: the following item keys appear to be missing from $type: " . join(", ", @missing_item_keys);
|
| 313 | 307 |
} |
| ... | ... | |
| 320 | 314 |
|
| 321 | 315 |
$self->{result} = RES_OK;
|
| 322 | 316 |
return $self; |
| 323 |
}
|
|
| 317 |
} |
|
| 324 | 318 |
|
| 325 | 319 |
1; |
| 326 | 320 |
|
Auch abrufbar als: Unified diff
Einrueckungen und weitere Stilprobleme repariert