source: main/trunk/greenstone2/perllib/sorttools.pm@ 32524

Last change on this file since 32524 was 18902, checked in by mdewsnip, 15 years ago

Same fix to format_string_fr() and format_string_es() as Katherine made to format_string_en() in June 2005.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1###########################################################################
2#
3# sorttools.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# various subroutines to format strings
27# for sorting
28
29package sorttools;
30
31use strict;
32
33# moved here from BasClas so import can share it
34sub format_metadata_for_sorting {
35 my ($metaname, $metavalue, $doc_obj) = @_;
36 if (!defined $metaname || $metaname !~ /\S/ || ! defined $metavalue || $metavalue !~ /\S/) {
37 return "";
38 }
39
40 if ($metaname eq "Language") {
41 $metavalue = $iso639::fromiso639{$metavalue};
42 return $metavalue;
43 }
44
45 my $lang;
46 if (defined $doc_obj) {
47 $lang = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), 'Language');
48 }
49 $lang = 'en' unless defined $lang;
50
51 # is this metadata likely to be a name?
52 my $function_name="format_string_name_$lang";
53 if ($metaname =~ /^(?:\w+\.)?(?:Creators?|Authors?|Editors?)(?:[:,].*)?$/
54 && exists &$function_name) {
55 no strict 'refs';
56 &$function_name(\$metavalue);
57 } else {
58 $function_name="format_string_$lang";
59 if (exists &$function_name) {
60 no strict 'refs';
61 &$function_name(\$metavalue);
62 }
63 }
64
65 return $metavalue;
66}
67
68### language-specific sorting functions (called by format_metadata_for_sorting)
69
70## format_string_$lang() converts to lowercase (where appropriate), and
71# removes punctuation, articles from the start of string, etc
72## format_string_name_$lang() converts to lowercase, puts the surname first,
73# removes punctuation, etc
74
75sub format_string_en {
76 my $stringref = shift;
77 $$stringref = lc($$stringref);
78 $$stringref =~ s/&[^\;]+\;//g; # html entities
79 $$stringref =~ s/^\s*(the|a|an)\b//; # articles
80 $$stringref =~ s/[^[:alnum:]]//g;
81 $$stringref =~ s/\s+/ /g;
82 $$stringref =~ s/^\s+//;
83 $$stringref =~ s/\s+$//;
84}
85
86sub format_string_name_en {
87 my ($stringref) = @_;
88 $$stringref =~ tr/A-Z/a-z/;
89 $$stringref =~ s/&\S+;//g;
90
91 my $comma_format = ($$stringref =~ m/^.+,.+$/);
92 $$stringref =~ s/[[:punct:]]//g;
93 $$stringref =~ s/\s+/ /g;
94 $$stringref =~ s/^\s+//;
95 $$stringref =~ s/\s+$//;
96
97
98 if (!$comma_format) {
99 # No commas in name => name in 'firstname surname' format
100 # need to sort by surname
101 my @names = split / /, $$stringref;
102 my $surname = pop @names;
103 while (scalar @names && $surname =~ /^(jnr|snr)$/i) {
104 $surname = pop @names;
105 }
106 $$stringref = $surname . " " . $$stringref;
107 }
108}
109
110
111sub format_string_fr {
112 my $stringref = shift;
113
114 $$stringref = lc($$stringref);
115 $$stringref =~ s/&[^\;]+\;//g; # html entities
116 $$stringref =~ s/^\s*(les?|la|une?)\b//; # articles
117 $$stringref =~ s/[^[:alnum:]]//g;
118 $$stringref =~ s/\s+/ /g;
119 $$stringref =~ s/^\s+//;
120 $$stringref =~ s/\s+$//;
121}
122
123sub format_string_es {
124 my $stringref = shift;
125
126 $$stringref = lc($$stringref);
127 $$stringref =~ s/&[^\;]+\;//g; # html entities
128 $$stringref =~ s/^\s*(la|el)\b//; # articles
129 $$stringref =~ s/[^[:alnum:]]//g;
130 $$stringref =~ s/\s+/ /g;
131 $$stringref =~ s/^\s+//;
132 $$stringref =~ s/\s+$//;
133}
134
135### end of language-specific functions
136
137# takes arguments of day, month, year and converts to
138# date of form yyyymmdd. month may be full (e.g. "January"),
139# abbreviated (e.g. "Jan"), or a number (1-12). Years like "86"
140# will be assumed to be "1986".
141sub format_date {
142 my ($day, $month, $year) = @_;
143
144 my %months = ('january' => '01', 'jan' => '01', 'february' => '02', 'feb' => '02',
145 'march' => '03', 'mar' => '03', 'april' => '04', 'apr' => '04',
146 'may' => '05', 'june' => '06', 'jun' => '06', 'july' => '07',
147 'jul' => '07', 'august' => '08', 'aug' => '08', 'september' => '09',
148 'sep' => '09', 'october' => '10', 'oct' => '10', 'november' => '11',
149 'nov' => '11', 'december' => '12', 'dec' => '12');
150
151 $month =~ tr/A-Z/a-z/;
152
153 if ($day < 1) {
154 print STDERR "sorttools::format_date WARNING day $day out of range\n";
155 $day = "01";
156 } elsif ($day > 31) {
157 print STDERR "sorttools::format_date WARNING day $day out of range\n";
158 $day = "31";
159 }
160
161 $day = "0$day" if (length($day) == 1);
162
163 if ($month =~ /^\d\d?$/) {
164 if ($month < 1) {
165 print STDERR "sorttools::format_date WARNING month $month out of range\n";
166 $month = "01";
167 } elsif ($month > 12) {
168 print STDERR "sorttools::format_date WARNING month $month out of range\n";
169 $month = "12";
170 }
171 if ($month =~ /^\d$/) {
172 $month = "0" . $month;
173 }
174 } elsif (!defined $months{$month}) {
175 print STDERR "sorttools::format_date WARNING month $month out of range\n";
176 $month = "01";
177 } else {
178 $month = $months{$month};
179 }
180
181 if ($year !~ /^\d\d\d\d$/) {
182 if ($year !~ /^\d\d$/) {
183 my $newyear = 1900 + $year;
184 print STDERR "sorttools::format_date WARNING year $year assumed to be $newyear\n";
185 $year=$newyear;
186 } else {
187 print STDERR "sorttools::format_date WARNING year $year out of range - reset to 1900\n";
188 $year = "1900";
189 }
190 }
191
192 return "$year$month$day";
193}
194
195
1961;
Note: See TracBrowser for help on using the repository browser.