random changes
[urisagit/CMS-Simple.git] / CMS / Simple / Filter / Markup.pm
CommitLineData
9e609156 1
2package CMS::Simple::Filter::Markup ;
3
4use strict ;
5use warnings ;
6
7my %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
25sub 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
40sub 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
55sub 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
66sub google_map {
67
68 my( $text ) = @_ ;
69
70 ( my $url_text = $text ) =~ tr/ \t\n\r/+/s ;
71
72 return
0db1d626 73qq{<a href="http://maps.google.com/maps?f=q&hl=en&q=$url_text">$text</a>} ;
9e609156 74}
75
76sub make_email {
77
78 my( $text ) = @_ ;
79
80 my( $user, $domain ) = split /\@/, $text ;
81
82 return <<EMAIL ;
83<script>
84document.write('<a href="mailto:$user' + '\@' +
85 '$domain">$user AT $domain</a>')
86</script>
87<noscript>
88$user AT $domain
89</noscript>
90EMAIL
91
92}
93
94sub 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
103sub make_image {
104
105 my( $text ) = @_ ;
106
0db1d626 107 return qq{<img src="$text">} ;
9e609156 108}
0db1d626 109
110sub make_bold {
111
112 my( $text ) = @_ ;
113
114 return qq{<B>$text</B>} ;
115}
116
1171 ;