/usr/share/perl5/CQL/ModifierSet.pm is in libcql-parser-perl 1.10-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | package CQL::ModifierSet;
use strict;
use warnings;
use CQL::Utils qw( indent xq );
use Carp qw( croak );
=head1 NAME
CQL::ModifierSet - represents a base string and modifier strings
=head1 SYNOPSIS
=head1 DESCRIPTION
This class is used as a delegate by both CQLRelation and
CQLProxNode - two functionally very separate classes that happen to
require similar data structures and functionality.
A ModifierSet consists of a ``base'' string together with a set of
zero or more type=value pairs, where both type and value are strings.
Types may be null, values may not.
=head1 METHODS
=head2 new()
Creates a new modifier set with the specified base.
=cut
sub new {
my ($class,$base) = @_;
my $self = { base => $base, modifiers => [] };
return bless $self, ref($class) || $class;
}
=head2 getBase()
Returns the base string with which the modifier set was created.
=cut
sub getBase {
return shift->{base};
}
=head2 addModifier()
Adds a modifier of the specified type and value to a modifier set.
=cut
sub addModifier {
my ($self,$type,$value) = @_;
push( @{ $self->{modifiers} }, [ $type => $value ] );
}
=head2 modifier()
Returns a modifier with a given type, or null if a modifier of that
type isn't present.
=cut
sub modifier {
my ($self,$type) = @_;
foreach my $pair ( @{ $self->{modifiers} } ) {
if ( $pair->[0] eq $type ) { return $pair->[1]; }
}
return undef;
}
=head2 getModifiers()
Returns a list of modifiers each represented by a 2 element array ref.
=cut
sub getModifiers {
my $self = shift;
return @{ $self->{modifiers} };
}
=head2 toCQL()
=cut
sub toCQL {
my $self = shift;
my $cql = $self->{base};
foreach ( @{ $self->{modifiers} } ) {
$cql .= "/" . $_->[1];
}
return $cql;
}
=head2 toSwish()
=cut
sub toSwish {
my $self = shift;
croak( "Swish does not support relational modifiers" )
if @{ $self->{modifiers} } > 0;
my $base = $self->getBase();
return $base if $base eq "=" or $base eq "not";
croak( "Swish doesn't support relations other than = and not" );
}
=head2 toXCQL()
=cut
sub toXCQL {
my ($self, $level, $topLevelElement) = @_;
my $buffer =
indent($level).'<'.$topLevelElement.">\n".
indent($level+1)."<value>".xq($self->{base})."</value>\n";
my @modifiers = $self->getModifiers();
if ( @modifiers > 0 ) {
$buffer .= indent($level+1)."<modifiers>\n";
foreach my $m ( @modifiers ) {
$buffer .= indent($level+2)."<modifier>";
$buffer .= "<type>".xq($m->[0])."</type>" if $m->[0];
$buffer .= "<value>".xq($m->[1])."</value></modifier>\n"
}
$buffer .= indent($level+1)."</modifiers>\n";
}
$buffer .= indent($level).'</'.$topLevelElement.">\n";
return $buffer;
}
1;
|