lib/Perl/Tidy/IndentationItem.pm

   1 #####################################################################
   2 #
   3 # the Perl::Tidy::IndentationItem class supplies items which contain
   4 # how much whitespace should be used at the start of a line
   5 #
   6 #####################################################################
   7
   8 package Perl::Tidy::IndentationItem;
   9 use strict;
  10 use warnings;
  11 our $VERSION = '20220217';
  12
  13 BEGIN {
  14
  15     # Array index names
  16     # Do not combine with other BEGIN blocks (c101).
  17     my $i = 0;
  18     use constant {
  19         _spaces_             => $i++,
  20         _level_              => $i++,
  21         _ci_level_           => $i++,
  22         _available_spaces_   => $i++,
  23         _closed_             => $i++,
  24         _comma_count_        => $i++,
  25         _lp_item_index_      => $i++,
  26         _have_child_         => $i++,
  27         _recoverable_spaces_ => $i++,
  28         _align_seqno_        => $i++,
  29         _marked_             => $i++,
  30         _stack_depth_        => $i++,
  31         _K_begin_line_       => $i++,
  32         _arrow_count_        => $i++,
  33     };
  34 }
  35
  36 sub AUTOLOAD {
  37
  38     # Catch any undefined sub calls so that we are sure to get
  39     # some diagnostic information.  This sub should never be called
  40     # except for a programming error.
  41     our $AUTOLOAD;
  42     return if ( $AUTOLOAD =~ /\bDESTROY$/ );
  43     my ( $pkg, $fname, $lno ) = caller();
  44     my $my_package = __PACKAGE__;
  45     print STDERR <<EOM;
  46 ======================================================================
  47 Error detected in package '$my_package', version $VERSION
  48 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
  49 Called from package: '$pkg'
  50 Called from File '$fname'  at line '$lno'
  51 This error is probably due to a recent programming change
  52 ======================================================================
  53 EOM
  54     exit 1;
  55 }
  56
  57 sub DESTROY {
  58
  59     # required to avoid call to AUTOLOAD in some versions of perl
  60 }
  61
  62 sub new {
  63
  64     # Create an 'indentation_item' which describes one level of leading
  65     # whitespace when the '-lp' indentation is used.
  66     my ( $class, %input_hash ) = @_;
  67
  68     # DEFINITIONS:
  69     # spaces             =>  # total leading white spaces
  70     # level              =>  # the indentation 'level'
  71     # ci_level           =>  # the 'continuation level'
  72     # available_spaces   =>  # how many left spaces available
  73     #                        # for this level
  74     # closed             =>  # index where we saw closing '}'
  75     # comma_count        =>  # how many commas at this level?
  76     # lp_item_index     =>  # index in output batch list
  77     # have_child         =>  # any dependents?
  78     # recoverable_spaces =>  # how many spaces to the right
  79     #                        # we would like to move to get
  80     #                        # alignment (negative if left)
  81     # align_seqno        =>  # if we are aligning with an opening structure,
  82     #                        # this is its seqno
  83     # marked             =>  # if visited by corrector logic
  84     # stack_depth        =>  # indentation nesting depth
  85     # K_begin_line   =>  # first token index K of this level
  86     # arrow_count        =>  # how many =>'s
  87
  88     my $self = [];
  89     $self->[_spaces_]             = $input_hash{spaces};
  90     $self->[_level_]              = $input_hash{level};
  91     $self->[_ci_level_]           = $input_hash{ci_level};
  92     $self->[_available_spaces_]   = $input_hash{available_spaces};
  93     $self->[_closed_]             = -1;
  94     $self->[_comma_count_]        = 0;
  95     $self->[_lp_item_index_]      = $input_hash{lp_item_index};
  96     $self->[_have_child_]         = 0;
  97     $self->[_recoverable_spaces_] = 0;
  98     $self->[_align_seqno_]        = $input_hash{align_seqno};
  99     $self->[_marked_]             = 0;
 100     $self->[_stack_depth_]        = $input_hash{stack_depth};
 101     $self->[_K_begin_line_]       = $input_hash{K_begin_line};
 102     $self->[_arrow_count_]        = 0;
 103
 104     bless $self, $class;
 105     return $self;
 106 }
 107
 108 sub permanently_decrease_available_spaces {
 109
 110     # make a permanent reduction in the available indentation spaces
 111     # at one indentation item.  NOTE: if there are child nodes, their
 112     # total SPACES must be reduced by the caller.
 113
 114     my ( $item, $spaces_needed ) = @_;
 115     my $available_spaces = $item->get_available_spaces();
 116     my $deleted_spaces =
 117       ( $available_spaces > $spaces_needed )
 118       ? $spaces_needed
 119       : $available_spaces;
 120
 121     # Fixed for c085; a zero value must remain unchanged unless the closed
 122     # flag has been set.
 123     my $closed = $item->get_closed();
 124     $item->decrease_available_spaces($deleted_spaces)
 125       unless ( $available_spaces == 0 && $closed < 0 );
 126     $item->decrease_SPACES($deleted_spaces);
 127     $item->set_recoverable_spaces(0);
 128
 129     return $deleted_spaces;
 130 }
 131
 132 sub tentatively_decrease_available_spaces {
 133
 134     # We are asked to tentatively delete $spaces_needed of indentation
 135     # for an indentation item.  We may want to undo this later.  NOTE: if
 136     # there are child nodes, their total SPACES must be reduced by the
 137     # caller.
 138     my ( $item, $spaces_needed ) = @_;
 139     my $available_spaces = $item->get_available_spaces();
 140     my $deleted_spaces =
 141       ( $available_spaces > $spaces_needed )
 142       ? $spaces_needed
 143       : $available_spaces;
 144     $item->decrease_available_spaces($deleted_spaces);
 145     $item->decrease_SPACES($deleted_spaces);
 146     $item->increase_recoverable_spaces($deleted_spaces);
 147     return $deleted_spaces;
 148 }
 149
 150 sub get_stack_depth {
 151     return $_[0]->[_stack_depth_];
 152 }
 153
 154 sub get_spaces {
 155     return $_[0]->[_spaces_];
 156 }
 157
 158 sub get_marked {
 159     return $_[0]->[_marked_];
 160 }
 161
 162 sub set_marked {
 163     my ( $self, $value ) = @_;
 164     if ( defined($value) ) {
 165         $self->[_marked_] = $value;
 166     }
 167     return $self->[_marked_];
 168 }
 169
 170 sub get_available_spaces {
 171     return $_[0]->[_available_spaces_];
 172 }
 173
 174 sub decrease_SPACES {
 175     my ( $self, $value ) = @_;
 176     if ( defined($value) ) {
 177         $self->[_spaces_] -= $value;
 178     }
 179     return $self->[_spaces_];
 180 }
 181
 182 sub decrease_available_spaces {
 183     my ( $self, $value ) = @_;
 184     if ( defined($value) ) {
 185         $self->[_available_spaces_] -= $value;
 186     }
 187     return $self->[_available_spaces_];
 188 }
 189
 190 sub get_align_seqno {
 191     return $_[0]->[_align_seqno_];
 192 }
 193
 194 sub get_recoverable_spaces {
 195     return $_[0]->[_recoverable_spaces_];
 196 }
 197
 198 sub set_recoverable_spaces {
 199     my ( $self, $value ) = @_;
 200     if ( defined($value) ) {
 201         $self->[_recoverable_spaces_] = $value;
 202     }
 203     return $self->[_recoverable_spaces_];
 204 }
 205
 206 sub increase_recoverable_spaces {
 207     my ( $self, $value ) = @_;
 208     if ( defined($value) ) {
 209         $self->[_recoverable_spaces_] += $value;
 210     }
 211     return $self->[_recoverable_spaces_];
 212 }
 213
 214 sub get_ci_level {
 215     return $_[0]->[_ci_level_];
 216 }
 217
 218 sub get_level {
 219     return $_[0]->[_level_];
 220 }
 221
 222 sub get_spaces_level_ci {
 223     my $self = shift;
 224     return [ $self->[_spaces_], $self->[_level_], $self->[_ci_level_] ];
 225 }
 226
 227 sub get_lp_item_index {
 228     return $_[0]->[_lp_item_index_];
 229 }
 230
 231 sub get_K_begin_line {
 232     return $_[0]->[_K_begin_line_];
 233 }
 234
 235 sub set_have_child {
 236     my ( $self, $value ) = @_;
 237     if ( defined($value) ) {
 238         $self->[_have_child_] = $value;
 239     }
 240     return $self->[_have_child_];
 241 }
 242
 243 sub get_have_child {
 244     return $_[0]->[_have_child_];
 245 }
 246
 247 sub set_arrow_count {
 248     my ( $self, $value ) = @_;
 249     if ( defined($value) ) {
 250         $self->[_arrow_count_] = $value;
 251     }
 252     return $self->[_arrow_count_];
 253 }
 254
 255 sub get_arrow_count {
 256     return $_[0]->[_arrow_count_];
 257 }
 258
 259 sub set_comma_count {
 260     my ( $self, $value ) = @_;
 261     if ( defined($value) ) {
 262         $self->[_comma_count_] = $value;
 263     }
 264     return $self->[_comma_count_];
 265 }
 266
 267 sub get_comma_count {
 268     return $_[0]->[_comma_count_];
 269 }
 270
 271 sub set_closed {
 272     my ( $self, $value ) = @_;
 273     if ( defined($value) ) {
 274         $self->[_closed_] = $value;
 275     }
 276     return $self->[_closed_];
 277 }
 278
 279 sub get_closed {
 280     return $_[0]->[_closed_];
 281 }
 282 1;