File Coverage

blib/lib/CQL/PrefixNode.pm
Criterion Covered Total %
statement 33 33 100.0
branch 4 8 50.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 5 5 100.0
total 53 59 89.8


line stmt bran cond sub pod time code
1             package CQL::PrefixNode;
2              
3 8     8   2060 use strict;
  8         16  
  8         333  
4 8     8   39 use warnings;
  8         14  
  8         229  
5 8     8   49 use base qw( CQL::Node );
  8         15  
  8         1379  
6 8     8   14705 use CQL::Prefix;
  8         21  
  8         221  
7 8     8   45 use Carp qw( croak );
  8         16  
  8         4096  
8              
9             =head1 NAME
10              
11             CQL::PrefixNode - represents a prefix node in a CQL parse tree
12              
13             =head1 SYNOPSIS
14              
15             use CQL::PrefixNode;
16             my $prefix = CQL::PrefixNode->new(
17             name => '',
18             identifier => '',
19             subtree => $node
20             );
21              
22             =head1 DESCRIPTION
23              
24             =head1 METHODS
25              
26             =head2 new()
27              
28             Creates a new CQL::PrefixNode inducing a mapping from the
29             specified qualifier-set name to the specified identifier across
30             the specified subtree.
31              
32             =cut
33              
34             sub new {
35 2     2 1 30 my ($class,%opts) = @_;
36 2 50       10 croak( 'must supply name' ) if ! exists $opts{name};
37 2 50       12 croak( 'must supply identifier' ) if ! exists $opts{identifier};
38 2 50       72 croak( 'must supply subtree' ) if ! exists $opts{subtree};
39 2         19 my $prefix = CQL::Prefix->new(
40             name => $opts{name},
41             identifier => $opts{identifier}
42             );
43 2         9 my $self = {
44             prefix => $prefix,
45             subtree => $opts{subtree}
46             };
47 2   33     31 return bless $self, ref($class) || $class;
48             }
49              
50             =head2 getPrefix()
51              
52             =cut
53              
54             sub getPrefix {
55 4     4 1 627 return shift->{prefix};
56             }
57              
58             =head2 getSubtree()
59              
60             =cut
61              
62             sub getSubtree {
63 3     3 1 15 return shift->{subtree};
64             }
65              
66             =head2 toCQL()
67              
68             =cut
69              
70             sub toCQL {
71 2     2 1 923 my $self = shift;
72 2         9 my $prefix = $self->getPrefix();
73 2         10 my $subtree = $self->getSubtree();
74 2         11 return ">" . $prefix->getName() . '="' . $prefix->getIdentifier() . '" ' .
75             '(' . $subtree->toCQL() . ')';
76             }
77              
78             =head2 toXCQL()
79              
80             =cut
81              
82             sub toXCQL {
83 1     1 1 4 my ($self,$level,@prefixes) = @_;
84 1 50       4 $level = 0 if ! $level;
85 1         4 push( @prefixes, $self->getPrefix() );
86 1         7 my $xml = $self->getSubtree()->toXCQL( $level, @prefixes );
87 1         7 return $self->addNamespace( $level, $xml );
88             }
89              
90             1;