initial commit

[urisagit/CMS-Simple.git] / CMS / Simple / Filter / Markup.pm

package CMS::Simple::Filter::Markup ;

use strict ;
use warnings ;

my %markup_to_code = (

	l	=> \&make_link,
	link	=> \&make_link,
	email	=> \&make_email,
	image	=> \&make_image,
	image_link	=> \&make_image_link,
	ilink	=> \&make_image_link,
	nbsp	=> sub { ' ' },
	em_dash	=> sub { '—' },
	eacute	=> sub { 'é' },
	copy	=> sub { '©' },
	p	=> sub { '<p>' },
	br	=> sub { '<br/>' },
	gmap	=> \&google_map,
) ;

sub filter_markup {

	my( $tag, $text ) = @_ ;

#print "TEXT $text\n" ;

	return unless $text =~
			s{(?<!\\)\[([a-z_]+)(?:\s+([^]]+)\s*)?\]}
			 {replace_markup(lc $1, $2)}gie
			||
			$text =~ s{\\\[}{[}g ;

	return $text ;
}

sub replace_markup {

	my( $key, $text ) = @_ ;

#print "KEY $key [$text]\n" ;

	my $code = $markup_to_code{ $key } ;

	$code or die "unknown markup key '$key'" ;

	return $code->($text) ;
}

sub make_link {

	my( $text ) = @_ ;

	my( $url, $url_text ) = split /\|/, $text ;

	$url_text ||= $url ;

	return qq{<A href="$url">$url_text</A>} ;
}

sub google_map {

	my( $text ) = @_ ;

	( my $url_text = $text ) =~ tr/ \t\n\r/+/s ;

	return
qq{<A href="http://maps.google.com/maps?f=q&hl=en&q=$url_text">$text</A>} ;
}

sub make_email {

	my( $text ) = @_ ;

	my( $user, $domain ) = split /\@/, $text ;

	return <<EMAIL ;
<script>
document.write('<a href="mailto:$user' + '\@' + 
          '$domain">$user AT $domain</a>')
</script>
<noscript>
$user AT $domain
</noscript>
EMAIL

}

sub make_image_link {

	my( $text ) = @_ ;

	my( $url, $image_url ) = split /\|/, $text ;

	return qq{<A href="$url"><IMG src="$image_url"></A>} ;
}

sub make_image {

	my( $text ) = @_ ;

	return qq{<IMG src="$text">} ;
}