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