Commit | Line | Data |
9e609156 |
1 | |
2 | package CMS::Simple::Filter::Markup ; |
3 | |
4 | use strict ; |
5 | use warnings ; |
6 | |
7 | my %markup_to_code = ( |
8 | |
9 | l => \&make_link, |
10 | link => \&make_link, |
11 | email => \&make_email, |
12 | image => \&make_image, |
13 | image_link => \&make_image_link, |
14 | ilink => \&make_image_link, |
15 | nbsp => sub { ' ' }, |
0db1d626 |
16 | bold => \&make_bold, |
9e609156 |
17 | em_dash => sub { '—' }, |
18 | eacute => sub { 'é' }, |
19 | copy => sub { '©' }, |
20 | p => sub { '<p>' }, |
21 | br => sub { '<br/>' }, |
22 | gmap => \&google_map, |
23 | ) ; |
24 | |
25 | sub filter_markup { |
26 | |
27 | my( $tag, $text ) = @_ ; |
28 | |
29 | #print "TEXT $text\n" ; |
30 | |
31 | return unless $text =~ |
32 | s{(?<!\\)\[([a-z_]+)(?:\s+([^]]+)\s*)?\]} |
33 | {replace_markup(lc $1, $2)}gie |
34 | || |
35 | $text =~ s{\\\[}{[}g ; |
36 | |
37 | return $text ; |
38 | } |
39 | |
40 | sub replace_markup { |
41 | |
42 | my( $key, $text ) = @_ ; |
43 | |
44 | #print "KEY $key [$text]\n" ; |
45 | |
0db1d626 |
46 | $text = 'UNDEF' unless defined $text ; |
47 | |
9e609156 |
48 | my $code = $markup_to_code{ $key } ; |
49 | |
0db1d626 |
50 | $code or die "unknown markup key '$key' text '$text'" ; |
9e609156 |
51 | |
52 | return $code->($text) ; |
53 | } |
54 | |
55 | sub make_link { |
56 | |
57 | my( $text ) = @_ ; |
58 | |
59 | my( $url, $url_text ) = split /\|/, $text ; |
60 | |
61 | $url_text ||= $url ; |
62 | |
0db1d626 |
63 | return qq{<a href="$url">$url_text</a>} ; |
9e609156 |
64 | } |
65 | |
66 | sub google_map { |
67 | |
68 | my( $text ) = @_ ; |
69 | |
70 | ( my $url_text = $text ) =~ tr/ \t\n\r/+/s ; |
71 | |
72 | return |
0db1d626 |
73 | qq{<a href="http://maps.google.com/maps?f=q&hl=en&q=$url_text">$text</a>} ; |
9e609156 |
74 | } |
75 | |
76 | sub make_email { |
77 | |
78 | my( $text ) = @_ ; |
79 | |
80 | my( $user, $domain ) = split /\@/, $text ; |
81 | |
82 | return <<EMAIL ; |
83 | <script> |
84 | document.write('<a href="mailto:$user' + '\@' + |
85 | '$domain">$user AT $domain</a>') |
86 | </script> |
87 | <noscript> |
88 | $user AT $domain |
89 | </noscript> |
90 | EMAIL |
91 | |
92 | } |
93 | |
94 | sub make_image_link { |
95 | |
96 | my( $text ) = @_ ; |
97 | |
98 | my( $url, $image_url ) = split /\|/, $text ; |
99 | |
0db1d626 |
100 | return qq{<a href="$url"><img src="$image_url"></a>} ; |
9e609156 |
101 | } |
102 | |
103 | sub make_image { |
104 | |
105 | my( $text ) = @_ ; |
106 | |
0db1d626 |
107 | return qq{<img src="$text">} ; |
9e609156 |
108 | } |
0db1d626 |
109 | |
110 | sub make_bold { |
111 | |
112 | my( $text ) = @_ ; |
113 | |
114 | return qq{<B>$text</B>} ; |
115 | } |
116 | |
117 | 1 ; |