home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / HistEntry.pm < prev    next >
Encoding:
Perl POD Document  |  2003-10-27  |  16.9 KB  |  696 lines
  1. # -*- perl -*-
  2.  
  3. #
  4. # $Id: HistEntry.pm,v 1.29 2003/10/27 22:15:03 eserte Exp $
  5. # Author: Slaven Rezic
  6. #
  7. # Copyright ⌐ 1997, 2000, 2001, 2003 Slaven Rezic. All rights reserved.
  8. # This package is free software; you can redistribute it and/or
  9. # modify it under the same terms as Perl itself.
  10. #
  11. # Mail: slaven@rezic.de
  12. # WWW:  http://www.cs.tu-berlin.de/~eserte/
  13. #
  14.  
  15. package Tk::HistEntry;
  16. require Tk;
  17. use strict;
  18. use vars qw($VERSION);
  19.  
  20. $VERSION = '0.42';
  21.  
  22. sub addBind {
  23.     my $w = shift;
  24.  
  25.     $w->_entry->bind('<Up>'        => sub { $w->historyUp });
  26.     $w->_entry->bind('<Control-p>' => sub { $w->historyUp });
  27.     $w->_entry->bind('<Down>'      => sub { $w->historyDown });
  28.     $w->_entry->bind('<Control-n>' => sub { $w->historyDown });
  29.  
  30.     $w->_entry->bind('<Meta-less>'    => sub { $w->historyBegin });
  31.     $w->_entry->bind('<Alt-less>'     => sub { $w->historyBegin });
  32.     $w->_entry->bind('<Meta-greater>' => sub { $w->historyEnd });
  33.     $w->_entry->bind('<Alt-greater>'  => sub { $w->historyEnd });
  34.  
  35.     $w->_entry->bind('<Control-r>' => sub { $w->searchBack });
  36.     $w->_entry->bind('<Control-s>' => sub { $w->searchForw });
  37.  
  38.     $w->_entry->bind('<Return>' => sub {
  39.          if ($w->cget(-command) || $w->cget(-auto)) {
  40.              $w->invoke;
  41.          }
  42.          });
  43.  
  44.     $w->_entry->bind('<Any-KeyPress>', sub {
  45.              my $e = $_[0]->XEvent;
  46.              $w->KeyPress($e->K, $e->s);
  47.              });
  48. }
  49.  
  50. # XXX del:
  51. #  sub _isdup {
  52. #      my($w, $string) = @_;
  53. #      foreach (@{ $w->privateData->{'history'} }) {
  54. #      return 1 if $_ eq $string;
  55. #      }
  56. #      0;
  57. #  }
  58.  
  59. sub _update {
  60.     my($w, $string) = @_;
  61.     $w->_entry->delete(0, 'end');
  62.     $w->_entry->insert('end', $string);
  63. }
  64.  
  65. sub _entry {
  66.     my $w = shift;
  67.     $w->Subwidget('entry') ? $w->Subwidget('entry') : $w;
  68. }
  69.  
  70. sub _listbox {
  71.     my $w = shift;
  72.     $w->Subwidget('slistbox') ? $w->Subwidget('slistbox') : $w;
  73. }
  74.  
  75. sub _listbox_method {
  76.     my $w = shift;
  77.     my $meth = shift;
  78.     if ($w->_has_listbox) {
  79.     $w->_listbox->$meth(@_);
  80.     }
  81. }
  82.  
  83. sub _has_listbox { $_[0]->Subwidget('slistbox') }
  84.  
  85. sub historyAdd {
  86.     my($w, $string, %args) = @_;
  87.  
  88.     $string = $w->_entry->get unless defined $string;
  89.     return undef if !defined $string || $string eq '';
  90.  
  91.     my $history = $w->privateData->{'history'};
  92.     if (!@$history or $string ne $history->[-1]) {
  93.     my $spliced = 0;
  94.     if (!$w->cget(-dup)) {
  95.         for(my $i = 0; $i<=$#$history; $i++) {
  96.         if ($string eq $history->[$i]) {
  97.             splice @$history, $i, 1;
  98.             $spliced++;
  99.             last;
  100.         }
  101.         }
  102.     }
  103.  
  104.     push @$history, $string;
  105.     if (defined $w->cget(-limit) &&
  106.         @$history > $w->cget(-limit)) {
  107.         shift @$history;
  108.     }
  109.     $w->privateData->{'historyindex'} = $#$history + 1;
  110.  
  111.     my @ret = $string;
  112.     if ($args{-spliceinfo}) {
  113.         push @ret, $spliced;
  114.     }
  115.     return @ret;
  116.     }
  117.     undef;
  118. }
  119. # compatibility with Term::ReadLine
  120. *addhistory = \&historyAdd;
  121.  
  122. sub historyUpdate {
  123.     my $w = shift;
  124.     $w->_update($w->privateData->{'history'}->[$w->privateData->{'historyindex'}]);
  125.     $w->_entry->icursor('end'); # suggestion by Jason Smith <smithj4@rpi.edu>
  126.     $w->_entry->xview('insert');
  127. }
  128.  
  129. sub historyUp {
  130.     my $w = shift;
  131.     if ($w->privateData->{'historyindex'} > 0) {
  132.         $w->privateData->{'historyindex'}--;
  133.     $w->historyUpdate;
  134.     } else {
  135.     $w->_bell;
  136.     }
  137. }
  138.  
  139. sub historyDown {
  140.     my $w = shift;
  141.     if ($w->privateData->{'historyindex'} <= $#{$w->privateData->{'history'}}) {
  142.     $w->privateData->{'historyindex'}++;
  143.     $w->historyUpdate;
  144.     } else {
  145.     $w->_bell;
  146.     }
  147. }
  148.  
  149. sub historyBegin {
  150.     my $w = shift;
  151.     $w->privateData->{'historyindex'} = 0;
  152.     $w->historyUpdate;
  153. }
  154.  
  155. sub historyEnd {
  156.     my $w = shift;
  157.     $w->privateData->{'historyindex'} = $#{$w->privateData->{'history'}};
  158.     $w->historyUpdate;
  159. }
  160.  
  161. sub historySet {
  162.     my($w, $index) = @_;
  163.     my $i;
  164.     my $history_ref = $w->privateData->{'history'};
  165.     for($i = $#{ $history_ref }; $i >= 0; $i--) {
  166.     if ($index eq $history_ref->[$i]) {
  167.         $w->privateData->{'historyindex'} = $i;
  168.         last;
  169.     }
  170.     }
  171. }
  172.  
  173. sub historyReset {
  174.     my $w = shift;
  175.     $w->privateData->{'history'} = [];
  176.     $w->privateData->{'historyindex'} = 0;
  177.     $w->_listbox_method("delete", 0, "end");
  178. }
  179.  
  180. sub historySave {
  181.     my($w, $file) = @_;
  182.     open(W, ">$file") or die "Can't save to file $file";
  183.     print W join("\n", $w->history) . "\n";
  184.     close W;
  185. }
  186.  
  187. # XXX document
  188. sub historyMergeFromFile {
  189.     my($w, $file) = @_;
  190.     if (open(W, "<$file")) {
  191.     while(<W>) {
  192.         chomp;
  193.         $w->historyAdd($_);
  194.     }
  195.     close W;
  196.     }
  197. }
  198.  
  199. sub history {
  200.     my($w, $history) = @_;
  201.     if (defined $history) {
  202.     $w->privateData->{'history'} = [ @$history ];
  203.     $w->privateData->{'historyindex'} =
  204.       $#{$w->privateData->{'history'}} + 1;
  205.     }
  206.     @{ $w->privateData->{'history'} };
  207. }
  208.  
  209. sub searchBack {
  210.     my $w = shift;
  211.     my $i = $w->privateData->{'historyindex'}-1;
  212.     while ($i >= 0) {
  213.     my $search = $w->_entry->get;
  214.         if ($search eq substr($w->privateData->{'history'}->[$i], 0,
  215.                   length($search))) {
  216.         $w->privateData->{'historyindex'} = $i;
  217.         $w->_update($w->privateData->{'history'}->[$w->privateData->{'historyindex'}]);
  218.             return;
  219.         }
  220.         $i--;
  221.     }
  222.     $w->_bell;
  223. }
  224.  
  225. sub searchForw {
  226.     my $w = shift;
  227.     my $i = $w->privateData->{'historyindex'}+1;
  228.     while ($i <= $#{$w->privateData->{'history'}}) {
  229.     my $search = $w->_entry->get;
  230.         if ($search eq substr($w->privateData->{'history'}->[$i], 0,
  231.                   length($search))) {
  232.         $w->privateData->{'historyindex'} = $i;
  233.         $w->_update($w->privateData->{'history'}->[$w->privateData->{'historyindex'}]);
  234.             return;
  235.         }
  236.         $i++;
  237.     }
  238.     $w->_bell;
  239. }
  240.  
  241. sub invoke {
  242.     my($w, $string) = @_;
  243.     $string = $w->_entry->get if !defined $string;
  244.     return unless defined $string;
  245.     my $added = defined $w->historyAdd($string);
  246.     $w->Callback(-command => $w, $string, $added);
  247. }
  248.  
  249. sub _bell {
  250.     my $w = shift;
  251.     return unless $w->cget(-bell);
  252.     $w->bell;
  253. }
  254.  
  255. sub KeyPress {
  256.     my($w, $key, $state) = @_;
  257.     my $e = $w->_entry;
  258.     my(@history) = reverse $w->history;
  259.     $w->{end} = $#history; # XXXXXXXX?
  260.     return if ($key =~ /^Shift|^Control|^Left|^Right|^Home|^End/);
  261.     return if ($state =~ /^Control-/);
  262.     if ($key eq 'Tab') {
  263.     # Tab doesn't trigger FocusOut event so clear selection
  264.     $e->selection('clear');
  265.     return;
  266.     }
  267.     return if (!$w->cget(-match));
  268.  
  269.     $e->update;
  270.     my $cursor = $e->index('insert');
  271.  
  272.     if ($key eq 'BackSpace' or $key eq 'Delete') {
  273.     $w->{start} = 0;
  274.     $w->{end} = $#history;
  275.     return;
  276.     }
  277.  
  278.     my $text = $e->get;
  279.     ###Grab test from entry upto cursor
  280.     (my $typedtext = $text) =~ s/^(.{$cursor})(.*)/$1/;
  281.     if ($2 ne "") {
  282.     ###text after cursor, do not use matching
  283.     return;
  284.     }
  285.  
  286.     if ($cursor == 0 || $text eq '') {
  287.     ###No text before cursor, reset list
  288.     $w->{start} = 0;
  289.     $w->{end} = $#history;
  290.     $e->delete(0, 'end');
  291.     $e->insert(0,'');
  292.     } else {
  293.     my $start = $w->{start};
  294.     my $end = $w->{end};
  295.     my ($newstart, $newend);
  296.  
  297.     ###Locate start of matching & end of matching
  298.     my $caseregex = ($w->cget(-case) ? "(?i)" : "");
  299.     for (; $start <= $end; $start++) {
  300.         if ($history[$start] =~ /^$caseregex\Q$typedtext\E/) {
  301.         $newstart = $start if (!defined $newstart);
  302.         $newend = $start;
  303.         } else {
  304.         last if (defined $newstart);
  305.         }
  306.     }
  307.  
  308.     if (defined $newstart) {
  309.         $e->selection('clear');
  310.         $e->delete(0, 'end');
  311.         $e->insert(0, $history[$newstart]);
  312.         $e->selection('range',$cursor,'end');
  313.         $e->icursor($cursor);
  314.         $w->{start} = $newstart;
  315.         $w->{end} = $newend;
  316.     } else {
  317.         $w->{end} = -1;
  318.     }
  319.     }
  320. }
  321.  
  322. ######################################################################
  323.  
  324. package Tk::HistEntry::Simple;
  325. require Tk::Entry;
  326. use vars qw(@ISA);
  327. @ISA = qw(Tk::Derived Tk::Entry Tk::HistEntry);
  328. #use base qw(Tk::Derived Tk::Entry Tk::HistEntry);
  329. Construct Tk::Widget 'SimpleHistEntry';
  330.  
  331. sub CreateArgs {
  332.     my($package, $parent, $args) = @_;
  333.     $args->{-class} = "SimpleHistEntry" unless exists $args->{-class};
  334.     $package->SUPER::CreateArgs($parent, $args);
  335. }
  336.  
  337. sub Populate {
  338.     my($w, $args) = @_;
  339.  
  340.     $w->historyReset;
  341.  
  342.     $w->SUPER::Populate($args);
  343.  
  344.     $w->Advertise(entry => $w);
  345.  
  346.     $w->{start} = 0;
  347.     $w->{end} = 0;
  348.  
  349.     $w->addBind;
  350.  
  351.     $w->ConfigSpecs
  352.       (-command => ['CALLBACK', 'command', 'Command', undef],
  353.        -auto    => ['PASSIVE',  'auto',    'Auto',    0],
  354.        -dup     => ['PASSIVE',  'dup',     'Dup',     1],
  355.        -bell    => ['PASSIVE',  'bell',    'Bell',    1],
  356.        -limit   => ['PASSIVE',  'limit',   'Limit',   undef],
  357.        -match   => ['PASSIVE',  'match',   'Match',   0],
  358.        -case    => ['PASSIVE',  'case',    'Case',    1],
  359.        -history => ['METHOD'],
  360.       );
  361.  
  362.     $w;
  363. }
  364.  
  365.  
  366. ######################################################################
  367. package Tk::HistEntry::Browse;
  368. require Tk::BrowseEntry;
  369. use vars qw(@ISA);
  370. @ISA = qw(Tk::Derived Tk::BrowseEntry Tk::HistEntry);
  371. #use base qw(Tk::Derived Tk::BrowseEntry Tk::HistEntry);
  372. Construct Tk::Widget 'HistEntry';
  373.  
  374. sub CreateArgs {
  375.     my($package, $parent, $args) = @_;
  376.     $args->{-class} = "HistEntry" unless exists $args->{-class};
  377.     $package->SUPER::CreateArgs($parent, $args);
  378. }
  379.  
  380. sub Populate {
  381.     my($w, $args) = @_;
  382.  
  383.     $w->historyReset;
  384.  
  385.     if ($Tk::VERSION >= 800) {
  386.     $w->SUPER::Populate($args);
  387.     } else {
  388.     my $saveargs;
  389.     foreach (qw(-auto -command -dup -bell -limit -match -case)) {
  390.         if (exists $args->{$_}) {
  391.         $saveargs->{$_} = delete $args->{$_};
  392.         }
  393.     }
  394.     $w->SUPER::Populate($args);
  395.     foreach (keys %$saveargs) {
  396.         $args->{$_} = $saveargs->{$_};
  397.     }
  398.     }
  399.  
  400.     $w->addBind;
  401.  
  402.     $w->{start} = 0;
  403.     $w->{end} = 0;
  404.  
  405.     my $entry = $w->Subwidget('entry');
  406.  
  407.     $w->ConfigSpecs
  408.       (-command => ['CALLBACK', 'command', 'Command', undef],
  409.        -auto    => ['PASSIVE',  'auto',    'Auto',    0],
  410.        -dup     => ['PASSIVE',  'dup',     'Dup',     1],
  411.        -bell    => ['PASSIVE',  'bell',    'Bell',    1],
  412.        -limit   => ['PASSIVE',  'limit',   'Limit',   undef],
  413.        -match   => ['PASSIVE',  'match',   'Match',   0],
  414.        -case    => ['PASSIVE',  'case',    'Case',    1],
  415.        -history => ['METHOD'],
  416.       );
  417.  
  418. ## Delegation does not work with the new BrowseEntry --- it seems to me
  419. ## that delegation only works for composites, not for derivates
  420. #    $w->Delegates('delete' => $entry,
  421. #          'get'    => $entry,
  422. #          'insert' => $entry,
  423. #         );
  424.  
  425.     $w;
  426. }
  427.  
  428. sub delete { shift->Subwidget('entry')->delete(@_) }
  429. sub get    { shift->Subwidget('entry')->get   (@_) }
  430. sub insert { shift->Subwidget('entry')->insert(@_) }
  431.  
  432. sub historyAdd {
  433.     my($w, $string) = @_;
  434.     my($inserted, $spliced) = $w->SUPER::historyAdd($string, -spliceinfo => 1);
  435.     if (defined $inserted) {
  436.     if ($spliced) {
  437.         $w->history([ $w->SUPER::history ]);
  438.     } else {
  439.         $w->_listbox_method("insert", 'end', $inserted);
  440.         # XXX Obeying -limit also for the array itself?
  441.         if (defined $w->cget(-limit) &&
  442.         $w->_listbox_method("size") > $w->cget(-limit)) {
  443.         $w->_listbox_method("delete", 0);
  444.         }
  445.     }
  446.     $w->_listbox_method("see", 'end');
  447.     return $inserted;
  448.     }
  449.     undef;
  450. }
  451. *addhistory = \&historyAdd;
  452.  
  453. sub history {
  454.     my($w, $history) = @_;
  455.     if (defined $history) {
  456.     $w->_listbox_method("delete", 0, 'end');
  457.     $w->_listbox_method("insert", 'end', @$history);
  458.     $w->_listbox_method("see", 'end');
  459.     }
  460.     $w->SUPER::history($history);
  461. }
  462.  
  463. 1;
  464.  
  465. =head1 NAME
  466.  
  467. Tk::HistEntry - Entry widget with history capability
  468.  
  469. =head1 SYNOPSIS
  470.  
  471.     use Tk::HistEntry;
  472.  
  473.     $hist1 = $top->HistEntry(-textvariable => \$var1);
  474.     $hist2 = $top->SimpleHistEntry(-textvariable => \$var2);
  475.  
  476. =head1 DESCRIPTION
  477.  
  478. C<Tk::HistEntry> defines entry widgets with history capabilities. The widgets
  479. come in two flavours:
  480.  
  481. =over 4
  482.  
  483. =item C<HistEntry> (in package C<Tk::HistEntry::Browse>) - with associated
  484. browse entry
  485.  
  486. =item C<SimpleHistEntry> (in package C<Tk::HistEntry::Simple>) - plain widget
  487. without browse entry
  488.  
  489. =back
  490.  
  491. The user may browse with the B<Up> and B<Down> keys through the history list.
  492. New history entries may be added either manually by binding the
  493. B<Return> key to B<historyAdd()> or
  494. automatically by setting the B<-command> option.
  495.  
  496. =head1 OPTIONS
  497.  
  498. B<HistEntry> is an descendant of B<BrowseEntry> and thus supports all of its
  499. standard options.
  500.  
  501. B<SimpleHistEntry> is an descendant of B<Entry> and supports all of the
  502. B<Entry> options.
  503.  
  504. In addition, the widgets support following specific options:
  505.  
  506. =over 4
  507.  
  508. =item B<-textvariable> or B<-variable>
  509.  
  510. Variable which is tied to the HistEntry widget. Either B<-textvariable> (like
  511. in Entry) or B<-variable> (like in BrowseEntry) may be used.
  512.  
  513. =item B<-command>
  514.  
  515. Specifies a callback, which is executed when the Return key was pressed or
  516. the B<invoke> method is called. The callback reveives three arguments:
  517. the reference to the HistEntry widget, the current textvariable value and
  518. a boolean value, which tells whether the string was added to the history
  519. list (e.g. duplicates and empty values are not added to the history list).
  520.  
  521. =item B<-dup>
  522.  
  523. Specifies whether duplicate entries are allowed in the history list. Defaults
  524. to true.
  525.  
  526. =item B<-bell>
  527.  
  528. If set to true, rings the bell if the user tries to move off of the history
  529. or if a search was not successful. Defaults to true.
  530.  
  531. =item B<-limit>
  532.  
  533. Limits the number of history entries. Defaults to unlimited.
  534.  
  535. =item B<-match>
  536.  
  537. Turns auto-completion on.
  538.  
  539. =item B<-case>
  540.  
  541. If set to true a true value, then be case sensitive on
  542. auto-completion. Defaults to 1.
  543.  
  544. =back
  545.  
  546. =head1 METHODS
  547.  
  548. =over 4
  549.  
  550. =item B<historyAdd(>[I<string>]B<)>
  551.  
  552. Adds string (or the current textvariable value if not set) manually to the
  553. history list. B<addhistory> is an alias for B<historyAdd>. Returns the
  554. added string or undef if no addition was made.
  555.  
  556. =item B<invoke(>[I<string>]B<)>
  557.  
  558. Invokes the command specified with B<-command>.
  559.  
  560. =item B<history(>[I<arrayref>]B<)>
  561.  
  562. Without argument, returns the current history list. With argument (a
  563. reference to an array), replaces the history list.
  564.  
  565. =item B<historySave(>I<file>B<)>
  566.  
  567. Save the history list to the named file.
  568.  
  569. =item B<historyMergeFromFile(>I<file>B<)>
  570.  
  571. Merge the history list from the named file to the end of the current
  572. history list of the widget.
  573.  
  574. =item B<historyReset>
  575.  
  576. Remove all entries from the history list.
  577.  
  578. =back
  579.  
  580. =head1 KEY BINDINGS
  581.  
  582. =over 4
  583.  
  584. =item B<Up>, B<Control-p>
  585.  
  586. Selects the previous history entry.
  587.  
  588. =item B<Down>, B<Control-n>
  589.  
  590. Selects the next history entry.
  591.  
  592. =item B<Meta-E<lt>>, B<Alt-E<lt>>
  593.  
  594. Selects first entry.
  595.  
  596. =item B<Meta-E<gt>>, B<Alt-E<gt>>
  597.  
  598. Selects last entry.
  599.  
  600. =item B<Control-r>
  601.  
  602. The current content of the widget is searched backward in the history.
  603.  
  604. =item B<Control-s>
  605.  
  606. The current content of the widget is searched forward in the history.
  607.  
  608. =item B<Return>
  609.  
  610. If B<-command> is set, adds current content to the history list and
  611. executes the associated callback.
  612.  
  613. =back
  614.  
  615. =head1 EXAMPLE
  616.  
  617. This is an simple example for Tk::HistEntry. More examples can be
  618. found in the t and examples directories of the source distribution.
  619.  
  620.     use Tk;
  621.     use Tk::HistEntry;
  622.  
  623.     $top = new MainWindow;
  624.     $he = $top->HistEntry(-textvariable => \$foo,
  625.                           -command => sub {
  626.                               # automatically adds $foo to history
  627.                               print STDERR "Do something with $foo\n";
  628.                           })->pack;
  629.     $b = $top->Button(-text => 'Do it',
  630.                       -command => sub { $he->invoke })->pack;
  631.     MainLoop;
  632.  
  633. If you like to not depend on the installation of Tk::HistEntry, you
  634. can write something like this:
  635.  
  636.     $Entry = "Entry"; # default Entry widget
  637.     eval {
  638.         # try loading the module, otherwise $Entry is left to the value "Entry"
  639.     require Tk::HistEntry;
  640.     $Entry = "SimpleHistEntry";
  641.     };
  642.     $entry = $mw->$Entry(-textvariable => \$res)->pack;
  643.     $entry->bind("<Return>" => sub {
  644.                                    # check whether the historyAdd method is
  645.                            # known to the widget
  646.                            if ($entry->can('historyAdd')) {
  647.                        $entry->historyAdd;
  648.                    }
  649.                                });
  650.  
  651. In this approach the history lives in an array variable. Here the
  652. entry widget does not need to be permanent, that is, it is possible to
  653. destroy the containing window and restore the history again:
  654.  
  655.     $Entry = "Entry";
  656.     eval {
  657.     require Tk::HistEntry;
  658.         $Entry = "HistEntry";
  659.     };
  660.     $entry = $mw->$Entry(-textvariable => \$res)->pack;
  661.     if ($entry->can('history') && @history) {
  662.     $entry->history(\@history);
  663.     }
  664.  
  665.     # Later, after clicking on a hypothetical "Ok" button:
  666.     if ($res ne "" && $entry->can('historyAdd')) {
  667.         $entry->historyAdd($res);
  668.     @history = $entry->history;
  669.     }
  670.  
  671.  
  672. =head1 BUGS/TODO
  673.  
  674.  - C-s/C-r do not work as nice as in gnu readline
  675.  - use -browsecmd from Tk::BrowseEntry
  676.  - use Tie::Array if present
  677.  
  678. =head1 AUTHOR
  679.  
  680. Slaven Rezic <slaven@rezic.de>
  681.  
  682. =head1 CREDITS
  683.  
  684. Thanks for Jason Smith <smithj4@rpi.edu> and Benny Khoo
  685. <kkhoo1@penang.intel.com> for their suggestions. The auto-completion
  686. code is stolen from Tk::IntEntry by Dave Collins
  687. <Dave.Collins@tiuk.ti.com>.
  688.  
  689. =head1 COPYRIGHT
  690.  
  691. Copyright (c) 1997, 2000, 2001, 2003 Slaven Rezic. All rights reserved.
  692. This package is free software; you can redistribute it and/or
  693. modify it under the same terms as Perl itself.
  694.  
  695. =cut
  696.