CMS/Simple/Filter/Markup.pm

   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 { '&nbsp;' },
  16         bold    => \&make_bold,
  17         em_dash => sub { '&#151;' },
  18         eacute  => sub { '&#233;' },
  19         copy    => sub { '&#169;' },
  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
  46         $text = 'UNDEF' unless defined $text ;
  47
  48         my $code = $markup_to_code{ $key } ;
  49
  50         $code or die "unknown markup key '$key' text '$text'" ;
  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
  63         return qq{<a href="$url">$url_text</a>} ;
  64 }
  65
  66 sub google_map {
  67
  68         my( $text ) = @_ ;
  69
  70         ( my $url_text = $text ) =~ tr/ \t\n\r/+/s ;
  71
  72         return
  73 qq{<a href="http://maps.google.com/maps?f=q&hl=en&q=$url_text">$text</a>} ;
  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
 100         return qq{<a href="$url"><img src="$image_url"></a>} ;
 101 }
 102
 103 sub make_image {
 104
 105         my( $text ) = @_ ;
 106
 107         return qq{<img src="$text">} ;
 108 }
 109
 110 sub make_bold {
 111
 112         my( $text ) = @_ ;
 113
 114         return qq{<B>$text</B>} ;
 115 }
 116
 117 1 ;