File Coverage

blib/lib/Sirc/URL.pm
Criterion Covered Total %
statement 22 104 21.1
branch 2 56 3.5
condition 0 12 0.0
subroutine 7 17 41.1
pod 2 7 28.5
total 33 196 16.8


line stmt bran cond sub pod time code
1             # $Id: URL.pm,v 1.1 2001-07-27 09:06:48-04 roderick Exp $
2             #
3             # Copyright (c) 2000 Roderick Schertler. All rights reserved. This
4             # program is free software; you can redistribute it and/or modify it
5             # under the same terms as Perl itself.
6              
7             # XXX
8             # - add help
9              
10 1     1   589 use strict;
  1         3  
  1         49  
11              
12             package Sirc::URL;
13              
14             =head1 NAME
15              
16             Sirc::URL - view URLs with an external browser
17              
18             =head1 SYNOPSIS
19              
20             From sirc:
21              
22             /eval use Sirc::URL
23              
24             /url # load most recent URL
25             /url 27 # load URL marked as number 27
26             /url www.argon.org # load named URL
27              
28             /urls -5 # list 5 most recent URLs
29             /urls 23 # list url marked as number 23
30             /urls # list all URLs
31              
32             /set url_browser openvt lynx %s &
33             /set url_mark off # disable URL marking
34             /set url_mark_format %s[%d] # less verbose marking style
35             /set url_max 234 # cycle back to 0 after 234
36              
37             From Perl:
38              
39             use Sirc::URL qw(browse_url urls);
40              
41             browse_url $url; # load named URL
42             ($index, @url) = urls; # index of most recent, and full list
43              
44             =head1 DESCRIPTION
45              
46             This module provides an easy way to view URLs which you see on IRC. Each
47             URL printed to the screen (as told by the L)
48             is numbered. For example, you might see
49              
50             It was either at http://www.memepool.com (/url 23)
51             or http://www.argon.org/~roderick/books.html (/url 24), I'm
52             not sure which.
53              
54             The C<(/url 23)> and C<(/url 24)> tags were added by B.
55              
56             =head1 COMMANDS
57              
58             =over 4
59              
60             =item /url [I]
61              
62             =item /url I
63              
64             You can load one of the marked URLs into your web browser by typing
65              
66             /url 23 # load http://www.memepool.com
67             /url 24 # load http://www.argon.org/~roderick/books.html
68             /url # same, no number means load the most recent one
69              
70             You can also use the machinery to load an URL you type yourself
71              
72             /url www.leisuretown.com
73              
74             =item /urls [I]
75              
76             This command lists the noted URLs.
77              
78             /urls -5 # list 5 most recent URLs
79             /urls 23 # list URL marked as number 23
80             /urls # list them all
81              
82             =cut
83              
84 1     1   5 use Exporter ();
  1         3  
  1         30  
85 1         448 use Sirc::Util qw(addcmd addhelp addhook arg_count_error
86             settable_boolean settable_int settable_str
87 1     1   6 tell_error tell_question xtell);
  1         1  
88              
89 1     1   7 use vars qw($VERSION @ISA @EXPORT_OK);
  1         1  
  1         325  
90              
91             $VERSION = do{my@r=q$Revision: 1.1 $=~/\d+/g;sprintf '%d.'.'%03d'x$#r,@r};
92             $VERSION .= '-l' if q$Locker: $ =~ /: \S/;
93              
94             @ISA = qw(Exporter);
95             @EXPORT_OK = qw(browse_url urls);
96              
97             # configuration
98              
99             # XXX document
100             # XXX has to be set before load
101             my $Module = 'URI::Find::Schemeless';
102              
103             my $Browser = 'netscape -remote openURL\\(%s", new-window)" &';
104             my $Debug = 0;
105             # XXX don't try to load until she has a chance to override $Module
106             my $Enabled = load_find_uris();
107             my $Format = '%s (/url %d)';
108             my $Max = 99;
109              
110             settable_str url_browser => \$Browser, \&validate_code_or_fmt;
111             settable_boolean url_debug => \$Debug;
112             settable_boolean url_mark => \$Enabled, \&validate_enabled;
113             settable_str url_mark_format => \$Format, \&validate_code_or_fmt;
114             settable_int url_max => \$Max, sub { $_[1] >= -1 };
115             # XXX
116             #settable_str url_finder => \$Module;
117              
118 1     1   5 use vars qw($Inhibit);
  1         1  
  1         740  
119              
120             =head1 SETTABLE OPTIONS
121              
122             You can set these variables with B's C command.
123              
124             =over 4
125              
126             =item B I|I
127              
128             This sets the command which will be used to load URLs. It can be either
129             an sprintf() format or a code reference. The default value is
130              
131             netscape -remote openURL\(%s", new-window)" &
132              
133             If the value is a string it's passed through sprintf() with a single argument
134             (the URL to be viewed, but already shell-escaped, so you shouldn't quote it
135             yourself). The command is interpred with F.
136              
137             If the value is a code reference it's called with the URL and it can do
138             what it likes. You have to use doset() to set this up.
139              
140             doset 'url_browser', \&mysub;
141              
142             I'd originally thought to make a number of pre-canned settings for
143             this, such as combinations of C, C, and
144             C with and without C, and text-mode
145             browsers launched with a settable X terminal emulation program or in
146             a new B window, or the like, but I came to believe that was a
147             bad idea. No matter which method you like to use, you'd do well to
148             have a simple shell script which you can pass URLs to in order to
149             load them, and if you have one of those you can just specify it for
150             this.
151              
152             =item B B|B|B
153              
154             This controls debugging messages. You can use them to see what command
155             is actually being run to load an URL.
156              
157             =item B B|B|B
158              
159             This turns URL marking on and off. It defaults to on, if the L
160             module|URI::Find> is available.
161              
162             =item B I|I
163              
164             B dictates how URLs are marked up on the screen. It
165             can be either an sprintf() format or a code reference. The default
166             value is
167              
168             %s (/url %d)
169              
170             If it's a string it's given to sprintf() with 3 arguments, the original
171             text, the URL number, and the cleaned-up URL.
172              
173             This doesn't give you much flexibility, though, since Perl's sprintf()
174             doesn't support position specifiers (eg, C<%2$s> to print the second
175             argument as a string). You can set B to a code
176             reference if you need to do something more fancy. Your sub is called
177             with the same 3 args, it returns the text which will replace the
178             original URL. You have to use doset() to set this up.
179              
180             doset 'url_mark_format', \&mysub;
181              
182             =item B I
183              
184             URL numbers cycle back around to 0 once they pass the B, the
185             default is 99. If you set this to -1 the list will just keep growing
186             (and your free memory will just keep shrinking).
187              
188             =back
189              
190             =head1 PROGRAMMING
191              
192             B optionally exports some functions and variables.
193              
194             =over 4
195              
196             =cut
197              
198             # internal use
199              
200             my $Count = -1;
201             my $Loaded_find_uris = 0;
202             my @Url;
203              
204             sub debug {
205 0 0   0 0 0 xtell 'url debug ' . join '', @_
206             if $Debug;
207             }
208              
209             sub waitstat ($) {
210 0     0 0 0 my ($w) = @_;
211              
212 0 0       0 if (eval { local $SIG{__DIE__}; require Proc::WaitStat }) {
  0         0  
  0         0  
213 0         0 return Proc::WaitStat::waitstat($w);
214             }
215             else {
216 0         0 return "wait status $w";
217             }
218             }
219              
220             =item B I
221              
222             This is the internal machinery which is used to view an URL. You can
223             use it, too, to piggy-back on the user's existing browser configuration.
224             It doesn't return anything meaningful.
225              
226             =cut
227              
228             sub browse_url {
229 0 0   0 1 0 unless (@_ == 1) {
230 0         0 arg_count_error undef, 1, @_;
231 0         0 return;
232             }
233 0         0 my ($url) = @_;
234              
235 0 0       0 if (ref $Browser) {
236 0         0 $Browser->($url);
237             }
238             else {
239 0         0 my $cmd = sprintf $Browser, quotemeta $url;
240 0         0 debug "running $cmd";
241 0         0 system $cmd;
242 0 0       0 if ($?) {
243 0         0 tell_error "Non-zero exit (" . waitstat($?) . ") from: $cmd";
244             }
245             }
246             }
247              
248             =item B
249              
250             This returns the index of the current URL followed by the full list. If
251             no URLs have been noted nothing is returned
252              
253             =cut
254              
255             sub urls {
256 0 0   0 1 0 if (@Url) {
257 0         0 return $Count, @Url;
258             }
259             else {
260 0         0 return;
261             }
262             }
263              
264             sub load_find_uris {
265             # XXX she could change module
266 1 50   1 0 5 return 1 if $Loaded_find_uris;
267              
268 1 50       72 if (!eval "local \$SIG{__DIE__}; require $Module") {
269 1         8 tell_error "$Module module not available, URL marking disabled ($@)";
270 1         2 return;
271             }
272              
273 0           $Loaded_find_uris = 1;
274 0           return 1;
275             }
276              
277             sub validate_code_or_fmt {
278 0     0 0   my ($name, $val) = @_;
279              
280 0 0         if (ref $val) {
281 0           return ref $val eq 'CODE';
282             }
283             else {
284 0           return eval { local $SIG{__DIE__}; my $x = sprintf $val; 1};
  0            
  0            
  0            
285             }
286             }
287              
288             sub validate_enabled {
289 0     0 0   my ($name, $val) = @_;
290              
291 0 0 0       if ($val && !load_find_uris) {
292 0           return 0;
293             }
294             else {
295 0           return 1;
296             }
297             }
298              
299             =item B<$Sirc::URL::Inhibit>
300              
301             If this is set to true then URL marking is inhibited. You might want
302             this if you're going to print the existing URL list out to the screen,
303             for example. You could also use C for that
304             purpose, but I provide this variable so you can conveniently localize
305             it.
306              
307             =cut
308              
309             sub main::hook_url_print {
310 0 0   0     return unless $Enabled;
311 0 0         return if $Inhibit;
312 0           local $Inhibit = 1;
313              
314             my $callback = sub {
315 0     0     my ($url, $orig_url) = @_;
316 0 0 0       if ($Count >= 0 && $Url[$Count] eq $url) {
317             # don't add it, it's the same as the last one
318             }
319             else {
320 0           $Count++;
321 0 0 0       $Count = 0 if $Max >= 0 && $Count > $Max;
322 0           $Url[$Count] = '' . $url; # stringify to lose objectness
323             }
324 0 0         if (ref $Format) {
325 0           return $Format->($orig_url, $Count, $url);
326             }
327             else {
328 0           return sprintf $Format, $orig_url, $Count, $url;
329             }
330 0           };
331              
332             # XXX cache the finder
333 1     1   6 my $finder = do { no strict 'refs'; $Module->new($callback) };
  1         3  
  1         598  
  0            
  0            
334 0           $finder->find(\$_[0]);
335             }
336             addhook 'print', 'url_print';
337              
338             sub main::cmd_url {
339 0     0     my (@spec, $carped);
340              
341 0           @spec = split ' ', $::args;
342 0 0         @spec = ($Count) if !@spec;
343              
344 0           for my $spec (@spec) {
345 0 0         if ($spec =~ /^-?\d+$/) {
346             # Numbers refer to URLs I've noted.
347 0 0 0       if ($Count == -1) {
    0          
348 0 0         tell_question "No URLs have been noted" unless $carped++;
349 0           next;
350             }
351             elsif ($spec < 0 || $spec > @Url) {
352 0           tell_question "URL number `$spec' is out of range";
353 0           next;
354             }
355             else {
356 0           browse_url $Url[$spec];
357             }
358             }
359             else {
360             # Non-numbers are themselves URLs.
361 0           browse_url $spec;
362             }
363             }
364             }
365             addcmd 'url';
366              
367             sub main::cmd_urls {
368 0     0     my @arg = split ' ', $::args;
369              
370 0 0         if (!$Count) {
371 0           tell_question "No URLs noted";
372 0           return;
373             }
374              
375 0           my @out = (0..$#Url);
376 0 0         unshift @out, splice @out, $Count + 1 if $Count < $#Url; # oldest first
377 0 0         if (@arg == 0) {
    0          
378             # output everything
379             }
380             elsif (@arg == 1) {
381 0           my $n = shift @arg;
382 0 0         if ($n !~ /^-?\d+$/) {
    0          
383 0           tell_question "Argument must be numeric";
384 0           return;
385             }
386             elsif ($n < 0) {
387 0           $n = -$n;
388 0 0         splice @out, 0, @out - $n if $n < @out;
389             }
390             else {
391 0 0         if ($n > $#Url) {
392 0           tell_question "URL $n hasn't been noted yet";
393 0           return;
394             }
395             else {
396 0           @out = ($n);
397             }
398             }
399             }
400             else {
401 0           tell_question "0 or 1 arg expected";
402 0           return;
403             }
404              
405 0           local $Inhibit = 1;
406 0           xtell sprintf "%3d. %s\n", $_, $Url[$_] for @out;
407             }
408             addcmd 'urls';
409              
410             1
411              
412             __END__