view release on metacpan or  search on metacpan

examples/chump.cgi  view on Meta::CPAN

$vars->{description} = $desc[3];

my $tt = Template->new(POST_FOLD=>1, PRE_FOLD=>1);

my $template = "chump.tem";

if (defined(CGI::param("rss"))) {
    $template = "rss.tem";
    print CGI::header("text/xml");
    for (@{$vars->{entries}}) {
        $_->{title} = $_->{message};
        $_->{title} =~ s/<[^>]+>//g;
    }
} else {
    print CGI::header();
}

$tt->process($template, $vars) || print $tt->error();


sub blog_filter {
    my $text = shift;

    return '' if (!defined $text); # catch empty 'bc' mistakes

    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    $text =~ s/((?:^|[\b\s]))(http:\/\/[^>\s\"]+)/$1<a href="$2">$2<\/a>/gi;
    $text =~ s/\+\[([^\]]+)\]/chump_image($1)/eig;
    $text =~ s/\[([^\]]+)\]/chump($1)/eig;

    $text =~ s/\*([\w']+)\*/<b>$1<\/b>/ig;
    $text =~ s/\s\/(\w+)\/\s/<i>$1<\/i>/ig;

    return $text;
}

sub chump {
    my $text = shift;
    my ($one, $two) = split(/\|/, $text);
    $one =~ s/^\s+//;
    $one =~ s/\s+$//;
    $two =~ s/^\s+// if $two;
    $two =~ s/\s+$// if $two;


    if ($two) {
        # Ok, so we have [<one>|<two>]. We want to Do The Right Thing, and
        # not require people to remember which way round to put the link and
        # title. This is pretty easy to get right - 90% of the time, the link
        # is really obvious. These tests will catch 99% of the cases.

        # catch 'real' urls - http://, ftp://, etc.
        if ($one =~ /^\w+:\/\//) {
            return "<a href=\"$one\">$two</a>";
        } elsif ($two =~ /^\w+:\/\//) {
            return "<a href=\"$two\">$one</a>";

        # catch just numbers, guess if it's a blog_id or a timestamp
        # TODO if we ever have >10^8 blog entries, this will break.
        # Hopefuly, time() will be larger by then, and I can adjust this
        # number.
        } elsif ($one =~ /^\d{8,}$/) {
            return "<a href=\"".CGI::url()."?timestamp=$one\">$two</a>";
        } elsif ($one =~ /^\d+$/) {
            return "<a href=\"".CGI::url()."?blog_id=$one\">$two</a>";
        } elsif ($two =~ /^\d{8,}$/) {
            return "<a href=\"".CGI::url()."?timestamp=$two\">$one</a>";
        } elsif ($two =~ /^\d+$/) {
            return "<a href=\"".CGI::url()."?blog_id=$two\">$one</a>";

        # Finally, if we've matched neither end so far, try to pick up a
        # simpler form of uri, things like mailto:me@address.com.
        } elsif ($one =~ /^\w+:/) {
            return "<a href=\"$one\">$two</a>";
        } elsif ($two =~ /^\w+:/) {
            return "<a href=\"$two\">$one</a>";

        # ok, you got me. I'm stumped. Print /something/, at least.
        } else {
            return "[$one|$two]";
        }
                
    } else {
        if ($one =~ /^\w+:\/\//) {
            return "<a href=\"$one\">$one</a>";
        } elsif ($one =~ /^\d{8,}$/) {
            return "<a href=\"".CGI::url()."?timestamp=$one\">$one</a>";
        } elsif ($one =~ /^\d+$/) {
            return "<a href=\"".CGI::url()."?blog_id=$one\">$one</a>";
        } else {
            my $query = $db->prepare("SELECT * FROM infobot WHERE object=?");
            $query->execute("blog_shortcut $one");
            my $row = $query->fetchrow_hashref();
            return "[$one]" unless $row;
            return $row->{description} unless ($row->{description} =~ /\[(.*)\]/);
            return chump($1);
        }
    }
}

sub chump_image {
    my $text = shift;

    unless ($text =~ /(?:gif|jpe?g|png)$/i) {
        return "<br><iframe src=\"$text\" width=500 height=300></iframe><font size=-1>[<a href=\"$text\">$text</a>]</font><br>";
    }
    my $link = $text;
    my $hash = md5_hex($text);
    my $file = "cache/$hash";
    unless (-e "$file.jpg") {
        $text =~ s/&amp;/&/ig;
        $text =~ s/%2E/./ig;
        $text =~ s/%3A/:/ig;
        $text =~ s/%2F/\//ig;
        print STDERR "Getting $text to $hash\n";
        mirror($text, $file);
        print STDERR "Converting to jpg\n";
        print STDERR `convert \"$file\" \"$file.jpg\"`;