File Coverage

blib/lib/Text/BibTeX/BibSort.pm
Criterion Covered Total %
statement 55 65 84.6
branch 10 16 62.5
condition 5 9 55.5
subroutine 9 11 81.8
pod 1 6 16.6
total 80 107 74.7


line stmt bran cond sub pod time code
1             # ----------------------------------------------------------------------
2             # NAME : BibSort.pm
3             # CLASSES : Text::BibTeX::BibSort
4             # RELATIONS : sub-class of StructuredEntry
5             # super-class of BibEntry
6             # DESCRIPTION: Provides methods for generating sort keys of entries
7             # in a BibTeX-style bibliographic database.
8             # CREATED : 1997/11/24, GPW (taken from Bib.pm)
9             # MODIFIED :
10             # VERSION : $Id$
11             # COPYRIGHT : Copyright (c) 1997-2000 by Gregory P. Ward. All rights
12             # reserved.
13             #
14             # This file is part of the Text::BibTeX library. This is free
15             # software; you can redistribute it and/or modify it under the
16             # same terms as Perl itself.
17             # ----------------------------------------------------------------------
18              
19             package Text::BibTeX::BibSort;
20 1     1   8 use strict;
  1         3  
  1         31  
21 1     1   6 use vars qw(@ISA $VERSION);
  1         2  
  1         42  
22              
23 1     1   574 use Text::BibTeX::Structure;
  1         2  
  1         48  
24              
25             @ISA = qw(Text::BibTeX::StructuredEntry);
26             $VERSION = 0.88;
27              
28 1     1   7 use Text::BibTeX qw(purify_string change_case);
  1         2  
  1         44  
29              
30 1     1   6 use Carp;
  1         2  
  1         749  
31              
32             =head1 NAME
33              
34             Text::BibTeX::BibSort - generate sort keys for bibliographic entries
35              
36             =head1 SYNOPSIS
37              
38             # Assuming $entry comes from a database of the 'Bib' structure
39             # (i.e., that it's blessed into the BibEntry class, which inherits
40             # the sort_key method from BibSort):
41             $sort_key = $entry->sort_key;
42              
43             =head1 DESCRIPTION
44              
45             C is a base class of C
46             for generating sort keys from bibliography entries. It could in
47             principle (and, someday, might) offer a wide range of highly
48             customizable sort-key generators. Currently, though, it provides only a
49             single method (C) for public use, and that method only pays
50             attention to one structure option, C.
51              
52             =head1 METHODS
53              
54             =over 4
55              
56             =item sort_key ()
57              
58             Generates a sort key for a single bibliographic entry. Assumes this
59             entry conforms to the C database structure. The nature of this
60             sort key is controlled by the C option, which can be either
61             C<"name"> or C<"year">. (The C also has a role, in
62             determining how author/editor names are formatted for inclusion in the
63             sort key.)
64              
65             For by-name sorting (which is how BibTeX's standard styles work), the sort
66             key consists of one of the C, C, C, or C
67             fields (depending on the entry type and which fields are actually present),
68             followed by the year and the title. All fields are drastically simplified
69             to produce the sort key: non-English letters are mercilessly anglicized,
70             non-alphabetic characters are stripped, and everything is forced to
71             lowercase. (The first two steps are done by the C routine;
72             see L for a brief
73             description, and the description of the C function C in
74             L for all the gory details.)
75              
76             =cut
77              
78             # methods for sorting -- everything here is geared towards generating
79             # a sort key; it's up to external code to actually order entries (since,
80             # of course, a single entry doesn't know anything about any other
81             # entries!)
82              
83             # also, we assume that an entry has been checked and coerced into
84             # shape -- that way we don't need to check for defined-ness of
85             # strings, or check the type, or anything.
86              
87             sub sort_key
88             {
89 4     4 1 582 my $self = shift;
90 4         6 my ($sortby, $type, $nkey, $skey);
91              
92 4         14 $sortby = $self->structure->get_options ('sortby');
93 4 50       12 croak ("BibSort::sort_key: sortby option is 'none'")
94             if $sortby eq 'none';
95 4 50 66     16 croak ("BibSort::sort_key: unknown sortby option '$sortby'")
96             unless $sortby eq 'name' || $sortby eq 'year';
97              
98 4         11 $type = $self->type;
99              
100 4 100 66     19 if ($type eq 'book' || $type eq 'inbook')
    50          
    50          
101             {
102 2         13 $nkey = $self->format_alt_fields ('author' => 'sort_format_names',
103             'editor' => 'sort_format_names',
104             'key' => 'sortify');
105             }
106             elsif ($type eq 'proceedings')
107             {
108 0         0 $nkey = $self->format_alt_fields ('editor' => 'sort_format_names',
109             'organization' => 'sort_format_org',
110             'key' => 'sortify');
111             }
112             elsif ($type eq 'manual')
113             {
114 0         0 $nkey = $self->format_alt_fields ('author' => 'sort_format_names',
115             'organization' => 'sort_format_org',
116             'key' => 'sortify');
117             }
118             else
119             {
120 2         7 $nkey = $self->format_alt_fields ('author' => 'sort_format_names',
121             'key' => 'sortify');
122             }
123              
124 4         14 my $ykey = change_case ('l', (purify_string ($self->get ('year'))));
125 4 100       16 $skey = ($sortby eq 'name')
126             ? $nkey . ' ' . $ykey
127             : $ykey . ' ' . $nkey;
128 4         13 $skey .= ' ' . $self->sort_format_title ('title');
129 4         18 return $skey;
130              
131             } # sort_key
132              
133              
134             sub sortify
135             {
136 0     0 0 0 my ($self, $field) = @_;
137 0         0 return lc (purify_string ($self->get ($field)));
138             }
139              
140              
141             sub sort_format_names
142             {
143 4     4 0 22 require Text::BibTeX::Name;
144 4         13 require Text::BibTeX::NameFormat;
145              
146 4         7 my ($self, $field) = @_;
147 4         9 my ($abbrev, $format, $name);
148              
149 4         9 $abbrev = ! ($self->structure->get_options ('namestyle') eq 'full');
150 4         13 $format = Text::BibTeX::NameFormat->new ("vljf", $abbrev);
151 4         12 $name = Text::BibTeX::Name->new;
152              
153 4         8 my (@snames, $i, $sname);
154 4         12 @snames = $self->split ($field);
155 4         15 for $i (0 .. $#snames)
156             {
157 6         10 $sname = $snames[$i];
158 6 50       14 if ($sname eq 'others') # hmmm... should we only do this on
159             { # the final name?
160 0         0 $sname = 'et al'; # purified version of "et. al."
161             }
162             else
163             {
164             # A spot of ugliness here:
165             # - lc (purify_string (x)) ought to be sortify (x), but I have
166             # already made sortify a method that only operates on a field,
167             # rather than a generic function (as it is in BibTeX)
168            
169 6         18 $name->split ($sname, $self->filename, $self->line ($field), $i+1);
170 6         19 $sname = $name->format ($format);
171             # print "s_f_n: about to purify >$sname<\n";
172 6         29 $snames[$i] = lc (purify_string ($sname));
173             }
174             }
175 4         20 return join (' ', @snames);
176             }
177              
178              
179              
180             # sort_format_org and sort_format_title are suspiciously similar...
181             # could probably have one method to handle both tasks...
182              
183             sub sort_format_org
184             {
185 0     0 0 0 my ($self, $field) = @_;
186              
187 0         0 my $value = $self->get ($field);
188 0         0 $value =~ s/^the\b\s*//i;
189 0         0 return lc (purify_string ($value));
190             }
191              
192              
193             sub sort_format_title
194             {
195 4     4 0 8 my ($self, $field) = @_;
196              
197 4         10 my $value = $self->get ($field);
198 4         16 $value =~ s/^(the|an?)\b\s*//i;
199 4         21 return lc (purify_string ($value));
200             }
201              
202              
203             # Hmm, I suspect format_alt_fields is a little more general purpose --
204             # probably belongs outside of the "generate sort key" methods.
205             # (Or.... does it maybe belong in one of the base classes, StructuredEntry
206             # or even Entry?)
207              
208             sub format_alt_fields
209             {
210 4     4 0 5 my $self = shift;
211 4         9 my ($field, $method);
212              
213 4         10 while (@_)
214             {
215 4         8 ($field, $method) = (shift, shift);
216 4 50       10 if ($self->exists ($field))
217             {
218 4   33     18 $method = $self->can ($method)
219             || croak ("unknown method in class " . (ref $self));
220 4         11 return &$method ($self, $field);
221             }
222             }
223              
224 0           return undef; # whoops, none of the alternate fields
225             # were present
226             }
227              
228             1;
229              
230             =back
231              
232             =head1 SEE ALSO
233              
234             L, L,
235             L
236              
237             =head1 AUTHOR
238              
239             Greg Ward
240              
241             =head1 COPYRIGHT
242              
243             Copyright (c) 1997-2000 by Gregory P. Ward. All rights reserved. This file
244             is part of the Text::BibTeX library. This library is free software; you
245             may redistribute it and/or modify it under the same terms as Perl itself.