File Coverage

blib/lib/HTML/Rainbow.pm
Criterion Covered Total %
statement 44 44 100.0
branch 28 28 100.0
condition 5 5 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 86 86 100.0


line stmt bran cond sub pod time code
1             # HTML::Rainbow.pm
2             #
3             # Copyright (c) 2005-2009 David Landgren
4             # All rights reserved
5              
6             package HTML::Rainbow;
7              
8 3     3   76400 use strict;
  3         6  
  3         108  
9 3     3   14 use Exporter;
  3         3  
  3         120  
10 3     3   2602 use Tie::Cycle::Sinewave;
  3         3544  
  3         94  
11              
12 3     3   18 use vars qw/$VERSION @PRIMES @ISA @EXPORT_OK/;
  3         5  
  3         3161  
13              
14             $VERSION = '0.06';
15             @ISA = ('Exporter');
16             @PRIMES = qw(17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79);
17              
18             =head1 NAME
19              
20             HTML::Rainbow - Put colour into your HTML
21              
22             =head1 VERSION
23              
24             This document describes version 0.06 of HTML::Rainbow, released
25             2009-10-04.
26              
27             =head1 SYNOPSIS
28              
29             use HTML::Rainbow 'rainbow';
30             print rainbow('hello, world');
31              
32             =head1 DESCRIPTION
33              
34             C will take plain text string (or array of strings)
35             and mark it up with C<< >> tags (or C<< >> tags
36             if you're feeling particularly orthodox), and produce text that
37             drifts endlessly from one colour to the next.
38              
39             The intensity of the red, green and blue channels follow mutually
40             prime sinusoidal periods.
41              
42             =for html
43            

This comes in handy when you have the burning desire

44             to say

45            
P
46             color="#7c797c">er
47             color="#8e878e">l i
48             color="#9f949f">s a
49             color="#afa0af">la
50             color="#beacbe">ng
51             color="#c9b7c9">ua
52             color="#d2c1d2">ge
53             color="#d8c9d8">op
54             color="#dbd0db">ti
55             color="#dbd5db">mi
56             color="#d9d9cc">ze
57             color="#d6dbad">d f
58             color="#d1db83">or
59             color="#ccd656">sc
60             color="#c5ca2e">an
61             color="#bdb813">ni
62             color="#b5a00a">ng
63             color="#ab860d">ar
64             color="#a16a0f">bi
65             color="#964f12">tr
66             color="#8b3615">ar
67             color="#802119">y t
68             color="#74131d">ex
69             color="#680b22">t f
70             color="#5d0a27">il
71             color="#52522c">es
72             color="#47c032">, e
73             color="#3cd338">xt
74             color="#33ce3f">ra
75             color="#2ac845">ct
76             color="#22c04c">in
77             color="#1bb854">g i
78             color="#15af5b">nf
79             color="#10a562">or
80             color="#0d9b6a">ma
81             color="#0b9072">ti
82             color="#0a8479">on
83             color="#0a7981">fr
84             color="#0b6d88">om
85             color="#0d6190">th
86             color="#0f5697">os
87             color="#134b9e">e t
88             color="#1740a5">ex
89             color="#1b36ab">t f
90             color="#202db2">il
91             color="#2625b8">es
92             color="#2d1ebd">, a
93             color="#3317c2">nd
94             color="#3b12c7">pr
95             color="#420ecb">in
96             color="#4a0bcf">ti
97             color="#530ad3">ng
98             color="#5b0ad5">re
99             color="#640cd8">po
100             color="#6d12d9">rt
101             color="#761adb">s b
102             color="#7e25db">as
103             color="#8733db">ed
104             color="#9043d7">on
105             color="#9854cc">th
106             color="#a066ba">at
107             color="#a879a3">in
108             color="#b08b89">fo
109             color="#b79d6d">rm
110             color="#bdad51">at
111             color="#c3bc38">io
112             color="#c8c823">n.
113             color="#cdd114">It
114             color="#d1d80b">'s
115             color="#d5db0a">al
116             color="#d8db10">so
117             color="#dad91d">a g
118             color="#dbd530">oo
119             color="#dbd048">d l
120             color="#dbc963">an
121             color="#d6c17f">gu
122             color="#c9b79a">ag
123             color="#b7acb2">e f
124             color="#9fa0c6">or
125             color="#8494d4">ma
126             color="#6986db">ny
127             color="#4d79da">sy
128             color="#356bd6">st
129             color="#205ece">em
130             color="#1251c4">ma
131             color="#0b44b7">na
132             color="#0a38a8">ge
133             color="#532e97">me
134             color="#c12485">nt
135             color="#d31c73">ta
136             color="#741560">sk
137             color="#140f4e">s.
138             color="#220c3e">Th
139             color="#460a2e">e l
140             color="#720a21">an
141             color="#9e0a17">gu
142             color="#c20c0f">ag
143             color="#d80d0b">e i
144             color="#da100a">s i
145             color="#d7120f">nt
146             color="#d21626">en
147             color="#cc1a4c">de
148             color="#c41e78">d t
149             color="#bb23a4">o b
150             color="#b128c6">e p
151             color="#a52dd9">ra
152             color="#9933d9">ct
153             color="#8c39d6">ic
154             color="#7f40d2">al
155             color="#7147cc">(e
156             color="#644ec5">as
157             color="#5655be">y t
158             color="#4a5cb5">o u
159             color="#3d64ac">se
160             color="#326ca2">, e
161             color="#287397">ff
162             color="#1f7b8c">ic
163             color="#178280">ie
164             color="#118a75">nt
165             color="#0d9169">, c
166             color="#0a985d">om
167             color="#0a9f52">pl
168             color="#0ba647">et
169             color="#15ad3d">e)
170             color="#24b333">ra
171             color="#39b92a">th
172             color="#53be22">er
173             color="#6ec31b">th
174             color="#8ac815">an
175             color="#a4cc10">be
176             color="#bbd00d">au
177             color="#cdd30b">ti
178             color="#d8d60a">fu
179             color="#dbd80a">l (
180             color="#dada0d">ti
181             color="#d7db13">ny
182             color="#d3db1c">, e
183             color="#cedb28">le
184             color="#c7d037">ga
185             color="#c0b447">nt
186             color="#b88b58">, m
187             color="#af5e6a">in
188             color="#a5357d">im
189             color="#9a178f">al
190             color="#8f0aa1">).
191              
192             Win friends, and influence enemies, on your favourite
193             HTML bulletin board.
194              
195             =head1 METHODS
196              
197             =over 8
198              
199             =item B
200              
201             Creates a new C object. A set of key/value parameters
202             can be supplied to control the finer details of the object's
203             behaviour.
204              
205             The colour-space of HTML is defined by a tuple of red, green and
206             blue components. Each component can vary between 0 and 255. Setting
207             all components to 0 produces black, and setting them all to 255
208             produces white. The parameters for C allow you to control
209             the behaviour of the components, either individually or as a whole.
210              
211             Each value may be specifed as a number from 0 to 255, or as a
212             percentage (such as C<50%>). Percentages are rounded to the nearest
213             integer, and values out of range are clipped to the nearest bound.
214              
215             =over 4
216              
217             =item min
218              
219             Sets the minimum value for all three components. For example, a
220             value of 0 (zero) may result in white being produced. This may
221             produce invisible text if the background colour is also white.
222             Hence, one may wish to use a value between 20 to 40 if this is the
223             case.
224              
225             =item max
226              
227             Sets the maximum value for all three components. Setting it to C<100%> or
228             255 may result in black being produced. A similar warning concerning a
229             background colour of black applies here.
230              
231             =item min_red, min_green, min_blue
232              
233             Sets the minimum value for the specified colour component.
234              
235             =item max_red, max_green, max_blue
236              
237             Sets the maximum value for the specified colour component.
238              
239             =item red, green, blue
240              
241             Sets the value of the specified colour component to a fixed value.
242             For example, the following call to new()...
243              
244             my $r = HTML::Rainbow->new(
245             red => 0,
246             green => 0,
247             min_blue => 10,
248             max_blue => 240,
249             );
250              
251             ... will result in a rainbow generator that moves through various
252             shades of blue.
253              
254             =item period_list
255              
256             Set the periods available to choose from. At each peak and trough
257             of the sine wave followed by each colour component, a new period
258             length is chosen at random. This is to ensure that the sequence
259             of colours does not repeat itself too rapidly. Prime numbers
260             are well suited, and the value of period should be at least 10 (ten) or
261             more for best results. A list of periods, from 17 to 79, is used by
262             default. Very long texts will benefit from longer periods. The
263             parameter is a reference to an array.
264              
265             my $r = HTML::Rainbow->new(
266             min => 0,
267             max => '80%',
268             period_list => [qw[ 19 37 53 71 89 107 131 151 173 193 ]],
269             );
270              
271             =item use_span
272              
273             Use the HTML C<< >> element instead of the C<< >>
274             element for specifying the colour. The result uses 6 more characters
275             per marked up character.
276              
277             =back
278              
279             The most specific parameter wins. If both, for example, a C
280             and a C parameter are found, the C parameter wins.
281             If a C and a C parameter is found, the C
282             parameter wins.
283              
284             =cut
285              
286             sub new {
287 11     11 1 5698 my $class = shift;
288 11         33 my %args = @_;
289              
290             # sanity checks for %args
291 11         23 for my $attr(
  33         102  
292             qw(min max),
293             map {( $_, "${_}_min", "${_}_max" )} qw( red green blue )
294             ) {
295 121 100       247 next unless exists $args{$attr};
296             # reduce round-off errors
297             # perl -le 'print 1/2+1/32+1/64+1/512+1/1024+1/4096'
298 7         9 my $scale = 2 + 1/2 + 1/32 + 1/64 + 1/512 + 1/1024 + 1/4096;
299             # 2.550048828125 approx 2.55
300             # 43% => 43 / 100 * 255 => 43 * 2.55 => 110
301 7         30 $args{$attr} =~ s{^(\d+(?:\.\d+)?)\s*%$}{sprintf('%d',sprintf('%0.2f',$1) * $scale)}e;
  2         37  
302 7 100       38 $args{$attr} = 0 if $args{$attr} < 0;
303 7 100       23 $args{$attr} = 255 if $args{$attr} > 255;
304             }
305              
306             my $self = {
307             period => $args{period_list} ? $args{period_list} : \@PRIMES,
308 11 100 100     103 use_span => $args{use_span } || 0,
309             };
310              
311             my $change_period = sub {
312 15     15   275 my $s = shift;
313 15         22 $s->period( $self->{period}[rand @{$self->{period}}] );
  15         51  
314 11         61 };
315              
316 33         1488 tie $self->{$_}, 'Tie::Cycle::Sinewave', {
317             min => defined $args{$_}
318             ? $args{$_}
319             : defined $args{"${_}_min"}
320             ? $args{"${_}_min"}
321             : defined $args{min}
322             ? $args{min}
323             : 16,
324             max => defined $args{$_}
325             ? $args{$_}
326             : defined $args{"${_}_max"}
327             ? $args{"${_}_max"}
328             : defined $args{max}
329             ? $args{max}
330             : 240,
331             period => $self->{period}[ rand @{$self->{period}} ],
332             at_min => $change_period,
333             at_max => $change_period,
334 11 100       119 } for qw( red green blue );
    100          
    100          
    100          
    100          
    100          
335              
336 11         501 bless $self, $class;
337             }
338              
339             =item B
340              
341             Converts each passed parameter to rainbowed markup, and returns
342             a single scalar with the resulting marked up text.
343              
344             print $r->rainbow( 'somewhere over the rainbow, bluebirds fly' );
345              
346             You can avoid using an intermediate variable by chaining the
347             C method on from the C method:
348              
349             print HTML::Rainbow->new(
350             max => 127,
351             min => 0,
352             period_list => [qw[ 11 29 47 71 97 113 149 173 ]],
353             )->rainbow( $text );
354              
355             =cut
356              
357             push @EXPORT_OK, 'rainbow';
358             {
359             my $ctx;
360             sub rainbow {
361 10     10 1 355 my $self = shift;
362 10         14 my $out = '';
363 10 100 100     82 if (!($self and UNIVERSAL::isa($self,'HTML::Rainbow'))) {
364             # called as a function, not a method
365 5         12 unshift @_, $self;
366 5 100       16 $self = $ctx ? $ctx : $ctx = HTML::Rainbow->new;
367             }
368 10         32 for my $str( grep defined, @_ ) {
369 8         29 for my $ch( split //, $str ) {
370 42 100       120 if( $ch =~ /^\s$/ ) {
371 2         6 $out .= $ch;
372             }
373             else {
374 40         178 my $triple = sprintf( "#%02x%02x%02x",
375             $self->{red}, $self->{green}, $self->{blue}
376             );
377 40 100       1656 if( $self->{use_span} ) {
378 7         24 $out .= qq{$ch};
379             }
380             else {
381 33         123 $out .= qq{$ch};
382             }
383             }
384             }
385             }
386             $out
387 10         380 }
388             }
389              
390             =back
391              
392             =head1 DIAGNOSTICS
393              
394             None.
395              
396             =head1 SEE ALSO
397              
398             =over 8
399              
400             =item L
401              
402             The individual red, green and blue colour components follow
403             sinewaves produced by this module.
404              
405             =item L
406              
407             If you want to modify an existing HTML page, you'll probably have
408             to parse it in order to extract the text. The C directory
409             contains some examples to show how this may be done.
410              
411             =back
412              
413             =head1 EXAMPLE
414              
415             The following example produces a valid HTML page.
416              
417             use strict;
418             use warnings;
419              
420             use CGI ':standard';
421             use HTML::Rainbow;
422              
423             print header(),
424             start_html(),
425             HTML::Rainbow->new->rainbow('hello, world'),
426             end_html();
427              
428             =head1 BUGS
429              
430             None known.
431              
432             Please report all bugs at
433             L
434              
435             Make sure you include the output from the following two commands:
436              
437             perl -MHTML::Rainbow -le 'print $HTML::Rainbow::VERSION'
438             perl -V
439              
440             =head1 ACKNOWLEDGEMENTS
441              
442             This module is dedicated to John Lang, someone I used to work
443             with back in the early days of the web. I found him one day
444             painstakingly writing HTML in a text editor and reviewing the
445             results in Netscape. He was trying to do something like this,
446             to post to a bulletin board, so I wrote some very ugly Perl
447             to help him out. Ten years later, I finally got around to
448             cleaning it up.
449              
450             =head1 AUTHOR
451              
452             David Landgren, copyright (C) 2005-2009. All rights reserved.
453              
454             http://www.landgren.net/perl/
455              
456             If you (find a) use this module, I'd love to hear about it.
457             If you want to be informed of updates, send me a note. You
458             know my first name, you know my domain. Can you guess my
459             e-mail address?
460              
461             =head1 LICENSE
462              
463             This library is free software; you can redistribute it and/or modify
464             it under the same terms as Perl itself.
465              
466             =cut
467              
468             'The Lusty Decadent Delights of Imperial Pompeii';
469             __END__