File Coverage

blib/lib/BibTeX/Parser/Entry.pm
Criterion Covered Total %
statement 132 161 81.9
branch 44 56 78.5
condition 8 8 100.0
subroutine 23 25 92.0
pod 16 16 100.0
total 223 266 83.8


line stmt bran cond sub pod time code
1             package BibTeX::Parser::Entry;
2             {
3             $BibTeX::Parser::Entry::VERSION = '1.03';
4             }
5              
6 18     18   140398 use warnings;
  18         53  
  18         593  
7 18     18   96 use strict;
  18         35  
  18         339  
8              
9 18     18   1007 use BibTeX::Parser;
  18         32  
  18         561  
10 18     18   7474 use BibTeX::Parser::Author;
  18         50  
  18         8172  
11              
12              
13              
14             sub new {
15 129     129 1 109997 my ($class, $type, $key, $parse_ok, $fieldsref) = @_;
16              
17 129 100       553 my %fields = defined $fieldsref ? %$fieldsref : ();
18 129         226 my $i=0;
19 129         341 foreach my $field (keys %fields) {
20 92 50       268 if ($field !~ /^_/) {
21 92         218 $fields{_fieldnums}->{$field}=$i;
22 92         170 $i++;
23             }
24             }
25 129 100       285 if (defined $type) {
26 92         207 $fields{_type} = uc($type);
27             }
28 129         245 $fields{_key} = $key;
29 129         209 $fields{_parse_ok} = $parse_ok;
30 129         225 $fields{_raw} = '';
31 129         437 return bless \%fields, $class;
32             }
33              
34              
35              
36             sub parse_ok {
37 51     51 1 4934 my $self = shift;
38 51 100       138 if (@_) {
39 34         68 $self->{_parse_ok} = shift;
40             }
41 51         138 $self->{_parse_ok};
42             }
43              
44              
45             sub error {
46 2     2 1 6 my $self = shift;
47 2 50       8 if (@_) {
48 2         7 $self->{_error} = shift;
49 2         6 $self->parse_ok(0);
50             }
51 2 50       7 return $self->parse_ok ? undef : $self->{_error};
52             }
53              
54              
55             sub type {
56 65 100   65 1 792 if (scalar @_ == 1) {
57             # get
58 28         51 my $self = shift;
59 28         157 return $self->{_type};
60             } else {
61             # set
62 37         82 my ($self, $newval) = @_;
63 37         147 $self->{_type} = uc($newval);
64             }
65             }
66              
67              
68             sub key {
69 90 100   90 1 2411 if (scalar @_ == 1) {
70             # get
71 58         98 my $self = shift;
72 58         1379 return $self->{_key};
73             } else {
74             # set
75 32         134 my ($self, $newval) = @_;
76 32         97 $self->{_key} = $newval;
77             }
78              
79             }
80              
81              
82             sub field {
83 331 100   331 1 676 if (scalar @_ == 2) {
84             # get
85 194         385 my ($self, $field) = @_;
86 194         729 return $self->{ lc( $field ) };
87             } else {
88 137         430 my ($self, $key, $value) = @_;
89 137         268 my $field = lc ($key);
90 137         341 $self->{$field} = $value; #_sanitize_field($value);
91 137 100       357 if (!exists($self->{_fieldnums}->{$field})) {
92 136         258 my $num = scalar keys %{$self->{_fieldnums}};
  136         290  
93 136         340 $self->{_fieldnums}->{$field} = $num;
94             }
95             }
96              
97             }
98              
99 18     18   9423 use LaTeX::ToUnicode qw( convert );
  18         87648  
  18         5455  
100              
101              
102             sub cleaned_field {
103 90     90 1 193 my ( $self, $field, @options ) = @_;
104 90 50       218 if ( $field =~ /author|editor/i ) {
105 0         0 return $self->field( $field );
106             } else {
107 90         266 return convert( $self->field( lc $field ), @options );
108             }
109             }
110              
111              
112             sub cleaned_author {
113 1     1 1 3 my $self = shift;
114 1         3 $self->_handle_cleaned_author_editor( [ $self->author ], @_ );
115             }
116              
117              
118             sub cleaned_editor {
119 0     0 1 0 my $self = shift;
120 0         0 $self->_handle_cleaned_author_editor( [ $self->editor ], @_ );
121             }
122              
123             sub _handle_cleaned_author_editor {
124 1     1   3 my ( $self, $authors, @options ) = @_;
125             map {
126 1         4 my $author = $_;
  2         21  
127 2         18 my $new_author = BibTeX::Parser::Author->new;
128             map {
129 4         12 $new_author->$_( convert( $author->$_, @options ) )
130 2         6 } grep { defined $author->$_ } qw( first von last jr );
  8         22  
131 2         9 $new_author;
132             } @$authors;
133             }
134              
135 18     18   173 no LaTeX::ToUnicode;
  18         38  
  18         20378  
136              
137             sub _handle_author_editor {
138 33     33   74 my $type = shift;
139 33         90 my $self = shift;
140 33 50       98 if (@_) {
141 0 0       0 if (@_ == 1) { #single string
142             # my @names = split /\s+and\s+/i, $_[0];
143 0         0 $_[0] =~ s/^\s*//;
144 0         0 $_[0] =~ s/\s*$//;
145 0         0 my @names = BibTeX::Parser::_split_braced_string($_[0],
146             '\s+and\s+');
147 0 0       0 if (!scalar @names) {
148 0         0 $self->error('Bad names in author/editor field');
149 0         0 return;
150             }
151 0         0 $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
  0         0  
152 0         0 $self->field($type, join " and ", @{$self->{"_$type"}});
  0         0  
153             } else {
154 0         0 $self->{"_$type"} = [];
155 0         0 foreach my $param (@_) {
156 0 0       0 if (ref $param eq "BibTeX::Author") {
157 0         0 push @{$self->{"_$type"}}, $param;
  0         0  
158             } else {
159 0         0 push @{$self->{"_$type"}}, new BibTeX::Parser::Author $param;
  0         0  
160             }
161            
162 0         0 $self->field($type, join " and ", @{$self->{"_$type"}});
  0         0  
163             }
164             }
165             } else {
166 33 100       135 unless ( defined $self->{"_$type"}) {
167 17   100     160 my @names = BibTeX::Parser::_split_braced_string($self->{$type} || "", '\s+and\s+' );
168 17         64 $self->{"_$type"} = [map {new BibTeX::Parser::Author $_} @names];
  32         180  
169             }
170 33         61 return @{$self->{"_$type"}};
  33         137  
171             }
172             }
173              
174              
175              
176             sub author {
177 24     24 1 1460 _handle_author_editor('author', @_);
178             }
179              
180              
181             sub editor {
182 9     9 1 692 _handle_author_editor('editor', @_);
183             }
184              
185              
186             sub fieldlist {
187 1     1 1 4 my $self = shift;
188            
189 1         5 return grep {!/^_/} keys %$self;
  7         23  
190             }
191              
192              
193             sub has {
194 3     3 1 8 my ($self, $field) = @_;
195              
196 3         16 return defined $self->{$field};
197             }
198              
199             sub _sanitize_field {
200 0     0   0 my $value = shift;
201 0         0 for ($value) {
202 0         0 tr/\{\}//d;
203 0         0 s/\\(?!=[ \\])//g;
204 0         0 s/\\\\/\\/g;
205             }
206 0         0 return $value;
207             }
208              
209              
210              
211             sub raw_bibtex {
212 36     36 1 91 my $self = shift;
213 36 50       98 if (@_) {
214 36         77 $self->{_raw} = shift;
215             }
216 36         68 return $self->{_raw};
217             }
218              
219             sub pre {
220 39     39 1 74 my $self = shift;
221 39 100       168 if (@_) {
222 36         91 $self->{_pre} = shift;
223             }
224 39         92 return $self->{_pre};
225             }
226              
227              
228             sub to_string {
229 15     15 1 72 my $self = shift;
230 15         42 my %options=@_;
231 15 100       58 if (!exists($options{canonize_names})) {
232 14         42 $options{canonize_names}=1;
233             }
234 15         61 my @fields = grep {!/^_/} keys %$self;
  180         404  
235             @fields = sort {
236 15         63 $self->{_fieldnums}->{$a} <=>
237 109         267 $self->{_fieldnums}->{$b}} @fields;
238 15         27 my $result = '';
239 15 100       70 if ($options{print_pre}) {
240 3         7 $result .= $self->pre()."\n";
241             }
242 15         50 my $type = $self->type;
243 15 100       46 if (exists($options{type_capitalization})) {
244 3 100       9 if ($options{type_capitalization} eq 'Lowercase') {
245 1         3 $type = lc $type;
246             }
247 3 100       8 if ($options{type_capitalization} eq 'Titlecase') {
248 1         4 $type = ucfirst lc $type;
249             }
250             }
251 15         41 print STDERR $self->key, "\n";
252 15         100 $result .= '@'.$type."{".$self->key.",\n";
253 15         42 foreach my $field (@fields) {
254 73         145 my $value = $self->field($field);
255 73 100 100     203 if ($field eq 'author' && $options{canonize_names}) {
256 14         37 my @names = ($self->author);
257 14         125 $value = join(' and ', @names);
258             }
259 73 100 100     158 if ($field eq 'editor' && $options{canonize_names}) {
260 8         19 my @names = ($self->editor);
261 8         23 $value = join(' and ', @names);
262             }
263 73 100       131 if (exists($options{field_capitalization})) {
264 15 100       32 if ($options{field_capitalization} eq 'Uppercase') {
265 5         13 $field = uc $field;
266             }
267 15 100       28 if ($options{field_capitalization} eq 'Titlecase') {
268 5         11 $field = ucfirst $field;
269             }
270             }
271 73         211 $result .= " $field = {"."$value"."},\n";
272             }
273 15         24 $result .= "}";
274 15         89 return $result;
275             }
276              
277             1; # End of BibTeX::Entry
278              
279             __END__