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