Making minor deities disappear in a puff of logic since 1972
#!/usr/bin/perl
# Author: Khan Klatt
# Released under the GNU GPL. (http://www.gnu.org/copyleft/gpl.html)
# http://www.khan.org/blog/cronmovies
use strict;
use DateTime;
use Image::ExifTool;
use IO::Socket::SSL;
use Mail::POP3Client;
use MIME::Parser;
# Date Constants
my $dt= DateTime->now(time_zone => "America/Los_Angeles");
#my $global_date = time() - 36000000; # (to kickstart first post when no videos recently posted)
my $global_date = time() - 3600; # One Hour Ago
# POP Constants
my $username = 'SECRET@SOMEMAILHOST.COM'; # Needs to support POP3 access.
my $password = 'P@$$\/\/0Rd';
my $mailhost = 'POP.MAILHOST.COM';
my $port = '995';
# Path Constants
my $homedir = '/home/YOU/';
my $blogdir = "$homedir" . ".blog";
my $webhome = "public_html";
my $moviepath = "movies";
my $moviedir = "$homedir" . "$webhome/$moviepath";
my $webmoviepath = "/$moviepath";
# Post Constants
my $postfilename = $blogdir . "/qtmov" . $global_date . ".txt";
my $prettydate = $dt->month_abbr. " " . $dt->day . ", " . $dt->year . " " . $dt->hour_12 . lc($dt->am_or_pm) . "\n";
my $debug = 0;
my $pop = new Mail::POP3Client(
USER => $username,
PASSWORD => $password,
HOST => $mailhost,
PORT => $port,
USESSL => 'true',
DEBUG => 0
);
if (($pop->Count()) < 1) {
print "No messages...\n" if $debug;
exit;
}
print $pop->Count() . " messages found!\n\n" if $debug;
my $movieposted;
my $post = qq[My Recent Videos, as of $prettydate\n<div class="movies">\n];
for (my $i = 1; $i <= $pop->Count(); $i++) {
my $msg = $pop->HeadAndBody($i) || die "Couldn't do HeadAndBody $!\n";
my $parser = new MIME::Parser;
$parser->output_to_core(1);
$parser->tmp_to_core(1);
my $entity = $parser->parse_data(\$msg);
$entity->dump_skeleton if $debug;
foreach my $part ($entity->parts_DFS) {
if ($part->mime_type eq 'video/quicktime') {
# Write the file to a web-accessible qtpath
my $filename = $part->head->recommended_filename;
print "I found a quicktime movie: $filename\n\n" if $debug;
open (MOVIE, ">$moviedir/$filename") || die "Can't open $moviedir/$filename";
select MOVIE;
$part->bodyhandle->print;
close(MOVIE);
select STDOUT;
print "Saved quicktime movie to $moviedir/$filename\n\n" if $debug;
# Read image dimensions
print "Preparing to read image dimensions for $moviedir/$filename \n\n" if $debug;
my $info = Image::ExifTool::ImageInfo("$moviedir/$filename", 'ImageWidth','ImageHeight') || die "Couldn't read $moviedir/$filename";
my $width = $info->{ImageWidth};
my $height = $info->{ImageHeight} + 16;
print "Read image of dimensions $width x $height \n\n" if $debug;
# Add to the HTML for the entry for each new message
$post .= <<EOF;
<div class="movie"><embed src="$webmoviepath/$filename" width="$width" height="$height" autoplay="false"></embed></div><br /><br />
EOF
$movieposted++;
}
}
}
$pop->Close();
$post .= "</div>\n";
print "Preparing to write post for $movieposted movies\n\n" if $debug;
# Write the post for each run
if ($movieposted) {
# Set file permissions and replace whatever was in the file
umask(002);
open(OUTFILE, ">$postfilename") or die "Couldn't open $postfilename for writing.";
print OUTFILE $post;
close(OUTFILE);
print "Wrote blog post $postfilename\n\n" if $debug;
}
exit;
URL: http://www.flickr.com/photos/khanklatt/4347442453/sizes/o/
Title:
Comment/Excerpt: Check out the URL above to see the full-resolution halftoned image.