]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXUser.pm
probably fix Script erase error
[spider.git] / perl / DXUser.pm
1 #
2 # DX cluster user routines
3 #
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
5 #
6 #
7 #
8
9 package DXUser;
10
11 use DXLog;
12 use DB_File;
13 use Data::Dumper;
14 use Fcntl;
15 use IO::File;
16 use DXDebug;
17 use DXUtil;
18 use LRU;
19 use File::Copy;
20
21 use strict;
22
23 use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3);
24
25 %u = ();
26 $dbm = undef;
27 $filename = undef;
28 $lastoperinterval = 60*24*60*60;
29 $lasttime = 0;
30 $lrusize = 2000;
31 $tooold = 86400 * 365;          # this marks an old user who hasn't given enough info to be useful
32 $v3 = 0;
33 our $maxconnlist = 3;                   # remember this many connection time (duration) [start, end] pairs
34
35 # hash of valid elements and a simple prompt
36 %valid = (
37                   call => '0,Callsign',
38                   alias => '0,Real Callsign',
39                   name => '0,Name',
40                   qth => '0,Home QTH',
41                   lat => '0,Latitude,slat',
42                   long => '0,Longitude,slong',
43                   qra => '0,Locator',
44                   email => '0,E-mail Address,parray',
45                   priv => '9,Privilege Level',
46                   lastin => '0,Last Time in,cldatetime',
47                   passwd => '9,Password,yesno',
48                   passphrase => '9,Pass Phrase,yesno',
49                   addr => '0,Full Address',
50                   'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
51                   xpert => '0,Expert Status,yesno',
52                   bbs => '0,Home BBS',
53                   node => '0,Last Node',
54                   homenode => '0,Home Node',
55                   lockout => '9,Locked out?,yesno',     # won't let them in at all
56                   dxok => '9,Accept DX Spots?,yesno', # accept his dx spots?
57                   annok => '9,Accept Announces?,yesno', # accept his announces?
58                   lang => '0,Language',
59                   hmsgno => '0,Highest Msgno',
60                   group => '0,Group,parray',    # used to create a group of users/nodes for some purpose or other
61                   buddies => '0,Buddies,parray',
62                   isolate => '9,Isolate network,yesno',
63                   wantbeep => '0,Req Beep,yesno',
64                   wantann => '0,Req Announce,yesno',
65                   wantwwv => '0,Req WWV,yesno',
66                   wantwcy => '0,Req WCY,yesno',
67                   wantecho => '0,Req Echo,yesno',
68                   wanttalk => '0,Req Talk,yesno',
69                   wantwx => '0,Req WX,yesno',
70                   wantdx => '0,Req DX Spots,yesno',
71                   wantemail => '0,Req Msgs as Email,yesno',
72                   pagelth => '0,Current Pagelth',
73                   pingint => '9,Node Ping interval',
74                   nopings => '9,Ping Obs Count',
75                   wantlogininfo => '0,Login Info Req,yesno',
76           wantgrid => '0,Show DX Grid,yesno',
77                   wantann_talk => '0,Talklike Anns,yesno',
78                   wantpc16 => '9,Want Users from node,yesno',
79                   wantsendpc16 => '9,Send PC16,yesno',
80                   wantroutepc19 => '9,Route PC19,yesno',
81                   wantusstate => '0,Show US State,yesno',
82                   wantdxcq => '0,Show CQ Zone,yesno',
83                   wantdxitu => '0,Show ITU Zone,yesno',
84                   wantgtk => '0,Want GTK interface,yesno',
85                   wantpc9x => '0,Want PC9X interface,yesno',
86                   lastoper => '9,Last for/oper,cldatetime',
87                   nothere => '0,Not Here Text',
88                   registered => '9,Registered?,yesno',
89                   prompt => '0,Required Prompt',
90                   version => '1,Version',
91                   build => '1,Build',
92                   believe => '1,Believable nodes,parray',
93                   lastping => '1,Last Ping at,ptimelist',
94                   maxconnect => '1,Max Connections',
95                   startt => '0,Start Time,cldatetime',
96                   connlist => '1,Connections,parraydifft',
97                  );
98
99 #no strict;
100 sub AUTOLOAD
101 {
102         no strict;
103         my $name = $AUTOLOAD;
104   
105         return if $name =~ /::DESTROY$/;
106         $name =~ s/^.*:://o;
107   
108         confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
109         # this clever line of code creates a subroutine which takes over from autoload
110         # from OO Perl - Conway
111         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
112        goto &$AUTOLOAD;
113 }
114
115 #use strict;
116
117 #
118 # initialise the system
119 #
120 sub init
121 {
122         my $mode = shift;
123   
124         my $ufn;
125         my $convert;
126         
127         eval {
128                 require Storable;
129         };
130
131         my $fn = "users";
132         
133         if ($@) {
134                 $ufn = localdata("users.v2");
135                 $v3 = $convert = 0;
136                 dbg("the module Storable appears to be missing!!");
137                 dbg("trying to continue in compatibility mode (this may fail)");
138                 dbg("please install Storable from CPAN as soon as possible");
139         } else {
140                 import Storable qw(nfreeze thaw);
141
142                 $ufn = localdata("users.v3");
143                 $v3 = 1;
144                 $convert++ if -e localdata("users.v2") && !-e $ufn;
145         }
146         
147         if ($mode) {
148                 $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
149         } else {
150                 $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
151         }
152
153         die "Cannot open $ufn ($!)\n" unless $dbm;
154
155         $lru = LRU->newbase("DXUser", $lrusize);
156         
157         # do a conversion if required
158         if ($dbm && $convert) {
159                 my ($key, $val, $action, $count, $err) = ('','',0,0,0);
160                 
161                 my %oldu;
162                 dbg("Converting the User File to V3 ");
163                 dbg("This will take a while, I suggest you go and have cup of strong tea");
164                 my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]";
165         for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
166                         my $ref;
167                         eval { $ref = asc_decode($val) };
168                         unless ($@) {
169                                 if ($ref) {
170                                         $ref->put;
171                                         $count++;
172                                 } else {
173                                         $err++
174                                 }
175                         } else {
176                                 Log('err', "DXUser: error decoding $@");
177                         }
178                 } 
179                 undef $odbm;
180                 untie %oldu;
181                 dbg("Conversion completed $count records $err errors");
182         }
183         $filename = $ufn;
184 }
185
186 sub del_file
187 {
188         # with extreme prejudice
189         unlink "$main::data/users.v3";
190         unlink "$main::local_data/users.v3";
191 }
192
193 #
194 # periodic processing
195 #
196 sub process
197 {
198         if ($main::systime > $lasttime + 15) {
199                 $dbm->sync if $dbm;
200                 $lasttime = $main::systime;
201         }
202 }
203
204 #
205 # close the system
206 #
207
208 sub finish
209 {
210         undef $dbm;
211         untie %u;
212 }
213
214 #
215 # new - create a new user
216 #
217
218 sub alloc
219 {
220         my $pkg = shift;
221         my $call = uc shift;
222         my $self = bless {call => $call, 'sort'=>'U'}, $pkg;
223         return $self;
224 }
225
226 sub new
227 {
228         my $pkg = shift;
229         my $call = shift;
230         #  $call =~ s/-\d+$//o;
231   
232 #       confess "can't create existing call $call in User\n!" if $u{$call};
233
234         my $self = $pkg->alloc($call);
235         $self->put;
236         return $self;
237 }
238
239 #
240 # get - get an existing user - this seems to return a different reference everytime it is
241 #       called - see below
242 #
243
244 sub get
245 {
246         my $call = uc shift;
247         my $data;
248         
249         # is it in the LRU cache?
250         my $ref = $lru->get($call);
251         return $ref if $ref && ref $ref eq 'DXUser';
252         
253         # search for it
254         unless ($dbm->get($call, $data)) {
255                 eval { $ref = decode($data); };
256                 
257                 if ($ref) {
258                         if (!UNIVERSAL::isa($ref, 'DXUser')) {
259                                 dbg("DXUser::get: got strange answer from decode of $call". ref $ref. " ignoring");
260                                 return undef;
261                         }
262                         # we have a reference and it *is* a DXUser
263                 } else {
264                         if ($@) {
265                                 LogDbg('err', "DXUser::get decode error on $call '$@'");
266                         } else {
267                                 dbg("DXUser::get: no reference returned from decode of $call $!");
268                         }
269                         return undef;
270                 }
271                 $lru->put($call, $ref);
272                 return $ref;
273         }
274         return undef;
275 }
276
277 #
278 # get an existing either from the channel (if there is one) or from the database
279 #
280 # It is important to note that if you have done a get (for the channel say) and you
281 # want access or modify that you must use this call (and you must NOT use get's all
282 # over the place willy nilly!)
283 #
284
285 sub get_current
286 {
287         my $call = uc shift;
288   
289         my $dxchan = DXChannel::get($call);
290         if ($dxchan) {
291                 my $ref = $dxchan->user;
292                 return $ref if $ref && UNIVERSAL::isa($ref, 'DXUser');
293
294                 dbg("DXUser::get_current: got invalid user ref for $call from dxchan $dxchan->{call} ". ref $ref. " ignoring");
295         }
296         return get($call);
297 }
298
299 #
300 # get all callsigns in the database 
301 #
302
303 sub get_all_calls
304 {
305         return (sort keys %u);
306 }
307
308 #
309 # put - put a user
310 #
311
312 sub put
313 {
314         my $self = shift;
315         confess "Trying to put nothing!" unless $self && ref $self;
316         my $call = $self->{call};
317
318         $dbm->del($call);
319         delete $self->{annok} if $self->{annok};
320         delete $self->{dxok} if $self->{dxok};
321
322         $lru->put($call, $self);
323         my $ref = $self->encode;
324         $dbm->put($call, $ref);
325 }
326
327 # freeze the user
328 sub encode
329 {
330         goto &asc_encode unless $v3;
331         my $self = shift;
332         return nfreeze($self);
333 }
334
335 # thaw the user
336 sub decode
337 {
338         goto &asc_decode unless $v3;
339         my $ref;
340         $ref = thaw(shift);
341         return $ref;
342 }
343
344
345 # create a string from a user reference (in_ascii)
346 #
347 sub asc_encode
348 {
349         my $self = shift;
350         my $strip = shift;
351         my $p;
352
353         if ($strip) {
354                 my $ref = bless {}, ref $self;
355                 foreach my $k (qw(qth lat long qra sort call homenode node lastoper lastin)) {
356                         $ref->{$k} = $self->{$k} if exists $self->{$k};
357                 }
358                 $ref->{name} = $self->{name} if exists $self->{name} && $self->{name} !~ /selfspot/i;
359                 $p = dd($ref);
360         } else {
361                 $p = dd($self);
362         }
363         return $p;
364 }
365
366 #
367 # create a hash from a string (in ascii)
368 #
369 sub asc_decode
370 {
371         my $s = shift;
372         my $ref;
373         $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
374         eval '$ref = ' . $s;
375         if ($@) {
376                 LogDbg('err', "DXUser::asc_decode: on '$s' $@");
377                 $ref = undef;
378         }
379         return $ref;
380 }
381
382 #
383 # del - delete a user
384 #
385
386 sub del
387 {
388         my $self = shift;
389         my $call = $self->{call};
390         $lru->remove($call);
391         $dbm->del($call);
392 }
393
394 #
395 # close - close down a user
396 #
397
398 sub close
399 {
400         my $self = shift;
401         my $startt = shift;
402         my $ip = shift;
403         $self->{lastin} = $main::systime;
404         # add a record to the connect list
405         my $ref = [$startt || $self->{startt}, $main::systime];
406         push @$ref, $ip if $ip;
407         push @{$self->{connlist}}, $ref;
408         shift @{$self->{connlist}} if @{$self->{connlist}} > $maxconnlist;
409         $self->put();
410 }
411
412 #
413 # sync the database
414 #
415
416 sub sync
417 {
418         $dbm->sync;
419 }
420
421 #
422 # return a list of valid elements 
423
424
425 sub fields
426 {
427         return keys(%valid);
428 }
429
430
431 #
432 # export the database to an ascii file
433 #
434
435 sub export
436 {
437         my $name = shift || 'user_asc';
438         my $basic_info_only = shift;
439
440         my $fn = $name ne 'user_asc' ? $name : "$main::local_data/$name";                       # force use of local
441         
442         # save old ones
443         move "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
444         move "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
445         move "$fn.oo", "$fn.ooo" if -e "$fn.oo";
446         move "$fn.o", "$fn.oo" if -e "$fn.o";
447         move "$fn", "$fn.o" if -e "$fn";
448
449         my $count = 0;
450         my $err = 0;
451         my $del = 0;
452         my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)";
453         if ($fh) {
454                 my $key = 0;
455                 my $val = undef;
456                 my $action;
457                 my $t = scalar localtime;
458                 print $fh q{#!/usr/bin/perl
459 #
460 # The exported userfile for a DXSpider System
461 #
462 # Input file: $filename
463 #       Time: $t
464 #
465                         
466 package main;
467                         
468 # search local then perl directories
469 BEGIN {
470         umask 002;
471                                 
472         # root of directory tree for this system
473         $root = "/spider"; 
474         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
475         
476         unshift @INC, "$root/perl";     # this IS the right way round!
477         unshift @INC, "$root/local";
478         
479         # try to detect a lockfile (this isn't atomic but 
480         # should do for now
481         $lockfn = "$root/local_data/cluster.lck";       # lock file name
482         if (-e $lockfn) {
483                 open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
484                 my $pid = <CLLOCK>;
485                 chomp $pid;
486                 die "Lockfile ($lockfn) and process $pid exists - cluster must be stopped first\n" if kill 0, $pid;
487                 close CLLOCK;
488         }
489 }
490
491 use SysVar;
492 use DXUser;
493
494 if (@ARGV) {
495         $main::userfn = shift @ARGV;
496         print "user filename now $userfn\n";
497 }
498
499 package DXUser;
500
501 del_file();
502 init(1);
503 %u = ();
504 my $count = 0;
505 my $err = 0;
506 while (<DATA>) {
507         chomp;
508         my @f = split /\t/;
509         my $ref = asc_decode($f[1]);
510         if ($ref) {
511                 $ref->put();
512                 $count++;
513         DXUser::sync() unless $count % 10000;
514         } else {
515                 print "# Error: $f[0]\t$f[1]\n";
516                 $err++
517         }
518 }
519 DXUser::sync(); DXUser::finish();
520 print "There are $count user records and $err errors\n";
521 };
522                 print $fh "__DATA__\n";
523
524         for ($action = R_FIRST; !$dbm->seq($key, $val, $action); $action = R_NEXT) {
525                         if (!is_callsign($key) || $key =~ /^0/) {
526                                 my $eval = $val;
527                                 my $ekey = $key;
528                                 $eval =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
529                                 $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
530                                 LogDbg('DXCommand', "Export Error1: $ekey\t$eval");
531                                 eval {$dbm->del($key)};
532                                 dbg(carp("Export Error1: $ekey\t$eval\n$@")) if $@;
533                                 ++$err;
534                                 next;
535                         }
536                         my $ref;
537                         eval {$ref = decode($val); };
538                         if ($ref) {
539                                 my $t = $ref->{lastin} || 0;
540                                 if ($ref->is_user && !$ref->{priv} && $main::systime > $t + $tooold) {
541                                         unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) {
542                                                 eval {$dbm->del($key)};
543                                                 dbg(carp("Export Error2: $key\t$val\n$@")) if $@;
544                                                 LogDbg('DXCommand', "$ref->{call} deleted, too old");
545                                                 $del++;
546                                                 next;
547                                         }
548                                 }
549                                 # only store users that are reasonably active or have useful information
550                                 print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n";
551                                 ++$count;
552                         } else {
553                                 LogDbg('DXCommand', "Export Error3: $key\t" . carp($val) ."\n$@");
554                                 eval {$dbm->del($key)};
555                                 dbg(carp("Export Error3: $key\t$val\n$@")) if $@;
556                                 ++$err;
557                         }
558                 } 
559         $fh->close;
560     }
561         my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors ('sh/log Export' for details)};
562         LogDbg('command', $s);
563         return $s;
564 }
565
566 #
567 # group handling
568 #
569
570 # add one or more groups
571 sub add_group
572 {
573         my $self = shift;
574         my $ref = $self->{group} || [ 'local' ];
575         $self->{group} = $ref if !$self->{group};
576         push @$ref, @_ if @_;
577 }
578
579 # remove one or more groups
580 sub del_group
581 {
582         my $self = shift;
583         my $ref = $self->{group} || [ 'local' ];
584         my @in = @_;
585         
586         $self->{group} = $ref if !$self->{group};
587         
588         @$ref = map { my $a = $_; return (grep { $_ eq $a } @in) ? () : $a } @$ref;
589 }
590
591 # does this thing contain all the groups listed?
592 sub union
593 {
594         my $self = shift;
595         my $ref = $self->{group};
596         my $n;
597         
598         return 0 if !$ref || @_ == 0;
599         return 1 if @$ref == 0 && @_ == 0;
600         for ($n = 0; $n < @_; ) {
601                 for (@$ref) {
602                         my $a = $_;
603                         $n++ if grep $_ eq $a, @_; 
604                 }
605         }
606         return $n >= @_;
607 }
608
609 # simplified group test just for one group
610 sub in_group
611 {
612         my $self = shift;
613         my $s = shift;
614         my $ref = $self->{group};
615         
616         return 0 if !$ref;
617         return grep $_ eq $s, $ref;
618 }
619
620 # set up a default group (only happens for them's that connect direct)
621 sub new_group
622 {
623         my $self = shift;
624         $self->{group} = [ 'local' ];
625 }
626
627 # set up empty buddies (only happens for them's that connect direct)
628 sub new_buddies
629 {
630         my $self = shift;
631         $self->{buddies} = [  ];
632 }
633
634 #
635 # return a prompt for a field
636 #
637
638 sub field_prompt
639
640         my ($self, $ele) = @_;
641         return $valid{$ele};
642 }
643
644 # some variable accessors
645 sub sort
646 {
647         my $self = shift;
648         @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
649 }
650
651 # some accessors
652
653 # want is default = 1
654 sub _want
655 {
656         my $n = shift;
657         my $self = shift;
658         my $val = shift;
659         my $s = "want$n";
660         $self->{$s} = $val if defined $val;
661         return exists $self->{$s} ? $self->{$s} : 1;
662 }
663
664 # wantnot is default = 0
665 sub _wantnot
666 {
667         my $n = shift;
668         my $self = shift;
669         my $val = shift;
670         my $s = "want$n";
671         $self->{$s} = $val if defined $val;
672         return exists $self->{$s} ? $self->{$s} : 0;
673 }
674
675 sub wantbeep
676 {
677         return _want('beep', @_);
678 }
679
680 sub wantann
681 {
682         return _want('ann', @_);
683 }
684
685 sub wantwwv
686 {
687         return _want('wwv', @_);
688 }
689
690 sub wantwcy
691 {
692         return _want('wcy', @_);
693 }
694
695 sub wantecho
696 {
697         return _want('echo', @_);
698 }
699
700 sub wantwx
701 {
702         return _want('wx', @_);
703 }
704
705 sub wantdx
706 {
707         return _want('dx', @_);
708 }
709
710 sub wanttalk
711 {
712         return _want('talk', @_);
713 }
714
715 sub wantgrid
716 {
717         return _want('grid', @_);
718 }
719
720 sub wantemail
721 {
722         return _want('email', @_);
723 }
724
725 sub wantann_talk
726 {
727         return _want('ann_talk', @_);
728 }
729
730 sub wantpc16
731 {
732         return _want('pc16', @_);
733 }
734
735 sub wantsendpc16
736 {
737         return _want('sendpc16', @_);
738 }
739
740 sub wantroutepc16
741 {
742         return _want('routepc16', @_);
743 }
744
745 sub wantusstate
746 {
747         return _want('usstate', @_);
748 }
749
750 sub wantdxcq
751 {
752         return _want('dxcq', @_);
753 }
754
755 sub wantdxitu
756 {
757         return _want('dxitu', @_);
758 }
759
760 sub wantgtk
761 {
762         return _want('gtk', @_);
763 }
764
765 sub wantpc9x
766 {
767         return _want('pc9x', @_);
768 }
769
770 sub wantlogininfo
771 {
772         my $self = shift;
773         my $val = shift;
774         $self->{wantlogininfo} = $val if defined $val;
775         return $self->{wantlogininfo};
776 }
777
778 sub is_node
779 {
780         my $self = shift;
781         return $self->{sort} =~ /^[ACRSX]$/;
782 }
783
784 sub is_local_node
785 {
786         my $self = shift;
787         return grep $_ eq 'local_node', @{$self->{group}};
788 }
789
790 sub is_user
791 {
792         my $self = shift;
793         return $self->{sort} =~ /^[UW]$/;
794 }
795
796 sub is_web
797 {
798         my $self = shift;
799         return $self->{sort} eq 'W';
800 }
801
802 sub is_bbs
803 {
804         my $self = shift;
805         return $self->{sort} eq 'B';
806 }
807
808 sub is_spider
809 {
810         my $self = shift;
811         return $self->{sort} eq 'S';
812 }
813
814 sub is_clx
815 {
816         my $self = shift;
817         return $self->{sort} eq 'C';
818 }
819
820 sub is_dxnet
821 {
822         my $self = shift;
823         return $self->{sort} eq 'X';
824 }
825
826 sub is_arcluster
827 {
828         my $self = shift;
829         return $self->{sort} eq 'R';
830 }
831
832 sub is_ak1a
833 {
834         my $self = shift;
835         return $self->{sort} eq 'A';
836 }
837
838 sub unset_passwd
839 {
840         my $self = shift;
841         delete $self->{passwd};
842 }
843
844 sub unset_passphrase
845 {
846         my $self = shift;
847         delete $self->{passphrase};
848 }
849
850 sub set_believe
851 {
852         my $self = shift;
853         my $call = uc shift;
854         $self->{believe} ||= [];
855         push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}};
856 }
857
858 sub unset_believe
859 {
860         my $self = shift;
861         my $call = uc shift;
862         if (exists $self->{believe}) {
863                 $self->{believe} = [grep {$_ ne $call} @{$self->{believe}}];
864                 delete $self->{believe} unless @{$self->{believe}};
865         }
866 }
867
868 sub believe
869 {
870         my $self = shift;
871         return exists $self->{believe} ? @{$self->{believe}} : ();
872 }
873
874 sub lastping
875 {
876         my $self = shift;
877         my $call = shift;
878         $self->{lastping} ||= {};
879         $self->{lastping} = {} unless ref $self->{lastping};
880         my $b = $self->{lastping};
881         $b->{$call} = shift if @_;
882         return $b->{$call};     
883 }
884 1;
885 __END__
886
887
888
889
890