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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
# base class.
package Driver::Sablotron;
use strict;
use warnings;
use Driver::BaseClass;
our @ISA = qw(Driver::BaseClass);
use XML::Sablotron;
use IO::File;
use vars qw(
$xslt
$stylesheet
$input
$handler
);
sub init {
my %options = @_;
$xslt = XML::Sablotron->new();
$handler = Driver::Sablotron::Handler->new(%options);
$xslt->RegHandler(0, $handler);
}
sub shutdown {
$xslt->ClearError();
$xslt->UnregHandler(0, $handler);
undef $handler;
undef $xslt;
undef $input;
undef $stylesheet;
}
sub load_stylesheet {
my ($filename) = @_;
my $fh = new IO::File;
if ($fh->open("< $filename")) {
local $/;
$stylesheet = <$fh>;
$fh->close;
}
}
sub load_input {
my ($filename) = @_;
my $fh = new IO::File;
if ($fh->open("< $filename")) {
local $/;
$input = <$fh>;
$fh->close;
}
}
use Cwd;
sub run_transform {
my ($output) = @_;
$handler->{show_error} = 1;
open(OUT, ">$output")
|| die "Can't write $output : $!";
my $result = '';
my $args = ['template', "$stylesheet", 'xml_resource', "$input"];
my $retcode = $xslt->RunProcessor("arg:/template", "arg:/xml_resource", "arg:/result", [], $args);
$result = $xslt->GetResultArg("result");
print OUT $result;
close OUT;
}
package Driver::Sablotron::Handler;
sub new {
my $class = shift;
my %options = @_;
bless \%options, $class;
}
sub MHMakeCode {
my $self = shift;
my $processor = shift;
my ($severity, $facility, $code) = @_;
return $code;
}
sub MHLog {
return 1;
}
sub MHError {
my $self = shift;
my $processor = shift;
my ($code, $level, @fields) = @_;
return unless $self->{show_error};
$self->{show_error} = 0;
warn "Sablotron [Error]: ", join(' :: ', @fields), "\n" if $self->{verbose};
return 1;
}
1;
|
