File Coverage

blib/lib/SQL/Template/XMLBuilder.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package SQL::Template::XMLBuilder;
2              
3 2     2   13 use strict;
  2         4  
  2         74  
4 2     2   956 use XML::Parser;
  0            
  0            
5             use SQL::Template::Command;
6              
7              
8              
9             sub new {
10             my ($class) = @_;
11             return bless { }, $class;
12             }
13              
14              
15             sub parse_file {
16             my $self = shift;
17             my $filename = shift;
18             my $p = XML::Parser->new(Style=>'Stream', Pkg=>'SQL::Template::XMLParser');
19             $p->parsefile($filename);
20             $self->_compile_commands;
21             ##$SQL::Template::XMLParser::SQL_COMMAND->dump;
22             }
23              
24             sub parse_string {
25             my $self = shift;
26             my $string = shift;
27             my $p = XML::Parser->new(Style=>'Stream', Pkg=>'SQL::Template::XMLParser');
28             $p->parse($string);
29             $self->_compile_commands;
30             ##$SQL::Template::XMLParser::SQL_COMMAND->dump;
31             }
32              
33             sub _compile_commands {
34             my $self = shift;
35             my @commands = $SQL::Template::XMLParser::SQL_COMMAND->get_commands;
36             foreach my $command(@commands) {
37             $self->{COMMANDS}->{lc($command->name)} = $command;
38             }
39             }
40              
41             sub get_commands {
42             my $self = shift;
43             return $self->{COMMANDS};
44             }
45              
46             sub get_command {
47             my $self = shift;
48             my $name = shift;
49             return $self->{COMMANDS}->{lc($name)};
50             }
51              
52             #******************************************************************************
53             package SQL::Template::XMLParser;
54              
55             our $SQL_COMMAND = undef;
56             my $CURRENT_COMMAND;
57             my $LAST_COMMAND;
58              
59             sub trim {
60             $_[0] =~ s!^\s+!!;
61             $_[0] =~ s!\s+$!!;
62             return $_[0];
63             }
64              
65             sub set_current_command {
66             my $command = shift;
67             ##print "set current command: ", ref($command), "\n";
68             $CURRENT_COMMAND = $command;
69             }
70              
71             sub set_last_command {
72             my $command = shift;
73             $LAST_COMMAND = $command;
74             }
75              
76             sub StartTag {
77             my $parser = shift;
78             my $name = trim(shift);
79             my $command = SQL::Template::Command::new_from({
80             XMLTYPE => $name,
81             PARENT => $CURRENT_COMMAND,
82             PREVIOUS => $LAST_COMMAND,
83             CONTAINER => $SQL_COMMAND,
84             PARAMS => \%_
85             });
86            
87             if( eval { $command->isa('SQL::Template::Command::Sql')} ) {
88             $SQL_COMMAND = $command;
89             }
90            
91             ##print "start tag: ", Data::Dump::dump(%_), "\n";
92             ##print "last command: ", ref($LAST_COMMAND), "\n";
93            
94             set_current_command $command;
95             set_last_command $command;
96             }
97              
98             sub EndTag {
99             my $parser = shift;
100             my $name = shift;
101             ##print "END TAG: $name\n";
102             my $parent = $CURRENT_COMMAND->parent;
103             set_current_command $parent;
104             }
105              
106             sub Text {
107             my $parser = $_[0];
108             my $text = trim($_);
109             if( $text ) {
110             $CURRENT_COMMAND->add_command( SQL::Template::Command::Text->new({TEXT=>$text}) );
111             }
112             }
113              
114              
115             1;