Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Daily Comix

by Arjen (Sexton)
on Jul 07, 2000 at 00:57 UTC ( #21389=sourcecode: print w/ replies, xml ) Need Help??

Category: Web Stuff
Author/Contact Info Arjen Wiersma (arjen@wiersma.org)
Description: I created this lil script a couple of months ago to have all the comix I read in the morning on one page. I also wanted to be able to chose what to see and I wanted to be able to add comix without having to modify the script itself.

The plugins are simple config files with a piece of code as a value which gets eval'ed. The script then puts them all in a nice overview on 1 single page.

An example plugin (UserFriendly) is included in the code section.

Cheers,

Arjen
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use URI::Heuristic;
use vars qw( $url );
$|++;

# Global vars...
my $plugin_dir = "/usr/lib/cgi-bin/comix-plugins";

# Set up the useragent, to be used by all plugs.
my $agent = LWP::UserAgent->new;
$agent->agent("Daily Comix/0.1");

if ( param() ) {
        &do_this;
} else {
        &print_main;
}

sub do_this {
        print header;
        print start_html(-Title=>"Comix",-BGCOLOR=>'white');
        foreach (param) {
                if ( open(PLUGIN, "$plugin_dir/$_") ) {
                        while (<PLUGIN>){
                                if (/^#/) { next }
                                my ($key, $val) = split(/=/,$_,2);
                                if (lc($key) eq 'title') { print "<B>$
+val</B><BR>\n"; }
                                if (lc($key) eq 'url') { $url = $val; 
+print "<I>$url</I><BR>\n"; }
                                if (lc($key) eq 'code') {
                                        while () {
                                                (my $line = <PLUGIN>);
                                                $val .= $line;
                                                if ($line =~ /^}/) { l
+ast; }
                                        }
                                        &get_comic( $val );
                                }
                        }
                        close(PLUGIN);
                } else {
                        print "<BR><B>There was an error processing $p
+lugin_dir/$_</B><BR>\n";
                }
                print "<BR><BR>";
        }
        print end_html;
}
sub print_main {
        print header;
        print start_html(-Title=>"Comix",-BGCOLOR=>'white');
        &list_plugins;
        print "<BR><BR>";
        print end_html;
}

sub list_plugins {
        print qq(<CENTER><TABLE><TR><TD>);
        print qq(<FORM ACTION="http://dream.chello.nl/cgi-bin/comix.pl
+"><BR>\n);
        if ( opendir(PLUGINS, $plugin_dir) ) {
                while ( defined( my $file = readdir(PLUGINS) ) ) {
                        if ( $file =~ /^\.{1,2}$/) { next; }
                        open (CONFIG, "$plugin_dir/$file") or die "Cou
+ldn't open: $!\n";
                        while (<CONFIG>) {
                                if (/^#/) { next }
                                my ($key, $val) = split(/=/,$_,2);
                                chomp($val);
                                if (lc($key) eq 'title') {  
                                        print qq(<INPUT TYPE=CHECKBOX 
+NAME=$file VALUE=$file> );
                                        print $val, "<BR>\n";
                                }
                        }
                }
                closedir(PLUGINS);
                print qq(<INPUT TYPE=SUBMIT VALUE="Show comix">);
        } else {
                print "Error opening directory: $!\n";
        }
        print qq(</TD></TR></TABLE></FORM>)
}

sub get_comic {
        $url = URI::Heuristic::uf_urlstr($url);
        my $req = HTTP::Request->new(GET => $url);
        $req->referer("http://wish.you.were.here");
        my $response = $agent->request($req);
        if ($response->is_error) {
                print "Oops... there was an error processing the reque
+st<BR>";
                print "<DD>", $response->status_line;
        } else {
                my $content = $response->content;
                eval $_[0];
                print $@ if $@;
        }
}

Configuration file:

Title=User Friendly Daily Strip
URL=http://www.userfriendly.org/static
Code={
        $content =~ m/(<IMG ALT="Latest Strip" .+?>)/sig;
        print $1, "<BR>\n";                                     
}

Comment on Daily Comix
Download Code
Re: Daily Comix
by jynx (Priest) on Nov 18, 2000 at 06:56 UTC
    hmmm,

    This is a somewhat old post (7-6-00), but from my experience i decided that i should post this anyway (against my better judgment).

    There is something called copyright laws. i have had personal experience in a website asking me to take down content because what i was posting was copyrighted. i have since grown much more wary about where content comes from on the internet. It is best advised to not post pages of other people's material without their explicit consent.

    It is in my hopes that this does not seem effrontery or rude, it is supposed to be a mere cautionary tale for anyone who thinks that this would be a good addition to their website. On the other hand, it is plusgood code ; )

    jynx

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://21389]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (9)
As of 2014-11-24 13:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (141 votes), past polls