From 88440e31f48cd2fb44fef4d6b4ecaaf017246002 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= <joaotavora@gmail.com>
Date: Fri, 3 Nov 2017 16:05:39 +0000
Subject: [PATCH 3/3] Add a Flymake backend for Perl

Define a simple backend in perl-mode.el, which cperl-mode.el also
uses.

* lisp/progmodes/cperl-mode.el (cperl-mode): Add to
flymake-diagnostic-functions.

* lisp/progmodes/flymake-proc.el
(flymake-proc-allowed-file-name-masks): Disable legacy backend
for perl files.

* lisp/progmodes/perl-mode.el (perl-flymake-command): New
defcustom.
(perl--flymake-proc): New buffer-local variable.
(perl-flymake): New function.
(perl-mode): Add to flymake-diagnostic-functions.
---
 lisp/progmodes/cperl-mode.el   |  4 ++-
 lisp/progmodes/flymake-proc.el |  2 +-
 lisp/progmodes/perl-mode.el    | 71 +++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 74 insertions(+), 3 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 853604d1d7..4c63ec2fb4 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1896,7 +1896,9 @@ cperl-mode
   (if cperl-pod-here-scan
       (or cperl-syntaxify-by-font-lock
        (progn (or cperl-faces-init (cperl-init-faces-weak))
-	      (cperl-find-pods-heres)))))
+	      (cperl-find-pods-heres))))
+  ;; Setup Flymake
+  (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t))
 
 ;; Fix for perldb - make default reasonable
 (defun cperl-db ()
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 5c4d451d63..2e98b2afd1 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -73,7 +73,7 @@ flymake-proc-allowed-file-name-masks
     ("\\.xml\\'" flymake-proc-xml-init)
     ("\\.html?\\'" flymake-proc-xml-init)
     ("\\.cs\\'" flymake-proc-simple-make-init)
-    ("\\.p[ml]\\'" flymake-proc-perl-init)
+    ;; ("\\.p[ml]\\'" flymake-proc-perl-init)
     ("\\.php[345]?\\'" flymake-proc-php-init)
     ("\\.h\\'" flymake-proc-master-make-header-init flymake-proc-master-cleanup)
     ("\\.java\\'" flymake-proc-simple-make-java-init flymake-proc-simple-java-cleanup)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 24b934ce6c..0f1088920a 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -581,6 +581,73 @@ perl-current-defun-name
 	(match-string-no-properties 1))))
 
 
+;;; Flymake support
+(defcustom perl-flymake-command '("perl" "-w" "-c")
+  "External tool used to check Perl source code.
+This is a non empty list of strings, the checker tool possibly
+followed by required arguments.  Once launched it will receive
+the Perl source to be checked as its standard input."
+  :group 'perl
+  :type '(repeat string))
+
+(defvar-local perl--flymake-proc nil)
+
+;;;###autoload
+(defun perl-flymake (report-fn &rest _args)
+  "Perl backend for Flymake.  Launches
+`perl-flymake-command' (which see) and passes to its standard
+input the contents of the current buffer.  The output of this
+command is analysed for error and warning messages."
+  (unless (executable-find (car perl-flymake-command))
+    (error "Cannot find a suitable checker"))
+
+  (when (process-live-p perl--flymake-proc)
+    (kill-process perl--flymake-proc))
+
+  (let ((source (current-buffer)))
+    (save-restriction
+      (widen)
+      (setq
+       perl--flymake-proc
+       (make-process
+        :name "perl-flymake" :noquery t :connection-type 'pipe
+        :buffer (generate-new-buffer " *perl-flymake*")
+        :command perl-flymake-command
+        :sentinel
+        (lambda (proc _event)
+          (when (eq 'exit (process-status proc))
+            (unwind-protect
+                (if (with-current-buffer source (eq proc perl--flymake-proc))
+                    (with-current-buffer (process-buffer proc)
+                      (goto-char (point-min))
+                      (cl-loop
+                       while (search-forward-regexp
+                              "^\\(.+\\) at - line \\([0-9]+\\)"
+                              nil t)
+                       for msg = (match-string 1)
+                       for (beg . end) = (flymake-diag-region
+                                          source
+                                          (string-to-number (match-string 2)))
+                       for type =
+                       (if (string-match
+                            "\\(Scalar value\\|Useless use\\|Unquoted string\\)"
+                            msg)
+                           :warning
+                         :error)
+                       collect (flymake-make-diagnostic source
+                                                        beg
+                                                        end
+                                                        type
+                                                        msg)
+                       into diags
+                       finally (funcall report-fn diags)))
+                  (flymake-log :debug "Canceling obsolete check %s"
+                               proc))
+              (display-buffer (process-buffer proc)))))))
+      (process-send-region perl--flymake-proc (point-min) (point-max))
+      (process-send-eof perl--flymake-proc))))
+
+
 (defvar perl-mode-hook nil
   "Normal hook to run when entering Perl mode.")
 
@@ -665,7 +732,9 @@ perl-mode
   ;; Setup outline-minor-mode.
   (setq-local outline-regexp perl-outline-regexp)
   (setq-local outline-level 'perl-outline-level)
-  (setq-local add-log-current-defun-function #'perl-current-defun-name))
+  (setq-local add-log-current-defun-function #'perl-current-defun-name)
+  ;; Setup Flymake
+  (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t))
 
 ;; This is used by indent-for-comment
 ;; to decide how much to indent a comment in Perl code
-- 
2.14.2