From a6bdb6a198f8f9fe4153f72e5b4d10e1b5057c3e Mon Sep 17 00:00:00 2001
From: "Salve J. Nilsen" <sjn-bugs.freedesktop.org@pvv.org>
Date: Tue, 16 Apr 2013 17:24:00 +0000
Subject: [PATCH] Improve Perl detection

https://bugs.freedesktop.org/show_bug.cgi?id=63612
---
 freedesktop.org.xml.in | 15 ++++++++++++++-
 tests/list             |  4 ++++
 tests/test.pl          |  7 +++++++
 tests/test.pm          |  9 +++++++++
 tests/test.t           | 16 ++++++++++++++++
 5 files changed, 50 insertions(+), 1 deletion(-)
 create mode 100644 tests/test.pl
 create mode 100644 tests/test.pm
 create mode 100644 tests/test.t

diff --git a/freedesktop.org.xml.in b/freedesktop.org.xml.in
index 92d3ec6..67d1b2e 100644
--- a/freedesktop.org.xml.in
+++ b/freedesktop.org.xml.in
@@ -2849,11 +2849,24 @@ command to generate the output files.
       <match type="string" value='eval \"exec /usr/local/bin/perl' offset="0"/>
       <match type="string" value="/bin/perl" offset="2:16"/>
       <match type="string" value="/bin/env perl" offset="2:16"/>
+      <match type="string" value="use strict" offset="0:256"/>
+      <match type="string" value="use warnings" offset="0:256"/>
+      <match type="string" value="use diagnostics" offset="0:256"/>
+      <match type="string" value="use Test::" offset="0:256"/>
+      <match type="string" value="BEGIN {" offset="0:256"/>
+    </magic>
+    <magic priority="40">
+      <match type="string" value="\n=pod" offset="0:256"/>
+      <match type="string" value="\n=head1 NAME" offset="0:256"/>
+      <match type="string" value="\n=head1 DESCRIPTION" offset="0:256"/>
     </magic>
     <glob pattern="*.pl"/>
+    <glob pattern="*.PL"/><!-- CPAN-style Perl build script -->
     <glob pattern="*.pm"/><!-- module -->
     <glob pattern="*.al"/><!-- autoloader -->
     <glob pattern="*.perl"/>
+    <glob pattern="*.pod"/><!-- documentation -->
+    <glob pattern="*.t" weight="10"/><!-- CPAN-style Perl test script -->
   </mime-type>
   <mime-type type="application/x-php">
     <_comment>PHP script</_comment>
@@ -3337,7 +3350,7 @@ command to generate the output files.
     </magic>
     <glob pattern="*.tr"/>
     <glob pattern="*.roff"/>
-    <glob pattern="*.t"/>
+    <glob weight="10" pattern="*.t"/>
   </mime-type>
   <mime-type type="application/x-troff-man">
     <_comment>Troff document (with manpage macros)</_comment>
diff --git a/tests/list b/tests/list
index df522ca..9bc3797 100644
--- a/tests/list
+++ b/tests/list
@@ -272,6 +272,10 @@ test.jnlp application/x-java-jnlp-file
 # Python script
 test.py text/x-python
 test.pyx text/x-python ox
+# Perl
+test.pl application/x-perl
+test.pm application/x-perl
+test.t application/x-perl
 
 # xml subtypes
 test.ttx application/x-font-ttx
diff --git a/tests/test.pl b/tests/test.pl
new file mode 100644
index 0000000..306ad8e
--- /dev/null
+++ b/tests/test.pl
@@ -0,0 +1,7 @@
+#!/usr/bin/env perl
+
+use 5.010_001; # Require Perl5 version 10.1 or newer
+use strict;
+use warnings;
+
+say scalar localtime;  # now
diff --git a/tests/test.pm b/tests/test.pm
new file mode 100644
index 0000000..1c47751
--- /dev/null
+++ b/tests/test.pm
@@ -0,0 +1,9 @@
+use 5.010_001; # Require Perl5 version 10.1 or newer
+use strict;
+use warnings;
+
+package test;
+
+sub now {
+    say scalar localtime;  # now
+}
diff --git a/tests/test.t b/tests/test.t
new file mode 100644
index 0000000..48929e3
--- /dev/null
+++ b/tests/test.t
@@ -0,0 +1,16 @@
+use Test::More tests => 4;
+
+my $true_value = !0;
+ok( $true_value, "Boolean negation of 0 is true" );
+
+SKIP: {
+    skip("Confused implementor", 1);
+    is( $true_value, "0 but true", "'0 but true' is true");
+}
+
+TODO: {
+    local $TODO = "Need fuzzy magic";
+    is( $true_value, 0.999999999999999, "True-ish in the fuzzy sense");
+}
+
+is( $true_value, 1, "Boolean negation of 0 is 1" );
-- 
1.8.3.1