File Coverage

blib/lib/Pg/SQL/PrettyPrinter/Node/BoolExpr.pm
Criterion Covered Total %
statement 78 79 98.7
branch 13 16 81.2
condition n/a
subroutine 17 17 100.0
pod 3 3 100.0
total 111 115 96.5


line stmt bran cond sub pod time code
1             package Pg::SQL::PrettyPrinter::Node::BoolExpr;
2              
3             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
4 6     6   3974 use v5.26;
  6         21  
5 6     6   36 use strict;
  6         13  
  6         148  
6 6     6   37 use warnings;
  6         11  
  6         185  
7 6     6   35 use warnings qw( FATAL utf8 );
  6         15  
  6         212  
8 6     6   33 use utf8;
  6         15  
  6         32  
9 6     6   174 use open qw( :std :utf8 );
  6         13  
  6         31  
10 6     6   855 use Unicode::Normalize qw( NFC );
  6         15  
  6         365  
11 6     6   42 use Unicode::Collate;
  6         13  
  6         214  
12 6     6   45 use Encode qw( decode );
  6         14  
  6         435  
13              
14             if ( grep /\P{ASCII}/ => @ARGV ) {
15             @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV;
16             }
17              
18             # If there is __DATA__,then uncomment next line:
19             # binmode( DATA, ':encoding(UTF-8)' );
20             # UTF8 boilerplace, per http://stackoverflow.com/questions/6162484/why-does-modern-perl-avoid-utf-8-by-default/
21              
22             # Useful common code
23 6     6   1327 use autodie;
  6         18  
  6         44  
24 6     6   33895 use Carp qw( carp croak confess cluck );
  6         17  
  6         529  
25 6     6   43 use English qw( -no_match_vars );
  6         13  
  6         38  
26 6     6   2335 use Data::Dumper qw( Dumper );
  6         21  
  6         1338  
27              
28             # give a full stack dump on any untrapped exceptions
29             local $SIG{ __DIE__ } = sub {
30             confess "Uncaught exception: @_" unless $^S;
31             };
32              
33             # now promote run-time warnings into stackdumped exceptions
34             # *unless* we're in an try block, in which
35             # case just generate a clucking stackdump instead
36             local $SIG{ __WARN__ } = sub {
37             if ( $^S ) { cluck "Trapped warning: @_" }
38             else { confess "Deadly warning: @_" }
39             };
40              
41             # Useful common code
42              
43 6     6   67 use parent qw( Pg::SQL::PrettyPrinter::Node );
  6         13  
  6         60  
44              
45             sub new {
46 13     13 1 335 my $class = shift;
47 13         68 my $self = $class->SUPER::new( @_ );
48 13         34 bless $self, $class;
49              
50 13         68 $self->objectify( 'args' );
51              
52 13         34 return $self;
53             }
54              
55             sub as_text {
56 13     13 1 30 my $self = shift;
57 13         28 my $this_op = $self->{ 'boolop' };
58 13 50       84 $this_op =~ s/_EXPR\z// or croak( "Unknown boolean operation: ${this_op}!" );
59 13         30 my @nice_args;
60 13         23 for my $arg ( @{ $self->{ 'args' } } ) {
  13         41  
61 33         94 my $x = $arg->as_text;
62 33 100       115 if ( 'Pg::SQL::PrettyPrinter::Node::BoolExpr' eq ref $arg ) {
63 1         4 push @nice_args, "( ${x} )";
64             }
65             else {
66 32         83 push @nice_args, $x;
67             }
68             }
69              
70 13 100       42 if ( 1 == scalar @nice_args ) {
71 2         12 return sprintf "%s %s", $this_op, $nice_args[ 0 ];
72             }
73 11         62 return join( " ${this_op} ", @nice_args );
74             }
75              
76             sub pretty_print {
77 13     13 1 33 my $self = shift;
78 13         29 my $this_op = $self->{ 'boolop' };
79 13 50       76 $this_op =~ s/_EXPR\z// or croak( "Unknown boolean operation: ${this_op}!" );
80 13         32 my @nice_args;
81              
82 13         25 for my $arg ( @{ $self->{ 'args' } } ) {
  13         39  
83 33         97 my $x = $arg->pretty_print;
84 33 100       108 if ( 'Pg::SQL::PrettyPrinter::Node::BoolExpr' eq ref $arg ) {
85 1 50       4 if ( $x =~ m{\n} ) {
86 1         9 push @nice_args, join( "\n", "(", $self->increase_indent( $x ), ")" );
87             }
88             else {
89 0         0 push @nice_args, "( ${x} )";
90             }
91             }
92             else {
93 32         89 push @nice_args, $x;
94             }
95             }
96              
97 13 100       59 if ( 1 == scalar @nice_args ) {
98 2         11 return sprintf "%s %s", $this_op, $nice_args[ 0 ];
99             }
100 11         28 my $out = '';
101 11         43 for my $i ( 0 .. $#nice_args ) {
102 31         67 $out .= $nice_args[ $i ];
103 31 100       90 if ( $i < $#nice_args ) {
104 20         57 $out .= " ${this_op}\n";
105             }
106             }
107 11         53 return $out;
108             }
109              
110             1;