From d50e96d50a2d69707f2ed397d14131ead70e29d2 Mon Sep 17 00:00:00 2001
From: Joe Atzberger <joe.atzberger@liblime.com>
Date: Tue, 8 Jan 2008 12:57:22 -0600
Subject: [PATCH] Languages.pm - add a carp for bad arg, return undef upon
 failure

Signed-off-by: Chris Cormack <crc@liblime.com>
Signed-off-by: Joshua Ferraro <jmf@liblime.com>
---
 C4/Languages.pm | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/C4/Languages.pm b/C4/Languages.pm
index 83cd6c1862..6667b7a808 100644
--- a/C4/Languages.pm
+++ b/C4/Languages.pm
@@ -21,6 +21,7 @@ package C4::Languages;
 
 use strict; 
 use warnings;	#FIXME: turn off warnings before release
+use Carp;
 use C4::Context;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
@@ -401,29 +402,34 @@ sub get_bidi {
 
 sub accept_language {
 	# referenced http://search.cpan.org/src/CGILMORE/I18N-AcceptLanguage-1.04/lib/I18N/AcceptLanguage.pm
-	my 	($clientPreferences,$supportedLanguages) = @_;
-	# There should be no whitespace anways, but a cleanliness/sanity check
-	$clientPreferences =~ s/\s//g;
-  
-	# Prepare the list of client-acceptable languages
+	# FIXME: since this is only used in Output.pm as of Jan 8 2008, maybe it should be IN Output.pm
+	my ($clientPreferences,$supportedLanguages) = @_;
 	my @languages = ();
-	foreach my $tag (split(/,/, $clientPreferences)) {
-		my ($language, $quality) = split(/\;/, $tag);
-		$quality =~ s/^q=//i if $quality;
-		$quality = 1 unless $quality;
-		next if $quality <= 0;
-		# We want to force the wildcard to be last
-		$quality = 0 if ($language eq '*');
-		# Pushing lowercase language here saves processing later
-		push(@languages, { quality => $quality,
+	if ($clientPreferences) {
+		# There should be no whitespace anways, but a cleanliness/sanity check
+		$clientPreferences =~ s/\s//g;
+
+		# Prepare the list of client-acceptable languages
+		foreach my $tag (split(/,/, $clientPreferences)) {
+			my ($language, $quality) = split(/\;/, $tag);
+			$quality =~ s/^q=//i if $quality;
+			$quality = 1 unless $quality;
+			next if $quality <= 0;
+			# We want to force the wildcard to be last
+			$quality = 0 if ($language eq '*');
+			# Pushing lowercase language here saves processing later
+			push(@languages, { quality => $quality,
 		       language => $language,
 		       lclanguage => lc($language) });
+		}
+	} else {
+		carp "accept_language(x,y) called with no clientPreferences (x).";
 	}
 	# Prepare the list of server-supported languages
 	my %supportedLanguages = ();
 	my %secondaryLanguages = ();
 	foreach my $language (@$supportedLanguages) {
-		warn "SUP: ".$language->{language_code};
+		# warn "Language supported: " . $language->{language_code};
 		$supportedLanguages{lc($language->{language_code})} = $language->{language_code};
 		if ($language->{language_code} =~ /^([^-]+)-?/) {
 			$secondaryLanguages{lc($1)} = $language->{language_code};
@@ -446,6 +452,7 @@ sub accept_language {
 			# Client en-gb eq server en-us
 			$secondaryMatch = $secondaryLanguages{$1};
 		} elsif ($tag->{lclanguage} =~ /^([^-]+)-/ && exists($secondaryLanguages{$1}) && $secondaryMatch eq '') {
+			# FIXME: We just checked the exact same conditional!
 			# Client en-us eq server en
 			$secondaryMatch = $supportedLanguages{$1};
 		} elsif ($tag->{lclanguage} eq '*') {
@@ -458,6 +465,7 @@ sub accept_language {
 	}
 	# No primary matches. Secondary? (ie, en-us requested and en supported)
 	return $secondaryMatch if $secondaryMatch;
+	return undef;	# else, we got nothing.
 }
 1;
 
-- 
2.39.5