From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Sun, 11 Aug 2024 14:57:58 +0000 (-0700)
Subject: improve guess if running under editor
X-Git-Tag: 20240511.10~7
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=5e39fad0890b6b942fe186c0705c4836f3d29cfa;p=perltidy.git

improve guess if running under editor
---

diff --git a/.perlcriticrc b/.perlcriticrc
index 3ae28971..5a8fb7d9 100644
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -78,9 +78,9 @@ lines=30
 # there are some critical loops in Formatter.pm whose high mccabe values cannot
 # be reduced without significantly increasing run time. Note that a complete
 # list of mccabe numbers can be obtained with perltidy -dbs file.pl >file.csv
-# sub scan_variable_usage has score 243
+# sub scan_variable_usage has score 250
 [Subroutines::ProhibitExcessComplexity]
-max_mccabe=245
+max_mccabe=260
 
 # This policy can be very helpful for locating complex code, but sometimes
 # deep nests are the best option, especially in error handling and debug
diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 6b77ce60..7dbc4ce9 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -8751,14 +8751,54 @@ sub has_complete_package {
 sub is_complete_script {
     my ($self) = @_;
 
-    # return true if this file appears to be a complete script
+    # Guess if we are formatting a complete script
+    # return: true if YES false if NO
 
-    # Require 0 starting indentation to be a complete script
+    #----------------------------------------------------------------
+    # PART 1: Assume a file with known extension is a complete script
+    #----------------------------------------------------------------
+    my %is_known_file_extension = (
+        'pm'  => 1,
+        'pl'  => 1,
+        'plx' => 1,
+        't'   => 1,
+        'PM'  => 1,
+        'PL'  => 1,
+    );
+    my $input_stream_name = get_input_stream_name();
+    my $pos_dot           = rindex( $input_stream_name, '.' );
+    my $file_extension    = EMPTY_STRING;
+    if ( $pos_dot > 1 ) {
+        $file_extension = substr( $input_stream_name, $pos_dot + 1 );
+        if (   defined($file_extension)
+            && length($file_extension)
+            && $file_extension =~ /^\d+$/ )
+        {
+            my $str = substr( $input_stream_name, 0, $pos_dot );
+            $pos_dot = rindex( $str, '.' );
+            if ( $pos_dot > 1 ) {
+                $file_extension = substr( $str, $pos_dot + 1 );
+            }
+        }
+        return 1 if $is_known_file_extension{$file_extension};
+    }
+
+    #-------------------------------------------------------------------------
+    # PART 2: otherwise zero starting indentation implies an incomplete script
+    #-------------------------------------------------------------------------
     my $rLL = $self->[_rLL_];
     return unless ( @{$rLL} );
     my $sil = $rLL->[0]->[_LEVEL_];
     return if ($sil);
 
+    #------------------------------------
+    # PART 3: look for a complete package
+    #------------------------------------
+    return 1 if $self->has_complete_package();
+
+    #----------------------------
+    # PART 4: examine other clues
+    #----------------------------
     my $rlines     = $self->[_rlines_];
     my $line_count = @{$rlines};
     return unless ($line_count);
@@ -8785,8 +8825,9 @@ sub is_complete_script {
     my $rK_package_list = $self->[_rK_package_list_];
     my $saw_package     = defined($rK_package_list) && @{$rK_package_list};
 
-    # Use the available clues to decide
+    # Make a guess using the available clues.
     my $score = 0;
+    $score += 50 if $file_extension;
     $score += 50 if $saw_hash_bang;
     $score += 50 if $saw_END_or_DATA;
     $score += 50 if $saw_package;
@@ -9995,11 +10036,8 @@ EOM
     if ( $is_possible_snippet && ( $check_unused || $check_constant ) ) {
 
         # the flag $is_possible_snippet = 0:No  1:Uncertain   2:Yes
-        if (
-            $is_possible_snippet == 1
-            && (   $self->has_complete_package()
-                || $self->is_complete_script() )
-          )
+        if (   $is_possible_snippet == 1
+            && $self->is_complete_script() )
         {
             # not a snippet
         }