root/trunk/gsdl/perllib/sorttools.pm @ 1919

Revision 1919, 3.8 KB (checked in by sjboddie, 19 years ago)

*** empty log message ***

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
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
31
32# format an english string for sorting
33# i.e. convert to lowercase, remove the, a or an
34# from beginning of string etc.
35sub format_string_english {
36    my ($stringref) = @_;
37
38    $$stringref =~ tr/A-Z/a-z/;
39    $$stringref =~ s/&\S;//g;
40    $$stringref =~ s/[^a-z0-9 ]//g;
41    $$stringref =~ s/^\s*(the|a|an)\b//;
42    $$stringref =~ s/^\s+//;
43}
44
45# format an english name for sorting
46# i.e. convert to lowercase, put surname before
47# first names etc.   
48sub format_string_name_english {
49    my ($stringref) = @_;
50
51    $$stringref =~ tr/A-Z/a-z/;
52    $$stringref =~ s/&\S;//g;
53    $$stringref =~ s/[^a-z0-9 ]//g;
54    $$stringref =~ s/\s+/ /g;
55    $$stringref =~ s/^\s+//;
56    my @names = split / /, $$stringref;
57    my $surname = pop @names;
58    while (scalar @names && $surname =~ /^(jnr|snr)$/i) {
59    $surname = pop @names;
60    }
61    $$stringref = $surname . " " . $$stringref;
62}
63
64# takes arguments of day, month, year and converts to
65# date of form yyyymmdd. month may be full (e.g. "January"),
66# abbreviated (e.g. "Jan"), or a number (1-12). Years like "86"
67# will be assumed to be "1986".
68sub format_date {
69    my ($day, $month, $year) = @_;
70
71    my %months = ('january' => '01', 'jan' => '01', 'february' => '02', 'feb' => '02',
72          'march' => '03', 'mar' => '03', 'april' => '04', 'apr' => '04',
73          'may' => '05', 'june' => '06', 'jun' => '06', 'july' => '07',
74          'jul' => '07', 'august' => '08', 'aug' => '08', 'september' => '09',
75          'sep' => '09', 'october' => '10', 'oct' => '10', 'november' => '11',
76          'nov' => '11', 'december' => '12', 'dec' => '12');
77
78    $month =~ tr/A-Z/a-z/;
79   
80    if ($day < 1) {
81    print STDERR "sorttools::format_date WARNING day $day out of range\n";
82    $day = "01";
83    } elsif ($day > 31) {
84    print STDERR "sorttools::format_date WARNING day $day out of range\n";
85    $day = "31";
86    }
87
88    $day = "0$day" if (length($day) == 1);
89
90    if ($month =~ /^\d\d?$/) {
91    if ($month < 1) {
92        print STDERR "sorttools::format_date WARNING month $month out of range\n";
93        $month = "01";
94    } elsif ($month > 12) {
95        print STDERR "sorttools::format_date WARNING month $month out of range\n";
96        $month = "12";
97    }
98    if ($month =~ /^\d$/) {
99        $month = "0" . $month;
100    }
101    } elsif (!defined $months{$month}) {
102    print STDERR "sorttools::format_date WARNING month $month out of range\n";
103    $month = "01";
104    } else {
105    $month = $months{$month};
106    }
107   
108    if ($year !~ /^\d\d\d\d$/) {
109    if ($year !~ /^\d\d$/) {
110        print STDERR "sorttools::format_date WARNING year $year assumed to be 19$year\n";
111        $year = "19" . $year;
112    } else {
113        print STDERR "sorttools::format_date WARNING year $year out of range - reset to 1900\n";
114        $year = "1900";
115    }
116    }
117
118    return "$year$month$day";
119}
120
121
1221;
Note: See TracBrowser for help on using the browser.