File Coverage

blib/lib/Config/Model/HashId.pm
Criterion Covered Total %
statement 231 261 88.5
branch 88 132 66.6
condition 19 33 57.5
subroutine 32 34 94.1
pod 14 18 77.7
total 384 478 80.3


line stmt bran cond sub pod time code
1             #
2             # This file is part of Config-Model
3             #
4             # This software is Copyright (c) 2005-2022 by Dominique Dumont.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU Lesser General Public License, Version 2.1, February 1999
9             #
10              
11             use Mouse;
12 33     33   216 use 5.10.1;
  33         64  
  33         274  
13 33     33   15655  
  33         119  
14             use Config::Model::Exception;
15 33     33   184 use Carp;
  33         68  
  33         1041  
16 33     33   162  
  33         78  
  33         2235  
17             use Mouse::Util::TypeConstraints;
18 33     33   214  
  33         70  
  33         392  
19             subtype 'HaskKeyArray' => as 'ArrayRef' ;
20             coerce 'HaskKeyArray' => from 'Str' => via { [$_] } ;
21              
22             use Log::Log4perl qw(get_logger :levels);
23 33     33   5341  
  33         74  
  33         318  
24             my $logger = get_logger("Tree::Element::Id::Hash");
25              
26             extends qw/Config::Model::AnyId/;
27              
28             with "Config::Model::Role::Grab";
29             with "Config::Model::Role::ComputeFunction";
30              
31             has data => ( is => 'rw', isa => 'HashRef', default => sub { {}; } );
32             has list => (
33             is => 'rw',
34             isa => 'ArrayRef[Str]',
35             traits => ['Array'],
36             default => sub { []; },
37             handles => {
38             _sort => 'sort_in_place',
39             }
40             );
41              
42             has [qw/default_keys auto_create_keys/] => (
43             is => 'rw',
44             isa => 'HaskKeyArray',
45             coerce => 1,
46             default => sub { []; }
47             );
48             has [qw/ordered write_empty_value/] => ( is => 'ro', isa => 'Bool', default => 0 );
49              
50             my $self = shift;
51              
52 224     224 1 381 # foreach my $wrong (qw/migrate_values_from/) {
53             # Config::Model::Exception::Model->throw (
54             # object => $self,
55             # error => "Cannot use $wrong with ".$self->get_type." element"
56             # ) if defined $self->{$wrong};
57             # }
58              
59             # could use "required", but we'd get a Moose error instead of a Config::Model
60             # error
61             Config::Model::Exception::Model->throw(
62             object => $self,
63 224 50       986 error => "Undefined index_type"
64             ) unless defined $self->index_type;
65              
66             return $self;
67             }
68 224         1949  
69             my $self = shift;
70              
71             $self->SUPER::set_properties(@_);
72 257     257 0 424  
73             my $idx_type = $self->{index_type};
74 257         986  
75             # remove unwanted items
76 256         483 my $data = $self->{data};
77              
78             my $idx = 1;
79 256         441 my $wrong = sub {
80             my $k = shift;
81 256         408 if ( $idx_type eq 'integer' ) {
82             return 1 if defined $self->{max_index} and $k > $self->{max_index};
83 52     52   86 return 1 if defined $self->{min_index} and $k < $self->{min_index};
84 52 100       97 }
85 42 50 66     128 return 1 if defined $self->{max_nb} and $idx++ > $self->{max_nb};
86 42 50 66     100 return 0;
87             };
88 52 50 66     109  
89 52         169 # delete entries that no longer fit the constraints imposed by the
90 256         1186 # warp mechanism
91             foreach my $k ( sort keys %$data ) {
92             next unless $wrong->($k);
93             $logger->trace( "set_properties: ", $self->name, " deleting id $k" );
94 256         1874 delete $data->{$k};
95 52 50       81 }
96 0         0 }
97 0         0  
98             my $self = shift;
99              
100             return if $self->{migration_done};
101              
102 1157     1157   1880 # migration must be done *after* initial load to make sure that all data
103             # were retrieved from the file before migration.
104 1157 100       3344 return if $self->instance->initial_load;
105             $self->{migration_done} = 1;
106              
107             if ( $self->{migrate_keys_from} ) {
108 415 100       2696 my $followed = $self->safe_typed_grab( param => 'migrate_keys_from', check => 'no' );
109 221         499 if ( $logger->is_debug ) {
110             $logger->debug( $self->name, " migrate keys from ", $followed->name );
111 221 100       938 }
    100          
112 1         7  
113 1 50       5 for my $idx ($followed->fetch_all_indexes) {
114 0         0 $self->_store( $idx, undef ) unless $self->_defined($idx);
115             }
116             }
117 1         14 elsif ( $self->{migrate_values_from} ) {
118 4 50       10 my $followed = $self->safe_typed_grab( param => 'migrate_values_from', check => 'no' );
119             $logger->debug( $self->name, " migrate values from ", $followed->name )
120             if $logger->is_debug;
121             foreach my $item ( $followed->fetch_all_indexes ) {
122 2         12 next if $self->exists($item); # don't clobber existing entries
123 2 50       5 my $data = $followed->fetch_with_id($item)->dump_as_data( check => 'no' );
124             $self->fetch_with_id($item)->load_data($data);
125 2         19 }
126 5 50       59 }
127 5         17  
128 5         17 }
129              
130             my $self = shift;
131             return 'hash';
132             }
133              
134             my $self = shift;
135 528     528 1 800  
136 528         1119 my @items = (
137             'type: ' . $self->get_type . ( $self->ordered ? '(ordered)' : '' ),
138             'index: ' . $self->index_type,
139             'cargo: ' . $self->cargo_type,
140 1     1 1 3 );
141              
142 1 50       5 if ( $self->cargo_type eq 'node' ) {
143             push @items, "cargo class: " . $self->config_class_name;
144             }
145              
146             foreach my $what (qw/min_index max_index max_nb warn_if_key_match warn_unless_key_match/) {
147             my $v = $self->$what();
148 1 50       4 my $str = $what;
149 1         5 $str =~ s/_/ /g;
150             push @items, "$str: $v" if defined $v;
151             }
152 1         4  
153 5         27 return @items;
154 5         7 }
155 5         12  
156 5 50       12 # important: return the actual size (not taking into account auto-created stuff)
157             my $self = shift;
158             return scalar keys %{ $self->{data} };
159 1         4 }
160              
161             my $self = shift;
162             return $self->{ordered}
163             ? @{ $self->{list} }
164 442     442 1 730 : sort keys %{ $self->{data} };
165 442         610 }
  442         1491  
166              
167             # fetch without any check
168             my ( $self, $key ) = @_;
169 1194     1194   1912 return $self->{data}{$key};
170             }
171 133         632  
172 1194 100       2854 # store without any check
  1061         5387  
173             my ( $self, $key, $value ) = @_;
174             push @{ $self->{list} }, $key
175             unless exists $self->{data}{$key};
176             $self->notify_change(note => "added entry $key") if $self->write_empty_value;
177 1238     1238   2269 return $self->{data}{$key} = $value;
178 1238         4563 }
179              
180             my ( $self, $key ) = @_;
181             return exists $self->{data}{$key};
182             }
183 411     411   988  
184 405         1030 my ( $self, $key ) = @_;
185 411 100       1185 return defined $self->{data}{$key} ? 1 : 0;
186 411 100       1487 }
187 411         1056  
188             #internal
189             my $self = shift;
190              
191 469     469   1014 my $auto_p = $self->auto_create_keys;
192 469         1548 return unless defined $auto_p;
193              
194             # create empty slots
195             map { $self->_store( $_, undef ) unless exists $self->{data}{$_}; }
196 2493     2493   4000 ( ref $auto_p ? @$auto_p : ($auto_p) );
197 2493 100       10813 }
198              
199             # internal
200             my $self = shift;
201             my @temp = keys %{ $self->{data} };
202 256     256 0 434  
203             return if @temp;
204 256         775  
205 256 100       681 # hash is empty so create empty element for default keys
206             my $def = $self->get_default_keys;
207             map { $self->_store( $_, undef ) } @$def;
208 7 100       26 $self->create_default_with_init;
  32 50       185  
209             }
210              
211             my ( $self, $key ) = @_;
212              
213             # remove key in ordered list
214 925     925 0 1490 @{ $self->{list} } = grep { $_ ne $key } @{ $self->{list} };
215 925         1270  
  925         3074  
216             return delete $self->{data}{$key};
217 925 100       2616 }
218              
219             my $self = shift;
220 317         1184 $self->delete(@_);
221 317         647 }
  20         44  
222 317         1066  
223             my ($self) = @_;
224             $self->{list} = [];
225             $self->{data} = {};
226 11     11   28 }
227              
228             my $self = shift;
229 11         23 if ($self->ordered) {
  11         33  
  27         62  
  11         34  
230             $self->_sort;
231 11         40 }
232             else {
233             Config::Model::Exception::User->throw(
234             object => $self,
235 6     6 0 10 message => "cannot call sort on non ordered hash"
236 6         50 );
237             }
238             }
239              
240 5     5   14 my ($self, $id) = @_;
241 5         25  
242 5         176 if ($self->ordered) {
243             my $elt = $self->fetch_with_id($id);
244             $self->_sort;
245             return $elt;
246 2     2 1 5 }
247 2 50       14 else {
248 2         14 Config::Model::Exception::User->throw(
249             object => $self,
250             message => "cannot call insort on non ordered hash"
251 0         0 );
252             }
253             }
254              
255             # hash only method
256             my $self = shift;
257              
258             $self->warp
259 4     4 1 12 if ( $self->{warp} and @{ $self->{warp_info}{computed_master} } );
260              
261 4 50       25 $self->create_default if defined $self->{default};
262 4         22  
263 4         22 # reset "each" iterator (to be sure, map is also an iterator)
264 4         126 my @list = $self->_fetch_all_indexes;
265             $self->{each_list} = \@list;
266             return shift @list;
267 0         0 }
268              
269             # hash only method
270             my $self = shift;
271              
272             $self->warp
273             if ( $self->{warp} and @{ $self->{warp_info}{computed_master} } );
274              
275             my $res = shift @{ $self->{each_list} };
276 0     0 1 0  
277             return $res if defined $res;
278              
279 0 0 0     0 # reset list for next call to next_keys
  0         0  
280             $self->{each_list} = [ $self->_fetch_all_indexes ];
281 0 0       0  
282             return;
283             }
284 0         0  
285 0         0 my $self = shift;
286 0         0 my ( $key1, $key2 ) = @_;
287              
288             foreach my $k (@_) {
289             Config::Model::Exception::User->throw(
290             object => $self,
291 0     0 1 0 message => "swap: unknow key $k"
292             ) unless exists $self->{data}{$k};
293             }
294 0 0 0     0  
  0         0  
295             my @copy = @{ $self->{list} };
296 0         0 for ( my $idx = 0 ; $idx <= $#copy ; $idx++ ) {
  0         0  
297             if ( $copy[$idx] eq $key1 ) {
298 0 0       0 $self->{list}[$idx] = $key2;
299             }
300             if ( $copy[$idx] eq $key2 ) {
301 0         0 $self->{list}[$idx] = $key1;
302             }
303 0         0 }
304              
305             $self->notify_change( note => "swap ordered hash keys '$key1' and '$key2'" );
306             }
307 2     2 1 6  
308 2         8 my $self = shift;
309             my ( $from, $to, %args ) = @_;
310 2         6  
311             Config::Model::Exception::User->throw(
312             object => $self,
313             message => "move: unknow key $from"
314 4 50       14 ) unless exists $self->{data}{$from};
315              
316             my $ok = $self->check_idx($to);
317 2         5  
  2         7  
318 2         10 my $check = $args{check};
319 6 100       16 if ($ok or $check eq 'no') {
320 2         6  
321             # this may clobber the old content of $self->{data}{$to}
322 6 100       17 $self->{data}{$to} = delete $self->{data}{$from};
323 2         6 delete $self->{warning_hash}{$from};
324              
325             # update index_value attribute in moved objects
326             $self->{data}{$to}->index_value($to);
327 2         18  
328             $self->notify_change( note => "rename key from '$from' to '$to'" );
329              
330             # data_mode is preset or layered or user. Actually only user
331 6     6 1 2760 # mode makes sense here
332 6         24 my $imode = $self->instance->get_data_mode;
333             $self->set_data_mode( $to, $imode );
334              
335             my ( $to_idx, $from_idx );
336             my $list = $self->{list};
337 6 50       71 for (my $idx = 0; $idx <= $#$list; $idx++) {
338             $to_idx = $idx if $list->[$idx] eq $to;
339 6         37 $from_idx = $idx if $list->[$idx] eq $from;
340             }
341 6         17  
342 6 50 33     24 if ( defined $to_idx ) {
    0          
343             # Since $to is clobbered, $from takes its place in the list
344             $list->[$from_idx] = $to;
345 6         47  
346 6         17 # and the $from entry is removed from the list
347             splice @$list, $to_idx, 1;
348             }
349 6         91 else {
350             # $to is moved in the place of from in the list
351 6         52 $list->[$from_idx] = $to;
352             }
353             }
354             elsif ($check eq 'yes') {
355 6         41 Config::Model::Exception::WrongValue->throw(
356 6         44 error => join( "\n\t", @{ $self->{error} } ),
357             object => $self
358 6         436 );
359 6         18 }
360 6         33 $logger->debug("Skipped move $from -> $to");
361 22 100       47 return $ok;
362 22 100       53 }
363              
364             my $self = shift;
365 6 100       20 my ( $key_to_move, $ref_key ) = @_;
366              
367 2         5 if ( not $self->ordered ) {
368             $logger->warn("called move_after on unordered hash");
369             return;
370 2         6 }
371              
372             foreach my $k (@_) {
373             Config::Model::Exception::User->throw(
374 4         12 object => $self,
375             message => "swap: unknow key $k"
376             ) unless exists $self->{data}{$k};
377             }
378              
379 0         0 # remove the key to move in ordered list
  0         0  
380             @{ $self->{list} } = grep { $_ ne $key_to_move } @{ $self->{list} };
381              
382             my $list = $self->{list};
383 6         36  
384 6         66 my $msg;
385             if ( defined $ref_key ) {
386             for ( my $idx = 0 ; $idx <= $#$list ; $idx++ ) {
387             if ( $list->[$idx] eq $ref_key ) {
388 3     3 1 1645 splice @$list, $idx + 1, 0, $key_to_move;
389 3         10 last;
390             }
391 3 50       21 }
392 0         0  
393 0         0 $msg = "moved key '$key_to_move' after '$ref_key'";
394             }
395             else {
396 3         11 unshift @$list, $key_to_move;
397             $msg = "moved key '$key_to_move' at beginning";
398             }
399              
400 5 50       20 $self->notify_change( note => $msg );
401              
402             }
403              
404 3         5 my $self = shift;
  3         12  
  15         30  
  3         8  
405             my ($key) = @_;
406 3         11  
407             if ( not $self->ordered ) {
408 3         7 $logger->warn("called move_up on unordered hash");
409 3 100       10 return;
410 2         9 }
411 6 100       15  
412 2         8 Config::Model::Exception::User->throw(
413 2         3 object => $self,
414             message => "move_up: unknow key $key"
415             ) unless exists $self->{data}{$key};
416              
417 2         7 my $list = $self->{list};
418              
419             # we start from 1 as we can't move up idx 0
420 1         4 for ( my $idx = 1 ; $idx < scalar @$list ; $idx++ ) {
421 1         5 if ( $list->[$idx] eq $key ) {
422             $list->[$idx] = $list->[ $idx - 1 ];
423             $list->[ $idx - 1 ] = $key;
424 3         20 $self->notify_change( note => "moved up key '$key'" );
425             last;
426             }
427             }
428              
429 1     1 1 3 # notify_change is placed in the loop so the notification
430 1         4 # is not sent if the user tries to move up idx 0
431             }
432 1 50       6  
433 0         0 my $self = shift;
434 0         0 my ($key) = @_;
435              
436             if ( not $self->ordered ) {
437             $logger->warn("called move_down on unordered hash");
438             return;
439             }
440 1 50       5  
441             Config::Model::Exception::User->throw(
442 1         3 object => $self,
443             message => "move_down: unknown key $key"
444             ) unless exists $self->{data}{$key};
445 1         5  
446 1 50       5 my $list = $self->{list};
447 1         3  
448 1         3 # we end at $#$list -1 as we can't move down last idx
449 1         7 for ( my $idx = 0 ; $idx < scalar @$list - 1 ; $idx++ ) {
450 1         3 if ( $list->[$idx] eq $key ) {
451             $list->[$idx] = $list->[ $idx + 1 ];
452             $list->[ $idx + 1 ] = $key;
453             $self->notify_change( note => "moved down key $key" );
454             last;
455             }
456             }
457              
458             # notify_change is placed in the loop so the notification
459 1     1 1 4 # is not sent if the user tries to move past last idx
460 1         3 }
461              
462 1 50       11 my $self = shift;
463 0         0 my %args = @_;
464 0         0 my $data = $args{data};
465             my %backup = %$data ;
466              
467             my @ordered_keys;
468             my $from = '';
469              
470 1 50       5 my $order_key = '__'.$self->element_name.'_order';
471             if ( $self->{ordered} and (defined $data->{$order_key} or defined $data->{__order} )) {
472 1         4 @ordered_keys = @{ delete $data->{$order_key} or delete $data->{__order} };
473             $from = ' with '.$order_key;
474             }
475 1         7 elsif ( $self->{ordered} and (not $data->{__skip_order} and keys %$data > 1)) {
476 2 100       7 $logger->warn(
477 1         3 "HashId " . $self->location . ": loading ordered "
478 1         3 . "hash from hash ref without special key '__order'. Element "
479 1         11 . "order is not defined. If needed, this warning can be suppressed by passing "
480 1         3 . " key '__skip_order' set to 1."
481             );
482             $from = ' without '.$order_key;
483             }
484             delete $data->{__skip_order};
485              
486             if (@ordered_keys) {
487             my %data_keys = map { $_ => 1 ; } keys %$data;
488             my @left_keys;
489 30     30   56 foreach my $k (@ordered_keys) {
490 30         84 push @left_keys, $k unless delete $data_keys{$k};
491 30         68 }
492 30         136 if ( %data_keys or @left_keys) {
493             my @msg ;
494 30         54 push @msg, "Unlisted keys in __order:", keys %data_keys if %data_keys;
495 30         85 push @msg, "Extra keys in __order:", @left_keys if @left_keys;
496             Config::Model::Exception::LoadData->throw(
497 30         144 object => $self,
498 30 100 66     232 message => "load_data: ordered keys mistmatch: @msg",
    100 100        
      100        
      66        
499 3 50       8 wrong_data => \%backup,
  3         23  
500 3         10 );
501             }
502             }
503 2         28 my @load_keys = @ordered_keys ? @ordered_keys : sort keys %$data;
504              
505             $logger->info(
506             "HashId load_data (" . $self->location .
507             ") will load idx @load_keys from hash ref $from"
508             );
509 2         160 foreach my $elt (@load_keys) {
510             my $obj = $self->fetch_with_id($elt);
511 30         68 $obj->load_data( %args, data => $data->{$elt} ) if defined $data->{$elt};
512             }
513 30 100       115 }
514 3         11  
  11         23  
515 3         7 my $self = shift;
516 3         10 my %args = @_ > 1 ? @_ : ( data => shift );
517 13 100       29 my $data = delete $args{data};
518             my $check = $self->_check_check( $args{check} );
519 3 100 66     18  
520 1         3 if ( ref($data) eq 'HASH' ) {
521 1 50       4 $self->_load_data_from_hash(data => $data, %args);
522 1 50       4 }
523 1         29 elsif ( ref($data) eq 'ARRAY' ) {
524             $logger->info(
525             "HashId load_data (" . $self->location . ") will load idx 0..$#$data from array ref" );
526             $self->notify_change( note => "Converted ordered data to non ordered", really => 1) unless $self->ordered;
527             my $idx = 0;
528             while ( $idx < @$data ) {
529             my $elt = $data->[ $idx++ ];
530 29 100       189 my $obj = $self->fetch_with_id($elt);
531             $obj->load_data( %args, data => $data->[ $idx++ ] );
532 29         243 }
533             }
534             elsif ( defined $data ) {
535              
536 29         303 # we can skip undefined data
537 59         281 my $expected = $self->{ordered} ? 'array' : 'hash';
538 59 100       391 Config::Model::Exception::LoadData->throw(
539             object => $self,
540             message => "load_data called with non $expected ref arg",
541             wrong_data => $data,
542             );
543 32     32 1 1589 }
544 32 100       162 }
545 32         90  
546 32         162 __PACKAGE__->meta->make_immutable;
547              
548 32 100       148 1;
    50          
    0          
549 30         138  
550             # ABSTRACT: Handle hash element for configuration model
551              
552 2         29  
553             =pod
554 2 50       30  
555 2         6 =encoding UTF-8
556 2         10  
557 8         17 =head1 NAME
558 8         30  
559 8         33 Config::Model::HashId - Handle hash element for configuration model
560              
561             =head1 VERSION
562              
563             version 2.151
564              
565 0 0         =head1 SYNOPSIS
566 0            
567             See L<Config::Model::AnyId/SYNOPSIS>
568              
569             =head1 DESCRIPTION
570              
571             This class provides hash elements for a L<Config::Model::Node>.
572              
573             The hash index can either be en enumerated type, a boolean, an integer
574             or a string.
575              
576             =head1 CONSTRUCTOR
577              
578             HashId object should not be created directly.
579              
580             =head1 Hash model declaration
581              
582             See
583             L<model declaration section|Config::Model::AnyId/"Hash or list model declaration">
584             from L<Config::Model::AnyId>.
585              
586             =head1 Methods
587              
588             =head2 get_type
589              
590             Returns C<hash>.
591              
592             =head2 fetch_size
593              
594             Returns the number of elements of the hash.
595              
596             =head2 sort
597              
598             Sort an ordered hash. Throws an error if called on a non ordered hash.
599              
600             =head2 insort
601              
602             Parameters: key
603              
604             Create a new element in the ordered hash while keeping alphabetical order of the keys
605              
606             Returns the newly created element.
607              
608             Throws an error if called on a non ordered hash.
609              
610             =head2 firstkey
611              
612             Returns the first key of the hash. Behaves like C<each> core perl
613             function.
614              
615             =head2 nextkey
616              
617             Returns the next key of the hash. Behaves like C<each> core perl
618             function.
619              
620             =head2 swap
621              
622             Parameters: C<< ( key1 , key2 ) >>
623              
624             Swap the order of the 2 keys. Ignored for non ordered hash.
625              
626             =head2 move
627              
628             Parameters: C<< ( key1 , key2 ) >>
629              
630             Rename key1 in key2.
631              
632             Also also optional check parameter to disable warning:
633              
634             move ('foo','bar', check => 'no')
635              
636             =head2 move_after
637              
638             Parameters: C<< ( key_to_move [ , after_this_key ] ) >>
639              
640             Move the first key after the second one. If the second parameter is
641             omitted, the first key is placed in first position. Ignored for non
642             ordered hash.
643              
644             =head2 move_up
645              
646             Parameters: C<< ( key ) >>
647              
648             Move the key up in a ordered hash. Attempt to move up the first key of
649             an ordered hash is ignored. Ignored for non ordered hash.
650              
651             =head2 move_down
652              
653             Parameters: C<< ( key ) >>
654              
655             Move the key down in a ordered hash. Attempt to move up the last key of
656             an ordered hash is ignored. Ignored for non ordered hash.
657              
658             =head2 load_data
659              
660             Parameters: C<< ( data => ( hash_ref | array_ref ) [ , check => ... , ... ]) >>
661              
662             Load data as a hash ref for standard hash.
663              
664             Ordered hash should be loaded with an array ref or with a hash
665             containing a special C<__order> element. E.g. loaded with either:
666              
667             [ a => 'foo', b => 'bar' ]
668              
669             or
670              
671             { __order => ['a','b'], b => 'bar', a => 'foo' }
672              
673             C<__skip_order> parameter can be used if loading order is not
674             important:
675              
676             { __skip_order => 1, b => 'bar', a => 'foo'}
677              
678             load_data can also be called with a single ref parameter.
679              
680             =head2 get_info
681              
682             Returns a list of information related to the hash. See
683             L<Config::Model::Value/get_info> for more details.
684              
685             =head1 AUTHOR
686              
687             Dominique Dumont, (ddumont at cpan dot org)
688              
689             =head1 SEE ALSO
690              
691             L<Config::Model>,
692             L<Config::Model::Instance>,
693             L<Config::Model::AnyId>,
694             L<Config::Model::ListId>,
695             L<Config::Model::Value>
696              
697             =head1 AUTHOR
698              
699             Dominique Dumont
700              
701             =head1 COPYRIGHT AND LICENSE
702              
703             This software is Copyright (c) 2005-2022 by Dominique Dumont.
704              
705             This is free software, licensed under:
706              
707             The GNU Lesser General Public License, Version 2.1, February 1999
708              
709             =cut