File Coverage

blib/lib/Lingua/Conjunction.pm
Criterion Covered Total %
statement 47 56 83.9
branch 18 22 81.8
condition 6 9 66.6
subroutine 11 13 84.6
pod 7 7 100.0
total 89 107 83.1


line stmt bran cond sub pod time code
1             package Lingua::Conjunction;
2              
3             # ABSTRACT: Convert lists into simple linguistic conjunctions
4              
5 5     5   1434847 use 5.008;
  5         21  
6              
7 5     5   34 use strict;
  5         9  
  5         161  
8 5     5   30 use warnings;
  5         11  
  5         459  
9              
10 5     5   29 use Carp qw/ croak /;
  5         11  
  5         454  
11 5     5   29 use Exporter qw/ import /;
  5         15  
  5         7156  
12              
13             our @EXPORT = qw( conjunction );
14             our @EXPORT_OK = @EXPORT;
15              
16             =head1 NAME
17              
18             Lingua::Conjunction - Convert lists into simple linguistic conjunctions
19              
20             =head1 VERSION
21              
22             Version 2.7
23              
24             =cut
25              
26             our $VERSION = '2.7';
27              
28             =head1 SYNOPSIS
29              
30             Language-specific definitions.
31             These may not be correct, and certainly they are not complete.
32             E-mail corrections and additions to C<< >>,
33             and an updated version will be released.
34              
35             =cut
36              
37             # Format of %language is as follows:
38             # Two-letter ISO language codes... see L from CPAN for more details.
39             # sep = item separator (usually a comma)
40             # alt = alternate ("phrase") separator
41             # pen = 1 = use penultimate separator/0 = don't use penultimate
42             # (i.e., "Jack, Jill and Spot" vs. "Jack, Jill, and Spot")
43             # con = conjunction ("and")
44             # dis = disjunction ("or"), well, grammatically still a "conjunction"...
45              
46             my %language = (
47             'af' => { sep => ',', alt => ';', pen => 1, con => 'en', dis => 'of' },
48             'br' => { sep => ',', alt => ';', pen => 0, con => 'ha', dis => 'ou' }, # Breton - 'and' is 'ha'
49             'da' => { sep => ',', alt => ';', pen => 1, con => 'og', dis => 'eller' },
50             'de' => { sep => ',', alt => ';', pen => 1, con => 'und', dis => 'oder' },
51             'en' => { sep => ',', alt => ';', pen => 1, con => 'and', dis => 'or' },
52             'es' => { sep => ',', alt => ';', pen => 1, con => 'y', dis => 'o' },
53             'fi' => { sep => ',', alt => ';', pen => 1, con => 'ja', dis => 'tai' },
54             'fr' => { sep => ',', alt => ';', pen => 0, con => 'et', dis => 'ou' },
55             'id' => { sep => ',', alt => ';', pen => 1, con => 'dan', dis => 'atau' },
56             'it' => { sep => ',', alt => ';', pen => 1, con => 'e', dis => 'o' },
57             'la' => { sep => ',', alt => ';', pen => 1, con => 'et', dis => 'vel' },
58             'nl' => { sep => ',', alt => ';', pen => 1, con => 'en', dis => 'of' },
59             'no' => { sep => ',', alt => ';', pen => 0, con => 'og', dis => 'eller' },
60             'pt' => { sep => ',', alt => ';', pen => 1, con => 'e', dis => 'ou' },
61             'sw' => { sep => ',', alt => ';', pen => 1, con => 'na', dis => 'au' },
62             );
63              
64             # Conjunction types. TODO: Someday we'll add either..or, neither..nor
65             my %types = (
66             'and' => 'con',
67             'or' => 'dis'
68             );
69              
70             my %punct = %{ $language{_get_language()} };
71             my $list_type = $types{'and'};
72              
73             =head1 SUBROUTINES/METHODS
74              
75             =head2 conjunction
76              
77             Lingua::Conjunction exports a single subroutine, C, that
78             converts a list into a properly punctuated text string.
79              
80             You can cause C to use the connectives of other languages, by
81             calling the appropriate subroutine:
82              
83             use Lingua::Conjunction;
84              
85             Lingua::Conjunction->lang('en'); # use 'and'
86             Lingua::Conjunction->lang('es'); # use 'y'
87             Lingua::Conjunction->lang(); # Tries to determine your language, otherwise falls back to 'en'
88              
89             Supported languages in this version are
90             Afrikaans,
91             Danish,
92             Dutch,
93             English,
94             French,
95             German,
96             Indonesian,
97             Italian,
98             Latin,
99             Norwegian,
100             Portuguese,
101             Spanish,
102             and Swahili.
103              
104             You can also set connectives individually:
105              
106             Lingua::Conjunction->separator("...");
107             Lingua::Conjunction->separator_phrase("--");
108             Lingua::Conjunction->connector_type("or");
109              
110             # emits "Jack... Jill... or Spot"
111             $name_list = conjunction('Jack', 'Jill', 'Spot');
112              
113             =cut
114              
115             sub conjunction {
116             # TODO: see List::ToHumanString
117 29 100   29 1 2826 my @list = grep { defined && /\S/ } @_;
  76         478  
118 29         86 my $list_count = scalar @list;
119              
120 29 100       102 return if $list_count == 0;
121 28 100       82 return $list[0] if $list_count == 1;
122              
123             # Use appropriate separator for 2-item lists without punctuation conflicts
124 24 100 100     69 return join(" $punct{$list_type} ", @list) if $list_count == 2 && !grep { /$punct{sep}/ } @list;
  28         326  
125              
126             # Quote with \Q incase the separator has regex characters e.g. '.'
127 24 100       21 my $separator = (grep { /\Q$punct{sep}\E/ } @list) ? $punct{alt} : $punct{sep};
  32         198  
128              
129 24 100       32 if($punct{pen}) { # Use Oxford comma?
130 8         88 return join("$separator ", @list[0 .. $#list - 1], "$punct{$list_type} $list[-1]");
131             }
132 16         27 return join("$separator ", @list[0 .. $#list - 2], "$list[-2] $punct{$list_type} $list[-1]");
133             }
134              
135             =head2 separator
136              
137             Sets the separator, usually ',' or ';'.
138              
139             Lingua::Conjunction->separator(',');
140              
141             Returns the previous value.
142              
143             =cut
144              
145             sub separator {
146 1     1 1 5 my $rc = $punct{'sep'};
147              
148 1         2 $punct{'sep'} = $_[1];
149 1         2 return $rc;
150             }
151              
152             =head2 separator_phrase
153              
154             Sets the alternate (phrase) separator.
155              
156             Lingua::Conjunction->separator_phrase(';');
157              
158             The C is used whenever the separator already appears in
159             an item of the list. For example:
160              
161             # emits "Doe, a deer; Ray; and Me"
162             $name_list = conjunction('Doe, a deer', 'Ray', 'Me');
163              
164             Returns the previous value;
165              
166             =cut
167              
168             sub separator_phrase {
169 0     0 1 0 my $rc = $punct{'alt'};
170              
171 0         0 $punct{alt} = $_[1];
172 0         0 return $rc;
173             }
174              
175             =head2 penultimate
176              
177             Enables/disables penultimate separator.
178              
179             You may use the C routine to disable the separator after the
180             next to last item.
181             In English, The Oxford Comma is a highly debated issue.
182              
183             # emits "Jack, Jill and Spot"
184             Lingua::Conjunction->penultimate(0);
185             $name_list = conjunction('Jack', 'Jill', 'Spot');
186              
187             The original author was told that the penultimate comma is not standard for some
188             languages, such as Norwegian.
189             Hence the defaults set in the C<%languages>.
190              
191             Lingua::Conjunction->penultimate(0);
192              
193             Returns the previous value.
194              
195             =cut
196              
197             sub penultimate {
198 3     3 1 925 my $rc = $punct{'pen'};
199              
200 3         10 $punct{pen} = $_[1];
201 3         6 return $rc;
202             }
203              
204             =head2 connector_type
205              
206             Use "and" or "or", with appropriate translation for the current language
207              
208             Lingua::Conjunction->connector_type('and');
209              
210             =cut
211              
212             sub connector_type {
213 3 50   3 1 525 if($types{ $_[1]}) {
214 3         8 $list_type = $types{ $_[1] };
215             } else {
216 0         0 croak "Undefined connector type \`$_[1]\'"
217             }
218              
219 3         17 return $list_type;
220             }
221              
222             =head2 connector
223              
224             Sets the for the current connector_type.
225              
226             Lingua::Conjunction->connector(SCALAR)
227              
228             Returns the previous value.
229              
230             =cut
231              
232             sub connector {
233 0     0 1 0 my $rc = $punct{'list_type'};
234              
235 0         0 $punct{$list_type} = $_[1];
236 0         0 return $rc;
237             }
238              
239             =head2 lang
240              
241             Sets the language to use.
242             If no arguments are given,
243             it tries its best to guess.
244              
245             Lingua::Conjunction->lang('de'); # Changes the language to German
246              
247             =cut
248              
249             sub lang {
250 6   33 6 1 220970 my $language = $_[1] || _get_language();
251              
252 6 100       24 if(defined($language{$language})) {
253 5         10 %punct = %{ $language{$language} };
  5         38  
254             } else {
255 1         178 croak "Undefined language \`$language\'";
256             }
257              
258 5         15 return $language;
259             }
260              
261             # https://www.gnu.org/software/gettext/manual/html_node/Locale-Environment-Variables.html
262             # https://www.gnu.org/software/gettext/manual/html_node/The-LANGUAGE-variable.html
263             sub _get_language
264             {
265 5 100 66 5   57 if($ENV{'LANGUAGE'} && ($ENV{'LANGUAGE'} =~ /^([a-z]{2})/i)) {
266 3         30 return lc($1);
267             }
268              
269 2         6 foreach my $variable('LC_ALL', 'LC_MESSAGES', 'LANG') {
270 6         13 my $val = $ENV{$variable};
271 6 50       16 next unless(defined($val));
272              
273 0 0       0 if($val =~ /^([a-z]{2})/i) {
274 0         0 return lc($1);
275             }
276             }
277 2         11 return 'en';
278             }
279              
280             =head1 AUTHORS
281              
282             =over 4
283              
284             =item *
285              
286             Robert Rothenberg
287              
288             =item *
289              
290             Damian Conway
291              
292             =back
293              
294             =head1 MAINTAINER
295              
296             2021-present Maintained by Nigel Horne, C<< >>
297              
298             =head1 CONTRIBUTORS
299              
300             =for stopwords Ade Ishs Mohammad S Anwar Nigel Horne
301              
302             =over 4
303              
304             =item *
305              
306             Ade Ishs
307              
308             =item *
309              
310             Mohammad S Anwar
311              
312             =item *
313              
314             Nigel Horne C<< >>
315              
316             =back
317              
318             =head1 SEE ALSO
319              
320             C, C
321              
322             The I in Section 4.2 has a similar subroutine called
323             C. The differences are that
324             1. this routine handles multiple languages and
325             2. being a module, you do not have to add the subroutine to a script every time you need it.
326              
327             =head1 SOURCE
328              
329             The development version is on github at L
330             and may be cloned from L
331              
332             =head1 SUPPORT
333              
334             You can find documentation for this module with the perldoc command.
335              
336             perldoc Lingua::Conjunction
337              
338             You can also look for information at:
339              
340             =over 4
341              
342             =item * MetaCPAN
343              
344             L
345              
346             =item * RT: CPAN's request tracker
347              
348             L
349              
350             =item * CPAN Testers' Matrix
351              
352             L
353              
354             =item * CPAN Testers Dependencies
355              
356             L
357              
358             =back
359              
360             =head1 BUGS AND LIMITATIONS
361              
362             Please report any bugs or feature requests on the bugtracker website
363             L
364              
365             When submitting a bug or request, please include a test-file or a
366             patch to an existing test-file that illustrates the bug or desired
367             feature.
368              
369             =head1 LICENSE AND COPYRIGHT
370              
371             This software is Copyright (c) 1999-2020 by Robert Rothenberg.
372              
373             This is free software, licensed under:
374              
375             The Artistic License 2.0 (GPL Compatible)
376              
377             The current maintainer is Nigel Horne.
378              
379             =cut
380              
381             1;