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 = '20210717';
  12
  13 BEGIN {
  14
  15     # Array index names
  16     my $i = 0;
  17     use constant {
  18         _spaces_             => $i++,
  19         _level_              => $i++,
  20         _ci_level_           => $i++,
  21         _available_spaces_   => $i++,
  22         _closed_             => $i++,
  23         _comma_count_        => $i++,
  24         _sequence_number_    => $i++,
  25         _index_              => $i++,
  26         _have_child_         => $i++,
  27         _recoverable_spaces_ => $i++,
  28         _align_paren_        => $i++,
  29         _marked_             => $i++,
  30         _stack_depth_        => $i++,
  31         _starting_index_K_   => $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     # sequence_number    =>  # output batch number
  77     # 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_paren        =>  # do we want to try to align
  83     #                        # with an opening structure?
  84     # marked             =>  # if visited by corrector logic
  85     # stack_depth        =>  # indentation nesting depth
  86     # starting_index_K   =>  # 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->[_sequence_number_]    = $input_hash{gnu_sequence_number};
  97     $self->[_index_]              = $input_hash{index};
  98     $self->[_have_child_]         = 0;
  99     $self->[_recoverable_spaces_] = 0;
 100     $self->[_align_paren_]        = $input_hash{align_paren};
 101     $self->[_marked_]             = 0;
 102     $self->[_stack_depth_]        = $input_hash{stack_depth};
 103     $self->[_starting_index_K_]   = $input_hash{starting_index_K};
 104     $self->[_arrow_count_]        = 0;
 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     $item->decrease_available_spaces($deleted_spaces);
 123     $item->decrease_SPACES($deleted_spaces);
 124     $item->set_recoverable_spaces(0);
 125
 126     return $deleted_spaces;
 127 }
 128
 129 sub tentatively_decrease_available_spaces {
 130
 131     # We are asked to tentatively delete $spaces_needed of indentation
 132     # for an indentation item.  We may want to undo this later.  NOTE: if
 133     # there are child nodes, their total SPACES must be reduced by the
 134     # caller.
 135     my ( $item, $spaces_needed ) = @_;
 136     my $available_spaces = $item->get_available_spaces();
 137     my $deleted_spaces =
 138       ( $available_spaces > $spaces_needed )
 139       ? $spaces_needed
 140       : $available_spaces;
 141     $item->decrease_available_spaces($deleted_spaces);
 142     $item->decrease_SPACES($deleted_spaces);
 143     $item->increase_recoverable_spaces($deleted_spaces);
 144     return $deleted_spaces;
 145 }
 146
 147 sub get_stack_depth {
 148     return $_[0]->[_stack_depth_];
 149 }
 150
 151 sub get_spaces {
 152     return $_[0]->[_spaces_];
 153 }
 154
 155 sub get_marked {
 156     return $_[0]->[_marked_];
 157 }
 158
 159 sub set_marked {
 160     my ( $self, $value ) = @_;
 161     if ( defined($value) ) {
 162         $self->[_marked_] = $value;
 163     }
 164     return $self->[_marked_];
 165 }
 166
 167 sub get_available_spaces {
 168     return $_[0]->[_available_spaces_];
 169 }
 170
 171 sub decrease_SPACES {
 172     my ( $self, $value ) = @_;
 173     if ( defined($value) ) {
 174         $self->[_spaces_] -= $value;
 175     }
 176     return $self->[_spaces_];
 177 }
 178
 179 sub decrease_available_spaces {
 180     my ( $self, $value ) = @_;
 181     if ( defined($value) ) {
 182         $self->[_available_spaces_] -= $value;
 183     }
 184     return $self->[_available_spaces_];
 185 }
 186
 187 sub get_align_paren {
 188     return $_[0]->[_align_paren_];
 189 }
 190
 191 sub get_recoverable_spaces {
 192     return $_[0]->[_recoverable_spaces_];
 193 }
 194
 195 sub set_recoverable_spaces {
 196     my ( $self, $value ) = @_;
 197     if ( defined($value) ) {
 198         $self->[_recoverable_spaces_] = $value;
 199     }
 200     return $self->[_recoverable_spaces_];
 201 }
 202
 203 sub increase_recoverable_spaces {
 204     my ( $self, $value ) = @_;
 205     if ( defined($value) ) {
 206         $self->[_recoverable_spaces_] += $value;
 207     }
 208     return $self->[_recoverable_spaces_];
 209 }
 210
 211 sub get_ci_level {
 212     return $_[0]->[_ci_level_];
 213 }
 214
 215 sub get_level {
 216     return $_[0]->[_level_];
 217 }
 218
 219 sub get_sequence_number {
 220     return $_[0]->[_sequence_number_];
 221 }
 222
 223 sub get_index {
 224     return $_[0]->[_index_];
 225 }
 226
 227 sub get_starting_index_K {
 228     return $_[0]->[_starting_index_K_];
 229 }
 230
 231 sub set_have_child {
 232     my ( $self, $value ) = @_;
 233     if ( defined($value) ) {
 234         $self->[_have_child_] = $value;
 235     }
 236     return $self->[_have_child_];
 237 }
 238
 239 sub get_have_child {
 240     return $_[0]->[_have_child_];
 241 }
 242
 243 sub set_arrow_count {
 244     my ( $self, $value ) = @_;
 245     if ( defined($value) ) {
 246         $self->[_arrow_count_] = $value;
 247     }
 248     return $self->[_arrow_count_];
 249 }
 250
 251 sub get_arrow_count {
 252     return $_[0]->[_arrow_count_];
 253 }
 254
 255 sub set_comma_count {
 256     my ( $self, $value ) = @_;
 257     if ( defined($value) ) {
 258         $self->[_comma_count_] = $value;
 259     }
 260     return $self->[_comma_count_];
 261 }
 262
 263 sub get_comma_count {
 264     return $_[0]->[_comma_count_];
 265 }
 266
 267 sub set_closed {
 268     my ( $self, $value ) = @_;
 269     if ( defined($value) ) {
 270         $self->[_closed_] = $value;
 271     }
 272     return $self->[_closed_];
 273 }
 274
 275 sub get_closed {
 276     return $_[0]->[_closed_];
 277 }
 278 1;