From 560cef422e25239c16bee4eec22cf278a8f7eb43 Mon Sep 17 00:00:00 2001
From: Dmitry Lukiyanchuk <tertius@yandex-team.ru>
Date: Thu, 26 Sep 2013 12:45:23 +0400
Subject: [PATCH] quotes like q{}, qq|| and etc. now are extracted too.

---
 lib/QBit/Gettext/Extract/Lang.pm      |  3 +++
 lib/QBit/Gettext/Extract/Lang/Perl.pm | 18 ++++++++++++++++--
 t/files/file.pl                       |  6 ++++++
 t/files/perl.pot                      |  3 +++
 4 files changed, 28 insertions(+), 2 deletions(-)
 mode change 100644 => 100755 t/files/file.pl

diff --git a/lib/QBit/Gettext/Extract/Lang.pm b/lib/QBit/Gettext/Extract/Lang.pm
index a59f586..c46f973 100644
--- a/lib/QBit/Gettext/Extract/Lang.pm
+++ b/lib/QBit/Gettext/Extract/Lang.pm
@@ -1,6 +1,7 @@
 package QBit::Gettext::Extract::Lang;
 
 use qbit;
+use Text::Balanced qw(extract_quotelike);
 
 use base qw(QBit::Class);
 
@@ -53,6 +54,8 @@ sub extract_from_file {
                 s/\\'/'/sg;
             } elsif (s/^"|"$//sg) {
                 s/\\"/"/sg;
+            } elsif ( my $quoted_value = (extract_quotelike($_))[5] ) {
+                $_ = $quoted_value;
             }
         }
 
diff --git a/lib/QBit/Gettext/Extract/Lang/Perl.pm b/lib/QBit/Gettext/Extract/Lang/Perl.pm
index 8eda63f..a78fbcf 100644
--- a/lib/QBit/Gettext/Extract/Lang/Perl.pm
+++ b/lib/QBit/Gettext/Extract/Lang/Perl.pm
@@ -1,18 +1,32 @@
 package QBit::Gettext::Extract::Lang::Perl;
 
 use qbit;
+use Text::Balanced qw(extract_multiple extract_quotelike);
 
 use base qw(QBit::Gettext::Extract::Lang);
 
 my $RE_eol        = $QBit::Gettext::Extract::Lang::RE_eol;
-my $RE_quoted_str = $QBit::Gettext::Extract::Lang::RE_quoted_str;
+
+sub extract_from_file {
+    my ($self, $filename, $po) = @_;
+
+    my @quoted = grep {defined($_)} map {scalar extract_quotelike($_)} extract_multiple(readfile($filename), [\&extract_quotelike]);
+    if(@quoted) {
+        my $quoted_regexp = '(?:'.join(')|(?:', map {quotemeta($_)} @quoted).')';
+        local $QBit::Gettext::Extract::Lang::RE_quoted_str = qr/(?:$QBit::Gettext::Extract::Lang::RE_quoted_str)|$quoted_regexp/ ;
+        $self->SUPER::extract_from_file($filename, $po);
+    }
+    else {
+        $self->SUPER::extract_from_file($filename, $po);
+    }
+}
 
 sub clean {
     my ($self, $text) = @_;
 
     {
         no warnings qw(uninitialized);
-        $text =~ s/($RE_quoted_str)|#.*$/$1/mg;    # Remove comments
+        $text =~ s/($QBit::Gettext::Extract::Lang::RE_quoted_str)|#.*$/$1/mg;    # Remove comments
     };
 
     # Remove PODs
diff --git a/t/files/file.pl b/t/files/file.pl
old mode 100644
new mode 100755
index 836df2b..6b1d9a3
--- a/t/files/file.pl
+++ b/t/files/file.pl
@@ -37,6 +37,12 @@
 gettext("1
 
 3");
+gettext(qq-1
+
+3-); # gettext(q{One more text in comment})
+
+gettext(q{Test 1' # " });
+gettext(q|Test 1' # " |);
 
 =head 1
 
diff --git a/t/files/perl.pot b/t/files/perl.pot
index bbf2712..541d644 100644
--- a/t/files/perl.pot
+++ b/t/files/perl.pot
@@ -19,6 +19,7 @@ msgstr ""
 "Plural-Forms: nplurals=INTEGER; plural=EXPRESSION;\n"
 
 #: $BIN/files/file.pl:37
+#: $BIN/files/file.pl:40
 msgid ""
 "1\n"
 "\n"
@@ -60,6 +61,8 @@ msgstr[0] ""
 msgstr[1] ""
 
 #: $BIN/files/file.pl:14
+#: $BIN/files/file.pl:44
+#: $BIN/files/file.pl:45
 msgid "Test 1' # \" "
 msgstr ""