source: perl/lib/BarnOwl.pm @ 78b9503

Last change on this file since 78b9503 was 104a4eb, checked in by David Benjamin <davidben@mit.edu>, 10 years ago
Accept validsettings in new_variable_string If people reeeaaally want to, I suppose they could pass in "<path>" or something silly. Whatever.
  • Property mode set to 100644
File size: 21.2 KB
RevLine 
[ee183be]1use strict;
2use warnings;
3
4package BarnOwl;
5
[2be605a]6use base qw(Exporter);
[b303ba2]7our @EXPORT_OK = qw(command getcurmsg getnumcols getnumlines getidletime
[2be605a]8                    zephyr_getsender zephyr_getrealm zephyr_zwrite
9                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
10                    queue_message admin_message
[e89ec48]11                    start_edit
[2be605a]12                    start_question start_password start_edit_win
13                    get_data_dir get_config_dir popless_text popless_ztext
[eede1bf]14                    error debug
[2be605a]15                    create_style getnumcolors wordwrap
[ffc4df6]16                    add_dispatch remove_dispatch
17                    add_io_dispatch remove_io_dispatch
[2be605a]18                    new_command
19                    new_variable_int new_variable_bool new_variable_string
[e26abb6]20                    new_variable_enum
[4df918b]21                    quote redisplay);
[2be605a]22our %EXPORT_TAGS = (all => \@EXPORT_OK);
23
[fd8dfe7]24BEGIN {
25# bootstrap in C bindings and glue
26    *owl:: = \*BarnOwl::;
27    bootstrap BarnOwl 1.2;
28};
29
30use lib(get_data_dir() . "/lib");
31use lib(get_config_dir() . "/lib");
32
[9179fd7]33use Glib;
34use AnyEvent;
35
[fd8dfe7]36use BarnOwl::Hook;
37use BarnOwl::Hooks;
38use BarnOwl::Message;
39use BarnOwl::Style;
[df569c5]40use BarnOwl::Zephyr;
[fd8dfe7]41use BarnOwl::Timer;
[cf26b72]42use BarnOwl::Editwin;
[8eac1a5]43use BarnOwl::Completion;
[b30c256]44use BarnOwl::Help;
[fd8dfe7]45
[6700c605]46use List::Util qw(max);
47
[ee183be]48=head1 NAME
49
50BarnOwl
51
52=head1 DESCRIPTION
53
54The BarnOwl module contains the core of BarnOwl's perl
55bindings. Source in this module is also run at startup to bootstrap
[b8a3e00]56BarnOwl by defining things like the default style.
[ee183be]57
58=for NOTE
59These following functions are defined in perlglue.xs. Keep the
60documentation here in sync with the user-visible commands defined
61there!
62
63=head2 command STRING
64
65Executes a BarnOwl command in the same manner as if the user had
66executed it at the BarnOwl command prompt. If the command returns a
67value, return it as a string, otherwise return undef.
68
69=head2 getcurmsg
70
71Returns the current message as a C<BarnOwl::Message> subclass, or
72undef if there is no message selected
73=head2 getnumcols
74
75Returns the width of the display window BarnOwl is currently using
76
77=head2 getidletime
78
79Returns the length of time since the user has pressed a key, in
80seconds.
81
82=head2 zephyr_getrealm
83
[b8a3e00]84Returns the zephyr realm BarnOwl is running in
[ee183be]85
86=head2 zephyr_getsender
87
[b8a3e00]88Returns the fully-qualified name of the zephyr sender BarnOwl is
[ee183be]89running as, e.g. C<nelhage@ATHENA.MIT.EDU>
90
91=head2 zephyr_zwrite COMMAND MESSAGE
92
93Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
94command line, and C<MESSAGE> is the zephyr body to send.
95
[374089a]96=cut
97
98sub zephyr_zwrite {
99    my ($command, $message) = @_;
100    my $ret = BarnOwl::Internal::zephyr_zwrite($command, $message);
101    die "Error sending zephyr" unless $ret == 0;
102}
103
[ee183be]104=head2 ztext_stylestrip STRING
105
106Strips zephyr formatting from a string and returns the result
107
108=head2 zephyr_getsubs
109
110Returns the list of subscription triples <class,instance,recipient>,
111separated by newlines.
112
113=head2 queue_message MESSAGE
114
115Enqueue a message in the BarnOwl message list, logging it and
116processing it appropriately. C<MESSAGE> should be an instance of
[e89ec48]117BarnOwl::Message or a subclass.
[ee183be]118
119=head2 admin_message HEADER BODY
120
121Display a BarnOwl B<Admin> message, with the given header and body.
122
[e89ec48]123=head2 start_edit %ARGS
[ee183be]124
[e89ec48]125Displays a prompt on the screen and lets the user enter text,
126and calls a callback when the editwin is closed.
[ee183be]127
[e89ec48]128C<%ARGS> must contain the following keys:
129
130=over 4
131
132=item prompt
133
134The line to display on the screen
135
136=item type
137
138One of:
139
140=over 4
141
142=item edit_win
143
144Displays the prompt on a line of its own and opens the edit_win.
145
146=item question
147
148Displays prompt on the screen and lets the user enter a line of
149text.
150
151=item password
[ee183be]152
[e89ec48]153Like question, but echoes the user's input as C<*>s when they
[ee183be]154input.
155
[e89ec48]156=back
157
158=item callback
159
160A Perl subroutine that is called when the user closes the edit_win.
[7803326]161C<CALLBACK> gets called with two parameters: the text the user entered,
162and a C<SUCCESS> boolean parameter which is false if the user canceled
163the edit_win and true otherwise.
[e89ec48]164
165=back
166
167=head2 start_question PROMPT CALLBACK
168
169=head2 start_password PROMPT CALLBACK
170
[ee183be]171=head2 start_edit_win PROMPT CALLBACK
172
[7803326]173Roughly equivalent to C<start_edit> called with the appropriate parameters.
174C<CALLBACK> is only called on success, for compatibility.
175
176These are deprecated wrappers around L<BarnOwl::start_edit>, and should not
177be uesd in new code.
[e89ec48]178
179=cut
180
181sub start_edit {
182    my %args = (@_);
183    BarnOwl::Internal::start_edit($args{type}, $args{prompt}, $args{callback});
184}
185
186sub start_question {
187    my ($prompt, $callback) = @_;
[7803326]188    BarnOwl::start_edit(type => 'question', prompt => $prompt, callback => sub {
189            my ($text, $success) = @_;
190            $callback->($text) if $success;
191        });
[e89ec48]192}
193
194sub start_password {
195    my ($prompt, $callback) = @_;
[7803326]196    BarnOwl::start_edit(type => 'password', prompt => $prompt, callback => sub {
197            my ($text, $success) = @_;
198            $callback->($text) if $success;
199        });
[e89ec48]200}
201
202sub start_edit_win {
203    my ($prompt, $callback) = @_;
[7803326]204    BarnOwl::start_edit(type => 'edit_win', prompt => $prompt, callback => sub {
205            my ($text, $success) = @_;
206            $callback->($text) if $success;
207        });
[e89ec48]208}
[ee183be]209
210=head2 get_data_dir
211
212Returns the BarnOwl system data directory, where system libraries and
213modules are stored
214
215=head2 get_config_dir
216
217Returns the BarnOwl user configuration directory, where user modules
218and configuration are stored (by default, C<$HOME/.owl>)
219
220=head2 popless_text TEXT
221
222Show a popup window containing the given C<TEXT>
223
224=head2 popless_ztext TEXT
225
226Show a popup window containing the provided zephyr-formatted C<TEXT>
227
228=head2 error STRING
229
230Reports an error and log it in `show errors'. Note that in any
231callback or hook called in perl code from BarnOwl, a C<die> will be
232caught and passed to C<error>.
233
[eede1bf]234=head2 debug STRING
235
236Logs a debugging message to BarnOwl's debug log
237
[ee183be]238=head2 getnumcolors
239
240Returns the number of colors this BarnOwl is capable of displaying
241
242=head2 add_dispatch FD CALLBACK
243
244Adds a file descriptor to C<BarnOwl>'s internal C<select()>
245loop. C<CALLBACK> will be invoked whenever data is available to be
246read from C<FD>.
247
[bcde7926]248C<add_dispatch> has been deprecated in favor of C<AnyEvent>, and is
249now a wrapper for C<add_io_dispatch> called with C<mode> set to
250C<'r'>.
[ffc4df6]251
252=cut
253
254sub add_dispatch {
255    my $fd = shift;
256    my $cb = shift;
257    add_io_dispatch($fd, 'r', $cb);
258}
259
[ee183be]260=head2 remove_dispatch FD
261
262Remove a file descriptor previously registered via C<add_dispatch>
263
[bcde7926]264C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
[ffc4df6]265
266=cut
267
268*remove_dispatch = \&remove_io_dispatch;
269
270=head2 add_io_dispatch FD MODE CB
271
272Adds a file descriptor to C<BarnOwl>'s internal C<select()>
273loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
274whenever C<FD> becomes ready, as specified by <MODE>.
275
276Only one callback can be registered per FD. If a new callback is
277registered, the old one is removed.
278
[bcde7926]279C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
280
[ffc4df6]281=cut
282
[bcde7926]283our %_io_dispatches;
284
[ffc4df6]285sub add_io_dispatch {
286    my $fd = shift;
287    my $modeStr = shift;
288    my $cb = shift;
[bcde7926]289    my @modes;
290
291    push @modes, 'r' if $modeStr =~ /r/i; # Read
292    push @modes, 'w' if $modeStr =~ /w/i; # Write
293    if (@modes) {
294        BarnOwl::remove_io_dispatch($fd);
295        for my $mode (@modes) {
296            push @{$_io_dispatches{$fd}}, AnyEvent->io(fh => $fd,
297                                                       poll => $mode,
298                                                       cb => $cb);
299        }
[ffc4df6]300    } else {
301        die("Invalid I/O Dispatch mode: $modeStr");
302    }
303}
304
305=head2 remove_io_dispatch FD
306
307Remove a file descriptor previously registered via C<add_io_dispatch>
308
[bcde7926]309C<remove_io_dispatch> has been deprecated in favor of C<AnyEvent>.
310
311=cut
312
313sub remove_io_dispatch {
314    my $fd = shift;
315    undef $_ foreach @{$_io_dispatches{$fd}};
316    delete $_io_dispatches{$fd};
317}
318
[ee183be]319=head2 create_style NAME OBJECT
320
[b8a3e00]321Creates a new BarnOwl style with the given NAME defined by the given
[ee183be]322object. The object must have a C<description> method which returns a
323string description of the style, and a and C<format_message> method
324which accepts a C<BarnOwl::Message> object and returns a string that
325is the result of formatting the message for display.
326
[4df918b]327=head2 redisplay
328
329Redraw all of the messages on screen. This is useful if you've just
330changed how a style renders messages.
331
[ee183be]332=cut
333
334# perlconfig.c will set this to the value of the -c command-line
335# switch, if present.
336our $configfile;
337
[d7bcff8]338our @all_commands;
339
[8135737]340if(!$configfile) {
341    if (-f get_config_dir() . "/init.pl") {
342        $configfile = get_config_dir() . "/init.pl";
343    } elsif (-f $ENV{HOME} . "/.barnowlconf") {
344        $configfile = $ENV{HOME} . "/.barnowlconf";
345    } else {
346        $configfile = $ENV{HOME}."/.owlconf";
347    }
[ee183be]348}
349
350# populate global variable space for legacy owlconf files
351sub _receive_msg_legacy_wrap {
352    my ($m) = @_;
353    $m->legacy_populate_global();
354    return &BarnOwl::Hooks::_receive_msg($m);
355}
356
357=head2 new_command NAME FUNC [{ARGS}]
358
359Add a new owl command. When owl executes the command NAME, FUNC will
360be called with the arguments passed to the command, with NAME as the
361first argument.
362
363ARGS should be a hashref containing any or all of C<summary>,
364C<usage>, or C<description> keys:
365
366=over 4
367
368=item summary
369
370A one-line summary of the purpose of the command
371
372=item usage
373
374A one-line usage synopsis, showing available options and syntax
375
376=item description
377
378A longer description of the syntax and semantics of the command,
379explaining usage and options
380
381=back
382
383=cut
384
385sub new_command {
386    my $name = shift;
387    my $func = shift;
388    my $args = shift || {};
389    my %args = (
390        summary     => "",
391        usage       => "",
392        description => "",
393        %{$args}
394    );
395
396    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
397}
398
399=head2 new_variable_int NAME [{ARGS}]
400
401=head2 new_variable_bool NAME [{ARGS}]
402
403=head2 new_variable_string NAME [{ARGS}]
404
[e26abb6]405=head2 new_variable_enum NAME [{ARGS}]
406
407Add a new owl variable, either an int, a bool, a string, or an enum with the
[ee183be]408specified name.
409
[e26abb6]410For new_variable_enum, ARGS is required to contain a validsettings key pointing
411to an array reference. For all four, it can optionally contain the following
412keys:
[ee183be]413
414=over 4
415
416=item default
417
418The default and initial value for the variable
419
420=item summary
421
422A one-line summary of the variable's purpose
423
424=item description
425
426A longer description of the function of the variable
427
428=back
429
[104a4eb]430In addition, new_variable_string optionally accepts a string validsettings
431parameter, in case people want to set it to "<path>".
432
[ee183be]433=cut
434
435sub new_variable_int {
[523146b]436    my ($name, $args) = @_;
437    my $storage = defined($args->{default}) ? $args->{default} : 0;
438    BarnOwl::new_variable_full($name, {
439            %{$args},
440            get_tostring => sub { "$storage" },
441            set_fromstring => sub {
[4953c44]442                die "Expected integer" unless $_[0] =~ /^-?[0-9]+$/;
[523146b]443                $storage = 0 + $_[0];
444            },
445            validsettings => "<int>",
446            takes_on_off => 0,
447        });
[ee183be]448}
449
450sub new_variable_bool {
[523146b]451    my ($name, $args) = @_;
452    my $storage = defined($args->{default}) ? $args->{default} : 0;
453    BarnOwl::new_variable_full($name, {
454            %{$args},
455            get_tostring => sub { $storage ? "on" : "off" },
456            set_fromstring => sub {
[4953c44]457                die "Valid settings are on/off" unless $_[0] eq "on" || $_[0] eq "off";
[523146b]458                $storage = $_[0] eq "on";
459            },
460            validsettings => "on,off",
461            takes_on_off => 1,
462        });
[ee183be]463}
464
465sub new_variable_string {
[523146b]466    my ($name, $args) = @_;
467    my $storage = defined($args->{default}) ? $args->{default} : "";
468    BarnOwl::new_variable_full($name, {
[104a4eb]469            # Allow people to override this one if they /reaaally/ want to for
470            # some reason. Though we still reserve the right to interpret this
471            # value in interesting ways for tab-completion purposes.
472            validsettings => "<string>",
[523146b]473            %{$args},
474            get_tostring => sub { $storage },
[4953c44]475            set_fromstring => sub { $storage = $_[0]; },
[523146b]476            takes_on_off => 0,
477        });
[ee183be]478}
479
[e26abb6]480sub new_variable_enum {
481    my ($name, $args) = @_;
482
483    # Gather the valid settings.
484    die "validsettings is required" unless defined($args->{validsettings});
485    my %valid;
486    map { $valid{$_} = 1 } @{$args->{validsettings}};
487
488    my $storage = (defined($args->{default}) ?
489                   $args->{default} :
490                   $args->{validsettings}->[0]);
491    BarnOwl::new_variable_full($name, {
492            %{$args},
493            get_tostring => sub { $storage },
494            set_fromstring => sub {
[4953c44]495                die "Invalid input" unless $valid{$_[0]};
[e26abb6]496                $storage = $_[0];
497            },
498            validsettings => join(",", @{$args->{validsettings}})
499        });
500}
501
[523146b]502=head2 new_variable_full NAME {ARGS}
503
504Create a variable, in full generality. The keyword arguments have types below:
505
506 get_tostring : ()  -> string
507 set_fromstring : string -> int
508 -- optional --
509 summary : string
510 description : string
511 validsettings : string
512 takes_on_off : int
[69f74c2]513
[523146b]514The get/set functions are required. Note that the caller manages storage for the
515variable. get_tostring/set_fromstring both convert AND store the value.
[4953c44]516set_fromstring dies on failure.
[523146b]517
518If the variable takes parameters 'on' and 'off' (i.e. is boolean-looking), set
519takes_on_off to 1. This makes :set VAR and :unset VAR work. set_fromstring will
520be called with those arguments.
521
522=cut
523
524sub new_variable_full {
[ee183be]525    my $name = shift;
526    my $args = shift || {};
527    my %args = (
[523146b]528        summary => "",
[ee183be]529        description => "",
[523146b]530        takes_on_off => 0,
531        validsettings => "<string>",
[ee183be]532        %{$args});
[69f74c2]533
[523146b]534    die "get_tostring required" unless $args{get_tostring};
535    die "set_fromstring required" unless $args{set_fromstring};
[69f74c2]536
[523146b]537    # Strip off the bogus dummy argument. Aargh perl-Glib.
538    my $get_tostring_fn = sub { $args{get_tostring}->() };
[69f74c2]539    my $set_fromstring_fn = sub {
[523146b]540      my ($dummy, $val) = @_;
[4953c44]541      # Translate from user-supplied die-on-failure callback to expected
542      # non-zero on error. Less of a nuisance than interacting with ERRSV.
543      eval { $args{set_fromstring}->($val) };
544      # TODO: Consider changing B::I::new_variable to expect string|NULL with
545      # string as the error message. That can then be translated to a GError in
546      # owl_variable_set_fromstring. For now the string is ignored.
547      return ($@ ? -1 : 0);
[69f74c2]548    };
549
[523146b]550    BarnOwl::Internal::new_variable($name, $args{summary}, $args{description}, $args{validsettings},
551                                    $args{takes_on_off}, $get_tostring_fn, $set_fromstring_fn, undef);
[ee183be]552}
553
[fc92e6e2]554=head2 quote LIST
[ee183be]555
[fc92e6e2]556Quotes each of the strings in LIST and returns a string that will be
557correctly decoded to LIST by the BarnOwl command parser.  For example:
558
559    quote('zwrite', 'andersk', '-m', 'Hello, world!')
560    # returns "zwrite andersk -m 'Hello, world!'"
[ee183be]561
562=cut
563
564sub quote {
[fc92e6e2]565    my @quoted;
566    for my $str (@_) {
567        if ($str eq '') {
568            push @quoted, "''";
[ef4700c]569        } elsif ($str !~ /['" \n\t]/) {
[fc92e6e2]570            push @quoted, "$str";
571        } elsif ($str !~ /'/) {
572            push @quoted, "'$str'";
573        } else {
574            (my $qstr = $str) =~ s/"/"'"'"/g;
575            push @quoted, '"' . $qstr . '"';
576        }
[ee183be]577    }
[fc92e6e2]578    return join(' ', @quoted);
[ee183be]579}
580
[22b54a7]581=head2 Modify filters by appending text
582
583=cut
584
[cff58b4]585sub register_builtin_commands {
[0b2afba]586    # Filter modification
[cff58b4]587    BarnOwl::new_command("filterappend",
588                         sub { filter_append_helper('appending', '', @_); },
589                       {
590                           summary => "append '<text>' to filter",
591                           usage => "filterappend <filter> <text>",
592                       });
593
594    BarnOwl::new_command("filterand",
595                         sub { filter_append_helper('and-ing', 'and', @_); },
596                       {
597                           summary => "append 'and <text>' to filter",
598                           usage => "filterand <filter> <text>",
599                       });
600
601    BarnOwl::new_command("filteror",
602                         sub { filter_append_helper('or-ing', 'or', @_); },
603                       {
604                           summary => "append 'or <text>' to filter",
605                           usage => "filteror <filter> <text>",
606                       });
607
[0b2afba]608    # Date formatting
609    BarnOwl::new_command("showdate",
610                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
611                       {
612                           summary => "Show date in timestamps for supporting styles.",
613                           usage => "showdate",
614                       });
615
616    BarnOwl::new_command("hidedate",
617                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
618                       {
619                           summary => "Don't show date in timestamps for supporting styles.",
620                           usage => "hidedate",
621                       });
622
623    BarnOwl::new_command("timeformat",
624                         \&BarnOwl::time_format,
625                       {
626                           summary => "Set the format for timestamps and re-display messages",
627                           usage => "timeformat <format>",
628                       });
629
[6700c605]630    # Receive window scrolling
631    BarnOwl::new_command("recv:shiftleft",
632                        \&BarnOwl::recv_shift_left,
633                        {
634                            summary => "scrolls receive window to the left",
635                            usage => "recv:shiftleft [<amount>]",
636                            description => <<END_DESCR
637By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
638Otherwise, scroll by the number of columns specified as the argument.
639END_DESCR
640                        });
641
642    BarnOwl::new_command("recv:shiftright",
643                        \&BarnOwl::recv_shift_right,
644                        {
645                            summary => "scrolls receive window to the right",
646                            usage => "recv:shiftright [<amount>]",
647                            description => <<END_DESCR
648By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
649Otherwise, scroll by the number of columns specified as the argument.
650END_DESCR
651                        });
652
[cff58b4]653}
654
655$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
[22b54a7]656
657=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
658
659Helper to append to filters.
660
661=cut
662
663sub filter_append_helper
664{
665    my $action = shift;
666    my $sep = shift;
667    my $func = shift;
668    my $filter = shift;
669    my @append = @_;
670    my $oldfilter = BarnOwl::getfilter($filter);
671    chomp $oldfilter;
[0b5168d]672    my $newfilter = "$oldfilter $sep " . quote(@append);
673    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
[22b54a7]674    if (BarnOwl::getvar('showfilterchange') eq 'on') {
675        BarnOwl::admin_message("Filter", $msgtext);
676    }
[1b9a163]677    set_filter($filter, $newfilter);
[22b54a7]678    return;
679}
680BarnOwl::new_variable_bool("showfilterchange",
681                           { default => 1,
682                             summary => 'Show modifications to filters by filterappend and friends.'});
[ee183be]683
[1b9a163]684sub set_filter
685{
686    my $filtername = shift;
687    my $filtertext = shift;
688    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
689    BarnOwl::command($cmd);
690}
691
[0b2afba]692=head3 time_format FORMAT
693
694Set the format for displaying times (variable timeformat) and redisplay
695messages.
696
697=cut
698
[d694c55]699my $timeformat = '%H:%M';
[0b2afba]700
701sub time_format
702{
703    my $function = shift;
704    my $format = shift;
705    if(!$format)
706    {
707        return $timeformat;
708    }
709    if(shift)
710    {
711        return "Wrong number of arguments for command";
712    }
713    $timeformat = $format;
714    redisplay();
715}
716
[6700c605]717=head3 Receive window scrolling
718
719Permit scrolling the receive window left or right by arbitrary
720amounts (with a default of 10 characters).
721
722=cut
723
724sub recv_shift_left
725{
726    my $func = shift;
727    my $delta = shift;
[365950b]728    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]729    my $shift = BarnOwl::recv_getshift();
730    if($shift > 0) {
731        BarnOwl::recv_setshift(max(0, $shift-$delta));
732    } else {
733        return "Already full left";
734    }
735}
736
737sub recv_shift_right
738{
739    my $func = shift;
740    my $delta = shift;
[675a998]741    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]742    my $shift = BarnOwl::recv_getshift();
743    BarnOwl::recv_setshift($shift+$delta);
744}
745
[de3f641]746=head3 default_zephyr_signature
747
748Compute the default zephyr signature.
749
750=cut
751
752sub default_zephyr_signature
753{
[77c87b2]754  my $zsig = getvar('zsig');
[785ee77]755  if (!defined($zsig) || $zsig eq '') {
756      my $zsigproc = getvar('zsigproc');
757      if (defined($zsigproc) && $zsigproc ne '') {
[3c428d4]758          $zsig = `$zsigproc`;
759      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
760          $zsig = ((getpwuid($<))[6]);
761          $zsig =~ s/,.*//;
762      }
[de3f641]763  }
[77c87b2]764  chomp($zsig);
765  return $zsig;
[de3f641]766}
767
[b120bd3]768=head3 random_zephyr_signature
769
770Retrieve a random line from ~/.zsigs (except those beginning with '#')
771and use it as the zephyr signature.
772
773=cut
774
775sub random_zephyr_signature
776{
777    my $zsigfile = "$ENV{'HOME'}/.zsigs";
778    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
779    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
780    close $file;
781    return '' if !@lines;
782    my $zsig = "$lines[int(rand(scalar @lines))]";
783    chomp $zsig;
784    return $zsig;
785}
786
[7589f0a]787# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
788# startup command. This may be redefined in a user's configfile.
789sub startup
790{
791}
792
[ee183be]7931;
Note: See TracBrowser for help on using the repository browser.