blob: 9f5e9b6c173d69d92be3d6b99b722868b00d8e23 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
% foreach my $row ( @$rows ) {
%
% if (&{$beginrow}($row)){
<% &{$beginrow}($row) %>
% }
%
% foreach my $i ( 0 .. scalar( @{$opt{'fields'}} ) - 1 ) {
% my $field = $opt{'fields'}->[$i];
% my $value = '';
% if ( ref($field) eq 'CODE' ) {
% $value = &{$field}($row);
% $value = '(N/A)' #unimplemented
% if ref($value) eq 'ARRAY';
% } else {
% $value = $row->$field();
% }
%
<% &{$beginfield}($row, $i) %><% $value |h %><% &{$endfield}($row, $i) %>
%
% }
%
% if (&{$endrow}($row)) {
<% &{$endrow}($row) %>
% }
%
% }
<%init>
my %args = @_;
my $header = $args{'header'};
my $rows = $args{'rows'};
my %opt = %{ $args{'opt'} };
http_header('Content-Type' => 'application/XML' ); # So saith RFC 4180
http_header('Content-Disposition' =>
'attachment;filename="'.($opt{'name'} || PL($opt{'name_singular'}) ).'.xml"');
unless ( $opt{'fields'} ) {
foreach my $i ( 0 .. ( $#{ @$rows[0] } ) ) {
$opt{'fields'}->[$i] = sub { my $row = shift; $row->[$i]; };
}
}
my $beginrow = sub { return ''; };
my $endrow = sub { return ''; };
if ($opt{xml_row_element}) {
$beginrow = sub { my ($row, $index) = @_;
my $value;
if ( ref($opt{xml_row_element}) eq 'CODE' ) {
$value = &{$opt{xml_row_element}}($row);
} else {
$value = $opt{xml_row_element};
}
return "<$value>";
};
$endrow = sub { my ($row, $index) = @_;
my $value;
if ( ref($opt{xml_row_element}) eq 'CODE' ) {
$value = &{$opt{xml_row_element}}($row);
} else {
$value = $opt{xml_row_element};
}
return "</$value>";
};
}
my $beginfield = sub { my ($row, $index) = @_;
my $value;
if ( ref($opt{xml_elements}->[$index]) eq 'CODE' ) {
$value = &{$opt{xml_elements}->[$index]}($row);
} else {
$value = $opt{xml_elements}->[$index];
}
return "<$value>";
};
my $endfield = sub { my ($row, $index) = @_;
my $value;
if ( ref($opt{xml_elements}->[$index]) eq 'CODE' ) {
$value = &{$opt{xml_elements}->[$index]}($row);
} else {
$value = $opt{xml_elements}->[$index];
}
return "</$value>";
};
$beginfield = sub { return ''; } if $opt{no_field_elements}; #hmm
$endfield = sub { return ''; } if $opt{no_field_elements}; #hmm
</%init>
|
