Welcome, Guest :: Blog Home | Login | Register

Articles By Tag:
Perl Cron Script for Astroslacker.com

2011-09-18 14:55:28 Tags: perl

So how does Astroslacker.com find all that great news? Well, I programmed several cron scripts to fetch XML feeds, find and create images, and create a wav file for descriptions. Here's how it's done...

Perl Code:
#!/usr/bin/perl -w
use strict;

use LWP::Simple;
use XML::Simple;
use Image::Magick;
use Data::Dumper;

use lib "/var/www/astroslacker.com/lib";
#use DB::Main;
use DB::MySQLDB;

my $schema = DB::MySQLDB->connect(
    'dbi:mysql:astroslacker:localhost',
    'user', 'password'
);

my $content = LWP::Simple::getstore("http://www.physorg.com/xml-feed/space-news/astronomy/", "/var/www/astroslacker.com/space-feed/store-space-feed.xml");

my $xml  = new XML::Simple;
my $data = $xml->XMLin("/var/www/astroslacker.com/space-feed/store-space-feed.xml");

print Dumper($data->{item});

foreach my $item (@{$data->{item}}) {
    my $rs_exist = $schema->resultset('Feeds')->find({ 'link' => $item->{'link'} });
    
    unless ($rs_exist) {
        my $image = '';
        my $link  = $item->{'link'};
        
        $link =~ s/\<link\>//;
        $link =~ s/\<\/link\>//;
        
        my $feed_image = _get_image($link) || '';
        
        if ($feed_image) {
            # sub out src url only
            $feed_image =~ s{^.*src}{src}i;
            $feed_image =~ s{src\=\"}{};
            $feed_image =~ s{(align+).*}{$1}i;
            $feed_image =~ s{\"\salign}{}g;
            
            my ($filename, $dummy, $extension) = File::Basename::fileparse($feed_image, qr{\.[^.]*$});
            
            my $upload_dir = '/var/www/astroslacker.com/root/feed_images';
            my $localimage = "$filename$extension";
            my $contentx   = LWP::Simple::getstore($feed_image, "$upload_dir/$localimage");
            my $imageurl   = "root/feed_images/thumb_$localimage";
            my $thumbnail  = new Image::Magick;
            my $full       = "$upload_dir/$localimage";
            my $thumb      = "$upload_dir/thumb_$localimage";
            
            $thumbnail->Read($full);
            $thumbnail->Resize('140x140');
            $thumbnail->Write(filename => $thumb);
            
            $image = $imageurl;
        }
        
        my $rc = $schema->resultset('Feeds')->create({
            id             => undef,
            title          => $item->{'title'} || undef,
            description => $item->{'description'} || undef,
            link           => $item->{'link'} || undef,
            image       => $image,
            category    => $item->{'category'} || undef,
            date         => $item->{'dc:date'} || undef,
            active       => 1,
        });
	
	# TTS descriptions
	my $wav_file  = time. '.wav';
	my $form_text = $item->{'description'};
	my $tts_file  = _generate_wav($wav_file,$form_text);
	
	print "$tts_file\n";
	
	my $wavs = $schema->resultset('Wav')->create({
	    id => undef,
	    feed_id => $rc->id(),
	    wav => $tts_file,
	});
    } else {
	print "Already stored.\n";
    }
}

my $time = localtime(time);

open FILE, ">", "/var/www/astroslacker.com/lastcron.txt";
print FILE $time;
close FILE;

sub _generate_wav {
    my $wav_file  = shift;
    my $form_text = shift;
    
    print qq(Wave File: $wav_file\n);
    print qq(Form Text: $form_text\n);
    
    my $user_dir  = '/var/www/astroslacker.com/root/feed_wav';
    my $temp_dir  = '/var/www/.astroslacker.com/root/feed_wav/temp';
    
    mkdir($temp_dir) unless (-d $temp_dir);
    
    my $temp_file = time. '.txt';
    
    my $text = $temp_dir. '/' .$temp_file;
    my $wave = $user_dir. '/' .$wav_file;
    
    open F, "> $text";
    print F $form_text;
    close F;
    
    my $convert = system("cat $text | text2wave -o $wave");
    
    print "System: cat $text | text2wave -o $wave\n";
    print "Sleeping for 2 seconds\n";
    
    sleep 2;
    
    unlink($text);
    
    return $wav_file;
}

sub _get_image {
    my $link = shift;
    
    my $ua = LWP::UserAgent->new;
       $ua->agent("Mozilla/8.0");
    
    my $req = HTTP::Request->new(GET => $link);
       $req->header('Accept' => 'text/html');
    
    my $res = $ua->request($req);
    
    my $feed_image = '';
    
    if ($res->is_success) {
	my @lines = split("\n", $res->content);
	
	my $count = 0;
	foreach my $line (@lines) {
	    $count++;
	    if ($line =~ /\<\!\-\- google\_ad\_section\_start \-\-\>/) {
		last;
	    }
	}
	
	$count = ($count + 2);
	
        my $enlarge = '';
	my $n_count = 0;
	foreach my $line (@lines) {
	    $n_count++;
	    if ($n_count == $count and $line =~ /.(png|jpg|gif)/) {
		$feed_image = $line;
	    }
	}
    }
    
    my $ilink = '';
    if ($feed_image) {
	my @linker = split(' />', $feed_image);
	
	$ilink  = $linker[0];
	$ilink .= ' />';
    }
    
    return $ilink;
}


I have programmed the main site using CGI::Application, a Perl MVC web framework. Here's a look at the source code.

Perl Code:
package Index;

#use lib '/usr/local/lib/perl5/site_perl/5.10.0:/usr/local/share/perl5';

use base 'CGI::Application';
use strict;

use CGI::Application::Plugin::TT;
use CGI::Session;
use Email::Valid;
use Email::MIME;
use Email::MIME::Creator;
use Email::Send;
use DateTime;
use Data::Dumper;

use lib "/var/www/astroslacker.com/lib";
#use DB::Main;
use DB::MySQLDB;

sub cgiapp_init
{
    my $self    = shift;
    my $query   = $self->query;
    my $sid     = $query->cookie( 'CGISESSID' ) || undef;
    my $session = CGI::Session->new("driver:File", $sid, {Directory=>'/tmp'});
    
    $self->param( 'session' => $session );
    
    if ( !$sid or $sid ne $session->id )
    {
       my $cookie = $query->cookie(
          -name    => 'CGISESSID',
          -value   => $session->id,
          -expires => '+1y'
       );
       
       $self->header_props( -cookie => $cookie );
    }
    
    # Configure the template
    $self->tt_config(
	TEMPLATE_OPTIONS => {
	INCLUDE_PATH => '/var/www/astroslacker.com/templates',
	#POST_CHOMP   => 1,
	#FILTERS => {
	#    'currency' => sub { sprintf('$ %0.2f', @_) },
	#},
	},
    );
}

sub setup
{
    my $self = shift;
    
    $self->start_mode('index');
    $self->run_modes(
	'index'               => 'index',
	'loginrequest'        => 'loginrequest',
	'clientlogin'         => 'clientlogin',
	'category'            => 'category',
	'clientregistration'  => 'clientregistration',
	'registrationrequest' => 'registrationrequest',
	'clienthome'          => 'clienthome',
	'logout'              => 'logout'
    );
}

sub index
{
    my $self = shift;
    
    my $query   = $self->query();
    my $session = $self->param('session');
    my $schema  = DB::MySQLDB->connection;
    
    my $rc = $schema->resultset('Hits')->create({
	id         => undef,
	ip         => $ENV{REMOTE_ADDR}     || undef,
	cookie     => $ENV{HTTP_COOKIE}     || undef,
	referer    => $ENV{HTTP_REFERER}    || undef,
	hostname   => $ENV{REMOTE_HOST}     || undef,
	method     => $ENV{REQUEST_METHOD}  || undef,
	user_agent => $ENV{HTTP_USER_AGENT} || undef,
	page       => 'index',
    });
    
    my $stardate     = $self->_stardate();
    my $stardate_mp3 = $self->_stardate_mp3();
    
    my $lastupdate = '';
    open (CRON, "/var/www/astroslacker.com/lastcron.txt");
    while (my $record = <CRON>) {
       $lastupdate = $record;
    }
    close(CRON);
    
    # Mon Nov  1 21:00:06 2010
    my ($cweek, $cmonth, $cblank, $cday, $ctime, $cyear) = split(/\s/, $lastupdate);
    my ($nweek, $nmonth, $nblank, $nday, $ntime, $nyear) = split(/\s/, localtime(time));
    
    my ($chours, $cminutes, $cseconds) = split(/\:/, $ctime);
    my ($nhours, $nminutes, $nseconds) = split(/\:/, $ntime);
    
    my $expiredtime = ($nminutes - $cminutes);
    my $nextupdate = (60 - $expiredtime);
    
    my $showupdate = '';
    if ($nextupdate > 0) {
	if ($nextupdate == 1) {
	    $showupdate = qq(| next update in $nextupdate minute);
	} else {
	    $showupdate = qq(| next update in $nextupdate minutes);
	}
    }
    
    # articles
    my $page = $query->param("page");
    
    $page = 1 if( defined $page and $page !~ /^\d+$/ );
    
    my $rs = $schema->resultset('Feeds')->search(
	undef,
	{
	    page => $page || 1,
	    rows => 15,
	    prefetch => 'wav',
	    order_by => 'date DESC',
	}
    );
    
    #use Data::Dumper;
    #print STDERR Dumper($rs);
    
    my $pager = $rs->pager;
    
    use URI::Escape;
    
    my @feeds;
    while (my $rec = $rs->next) {
	# truncate title
	my $title = substr($rec->title, 0, 76);
	
	if ($ENV{'HTTP_USER_AGENT'} =~ 'Android' or $ENV{'HTTP_USER_AGENT'} =~ 'iPhone OS') {
	    if (length($rec->title) > 36) {
		$title .= '...';
	    }
	} else {
	    if (length($rec->title) > 76) {
		$title .= '...';
	    }
	}
	
	my @date = split(" ", $rec->date);
	my @time = split("-", $date[1]);
	
	my $encent = uri_escape($rec->category);
	
	my $link_cat = $self->_scruburl($rec->category);
	
	my $feed_ref = {};
	
	$feed_ref->{link}     = $rec->link;
	$feed_ref->{title}    = $title;
	$feed_ref->{category} = $rec->category;
	$feed_ref->{lcat}     = $link_cat;
	$feed_ref->{date}     = $date[0];
	$feed_ref->{time}     = $time[0];
	$feed_ref->{image}    = $rec->image;
	
	my $medium = $rec->image;
	   $medium =~ s/thumb\_/medium\_/g;
	   
	$feed_ref->{medium_image} = $medium;
	
	$feed_ref->{description} = $rec->description;
	$feed_ref->{wav}         = $rec->wav->wav;
	
	push @feeds, $feed_ref;
    }
    
    my $t_page      = $pager->current_page;
    my $t_pages     = $pager->last_page;
    my $t_show_page = qq($t_page of $t_pages);
    
    my $prevpage = '<< <';
    my $nextpage = '>> >';
    
    if ($pager->previous_page) {
	my $ppage = $pager->previous_page;
	my $fpage = $pager->first_page;
	$prevpage = qq(<a href="?page=$fpage"><<</a> <a href="?page=$ppage"><</a>);
    }
    
    if ($pager->next_page) {
	my $npage = $pager->next_page;
	my $lpage = $pager->last_page;
	$nextpage = qq(<a href="?page=$npage">></a> <a href="?page=$lpage">>></a>);
    }
    
    my %params = (
	loggedin     => $session->param('profile'),
	stardate     => $stardate,
        stardatemp3  => $stardate_mp3,
	lastupdate   => $lastupdate,
	showupdate   => $showupdate,
	feeds        => \@feeds,
	page         => $t_show_page,
        previouspage => $prevpage,
        nextpage     => $nextpage,
    );
    
    if ($ENV{'HTTP_USER_AGENT'} =~ 'Android' or $ENV{'HTTP_USER_AGENT'} =~ 'iPhone OS') {
	return $self->tt_process('index_android.tmpl', \%params);
    } else {
	return $self->tt_process('index.tmpl', \%params);
    }
}

sub category
{
    my $self = shift;
    
    my $query   = $self->query();
    my $session = $self->param('session');
    my $schema  = DB::MySQLDB->connection;
    
    my $cat = $query->param("cat");
    
    my $hitpage = qq(category::$cat);
    
    my $rc = $schema->resultset('Hits')->create({
	id         => undef,
	ip         => $ENV{REMOTE_ADDR}     || undef,
	cookie     => $ENV{HTTP_COOKIE}     || undef,
	referer    => $ENV{HTTP_REFERER}    || undef,
	hostname   => $ENV{REMOTE_HOST}     || undef,
	method     => $ENV{REQUEST_METHOD}  || undef,
	user_agent => $ENV{HTTP_USER_AGENT} || undef,
	page       => $hitpage,
    });
    
    my $stardate     = $self->_stardate();
    my $stardate_mp3 = $self->_stardate_mp3();
    
    my $lastupdate = '';
    open (CRON, "/var/www/astroslacker.com/lastcron.txt");
    while (my $record = <CRON>) {
       $lastupdate = $record;
    }
    close(CRON);
    
    # Mon Nov  1 21:00:06 2010
    my ($cweek, $cmonth, $cblank, $cday, $ctime, $cyear) = split(/\s/, $lastupdate);
    my ($nweek, $nmonth, $nblank, $nday, $ntime, $nyear) = split(/\s/, localtime(time));
    
    my ($chours, $cminutes, $cseconds) = split(/\:/, $ctime);
    my ($nhours, $nminutes, $nseconds) = split(/\:/, $ntime);
    
    my $expiredtime = ($nminutes - $cminutes);
    my $nextupdate = (60 - $expiredtime);
    
    my $showupdate = '';
    if ($nextupdate > 0) {
	if ($nextupdate == 1) {
	    $showupdate = qq(| next update in $nextupdate minute);
	} else {
	    $showupdate = qq(| next update in $nextupdate minutes);
	}
    }
    
    # articles
    my $page = $query->param("page");
    
    $page = 1 if( defined $page and $page !~ /^\d+$/ );
    
    my $put_cat = '';
    if ($cat eq 'Space_Exploration') {
	$put_cat = 'Space & Earth - Space Exploration';
    } elsif ($cat eq 'Environment') {
	$put_cat = 'Space & Earth - Environment';
    } elsif ($cat eq 'Astronomy') {
	$put_cat = 'Space & Earth - Astronomy';
    } elsif ($cat eq 'Earth_Sciences') {
	$put_cat = 'Space & Earth - Earth Sciences';
    } else {
	$put_cat = $cat;
    }
    
    my $rs = $schema->resultset('Feeds')->search(
	category => $put_cat,
	{
	    page => $page || 1,
	    rows => 15,
            prefetch => 'wav',
	    order_by => 'date DESC',
	}
    );
    
    my $pager = $rs->pager;
    
    use URI::Escape;
    
    my @feeds;
    while (my $rec = $rs->next) {
	# truncate title
	my $title = substr($rec->title, 0, 76);
	
	if ($ENV{'HTTP_USER_AGENT'} =~ 'Android' or $ENV{'HTTP_USER_AGENT'} =~ 'iPhone OS') {
	    if (length($rec->title) > 36) {
		$title .= '...';
	    }
	} else {
	    if (length($rec->title) > 76) {
		$title .= '...';
	    }
	}
	
	my @date = split(" ", $rec->date);
	my @time = split("-", $date[1]);
	
	my $encent = uri_escape($rec->category);
	
	my $link_cat = $self->_scruburl($rec->category);
	
	my $feed_ref = {};
	
	$feed_ref->{link}        = $rec->link;
	$feed_ref->{title}       = $title;
	$feed_ref->{category}    = $rec->category;
	$feed_ref->{lcat}        = $link_cat;
	$feed_ref->{date}        = $date[0];
	$feed_ref->{time}        = $time[0];
	$feed_ref->{image}       = $rec->image;
	$feed_ref->{description} = $rec->description;
	$feed_ref->{wav}         = $rec->wav->wav;
	
	push @feeds, $feed_ref;
    }
    
    my $t_page      = $pager->current_page;
    my $t_pages     = $pager->last_page;
    my $t_show_page = qq($t_page of $t_pages);
    
    my $prevpage = '<< <';
    my $nextpage = '>> >';
    
    if ($pager->previous_page) {
	my $ppage = $pager->previous_page;
	my $fpage = $pager->first_page;
	$prevpage = qq(<a href="?rm=category&cat=$cat&page=$fpage"><<</a> <a href="?rm=category&cat=$cat&page=$ppage"><</a>);
    }
    
    if ($pager->next_page) {
	my $npage = $pager->next_page;
	my $lpage = $pager->last_page;
	$nextpage = qq(<a href="?rm=category&cat=$cat&page=$npage">></a> <a href="?rm=category&cat=$cat&page=$lpage">>></a>);
    }
    
    my %params = (
	loggedin     => $session->param('profile'),
	stardate     => $stardate,
        stardatemp3  => $stardate_mp3,
	lastupdate   => $lastupdate,
	showupdate   => $showupdate,
	feeds        => \@feeds,
	page         => $t_show_page,
        previouspage => $prevpage,
        nextpage     => $nextpage,
    );
    
    if ($ENV{'HTTP_USER_AGENT'} =~ 'Android' or $ENV{'HTTP_USER_AGENT'} =~ 'iPhone OS') {
	return $self->tt_process('index_android.tmpl', \%params);
    } else {
	return $self->tt_process('index.tmpl', \%params);
    }
}


sub _scruburl {
    my $self = shift;
    
    my $link_cat = shift;
    
    my $put_cat = '';
    if ($link_cat eq 'Space & Earth - Space Exploration') {
	$put_cat = 'Space_Exploration';
    } elsif ($link_cat eq 'Space & Earth - Environment') {
	$put_cat = 'Environment';
    } elsif ($link_cat eq 'Space & Earth - Astronomy') {
	$put_cat = 'Astronomy';
    } elsif ($link_cat eq 'Space & Earth - Earth Sciences') {
	$put_cat = 'Earth_Sciences';
    } else {
	$put_cat = $link_cat;
    }
    
    return $put_cat;
}

sub _stardate {
    my $self = shift;
    # sub used to format proper date string for daily stardate mp3
    
    # use local version of module
    use lib '/var/www/astroslacker.com/cpan';
    use Time::Format qw(%time %strftime %manip);
    
#     http://stardate.org/radio/program/2010-10-09
#     http://stardate.org/sites/default/files/audio/radio/sd20101008_0.mp3
    
    return $time{'yyyy-mm-dd', time-24*60*60};
}

sub _stardate_mp3 {
    my $self = shift;
    # sub used to format proper date string for daily stardate mp3
    
    # use local version of module
    use lib '/var/www/astroslacker.com/cpan';
    use Time::Format qw(%time %strftime %manip);
    
#     http://stardate.org/radio/program/2010-10-09
#     http://stardate.org/sites/default/files/audio/radio/sd20101008_0.mp3
    
    return 'sd' .$time{'yyyymmdd', time-24*60*60}. '_0.mp3';
}


~Stephen

[ Comments (0) ]



Private SMS Perl Script

2011-09-18 13:17:38 Tags: perl sms apache

So I needed a way to text my Android phone from home and came up with this solution. Here's an overview on the setup.

First, we need apache to have sudo powers, as we are getting email files from a users home directory. Linux by default frowns upon this behaviour so we need to modify our server to allow aphache to have sudo powers. Specically, we need to turn off tty and add apache with no password.

From the command line we issue:
Code:
visudo


Find this line:
Code:
Defaults requiretty


Now change that to show:
Code:
Defaults requiretty
Defaults:%apache !requiretty
Defaults:apache !requiretty


We also have to add the sudo powers for apache user to this file:
Code:
apache   ALL = (root) NOPASSWD: ALL


Now save and close the file by using shift+z twice. Here is the magical Perl script I wrote, with changes made to protect my server and mobile number! ;)

Perl Code:
#!/usr/bin/perl -w
use strict;


use Email::MIME;
use Email::MIME::Creator;
use Email::Send;
use Data::Dumper;

use CGI qw/:standard/;

my $q = CGI->new;

my $rm = $q->param('rm') || 'default';

print "Content-type: text/html\n\n";

print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html lang="en">
<head>
<title>SMS Server</title>';

if ($rm eq 'send_sms') {
    print qq(<meta HTTP-EQUIV="REFRESH" content="5; url=http://domain.name/sms-server.pl">);
} else {
    print qq(<meta HTTP-EQUIV="REFRESH" content="60; url=http://domain.nameg/sms-server.pl">);
}

print '</head>
<body>';

print "<fieldset style=\"font-size:10px; width:600px;\">\n";

if ($rm eq 'send_sms') {
    
    my $sms_body = $q->param('sms_body') || '...';
    
    my $mobile_email_to = '5555555555@vmobl.com';
    
    # Compose E-Mail To Me...
    my @mobile_headers = (
	From    => 'me@domain.name',
	Subject => '',
	To      => $mobile_email_to,
    );
    my $mobile_mailer = Email::Send->new({
	mailer => 'SMTP',
	mailer_args => [ Host => 'localhost' ],
    });
    my $mobule_result = $mobile_mailer->send(
	Email::MIME->create(
	    header => \@mobile_headers,
	    parts => [
		Email::MIME->create(
		    body => $sms_body,
		),
	    ],
	)
    );
    
    my $send_file = time . '.Vca00I3e38cM' .time. '.domain.name';
    
    open FILE, ">", "/var/www/domain.name/sms-messages/new/$send_file";
    print FILE "From: SERVER\n\n" .$sms_body;
    close FILE;
    
    print qq(<span style="font-size: 12px;">Message sent. Refreshing in 5 seconds...</span>);
    
} else {
    
    my $cmd1 = "sudo cp -rf /home/username/Maildir/new /var/www/domain.name/sms-messages/";
    `$cmd1`;
    
    my $cmd2 = "sudo chown -R apache:apache /var/www/domain.name/sms-messages";
    `$cmd2`;
    
    opendir(SMS, "/var/www/domain.name/sms-messages/new") || die("Cannot open directory - " .$!);
    my @emails = readdir(SMS);
    closedir(SMS);
    
    @emails = sort {$b cmp $a} @emails;
    
    open FILE, ">", "/var/www/domain.name/sms-messages/sms.txt";
    
    my $allcnt = 0;
    foreach my $f (@emails) {
	unless ($f eq '.' or $f eq '..') {
	    my $from_me = '';
	    
	    open (SMS, "/var/www/domain.name/sms-messages/new/$f");
	    while (my $record = <SMS>) {
		if ($record =~ 'From' and $record =~ '5555555555@yrmobl.com') {
		    $from_me = 'MOBILE';
		} elsif ($record =~ 'From' and $record =~ 'SERVER') {
		    $from_me = 'SERVER';
		}
	    }
	    close(SMS);
	    
	    if ($from_me eq 'MOBILE' or $from_me eq 'SERVER') {
		$allcnt++;
		my $cnt   = 0;
		open (SMS, "/var/www/domain.name/sms-messages/new/$f");
		while (my $record = <SMS>) {
		    $cnt++;
		}
		close(SMS);
		
		my $cnt2 = 0;
		open (SMS, "/var/www/domain.name/sms-messages/new/$f");
		while (my $record = <SMS>) {
		    $cnt2++;
		    if ($cnt2 == $cnt) {
			
			my @time = split(/\./, $f);
			my $localtime = $time[0];
			
			chomp($from_me);
			chomp($localtime);
			
			chomp($record);
			print FILE "$from_me||$localtime||$record\n";
		    }
		}
		close(SMS);
		
	    } else {
		next;
	    }
	}
    }
    
    close FILE;
    
    print qq(<legend>Text Messages: $allcnt</legend>\n);
    print qq(<div style="height: 500px; overflow:scroll;"><ul>\n);
    
    open (SMS, "/var/www/domain.name/sms-messages/sms.txt");
    while (my $record = <SMS>) {
	my @line = split(/\|\|/, $record);
	
	my $from    = $line[0];
	my $message = $line[2];
	
	my @time = split(/ /, localtime($line[1]));
	
	my $hour = $time[3];
	
	print "<li>\n";
	print qq(<span style="font-size: 14px;">$from [$hour] - $message</span>);
	print "</li>\n";
    }
    close(SMS);
    
    print "</ul></div>\n";
    
    print qq(<p><form action="/sms-server.pl" method="GET">);
    print qq(<input type="hidden" name="rm" value="send_sms">);
    print qq(<hr>Enter message: <input type="text" size="50" name="sms_body">);
    print qq(<input type="submit" value="Send Message">);
    print qq(</form></p>);
    
}

print "</fieldset>";

print '</body>
</html>';


That's it, a perfect SMS solution for private home computer to mobile phone communication.

~Stephen

[ Comments (0) ]



OpenBlog Catalyst App \@ GitHub

2009-08-16 18:33:56 Tags: catalyst perl software

The Catalyst MVC driven software OpenBlog is now available as open source project at GitHub.

Here is the public clone URL:
git://github.com/sasykes/OpenBlog.git

Please contact me if you plan to modify or use the software. I am interested to see if anyone would be interested in future use/development.

~Stephen

[ Comments (1) ]



Domain Lister \@ GitHub

2009-08-12 22:01:12 Tags: catalyst perl software

The Catalyst MVC software driven domain name auction/listing software I developed for MySQLSoftware.net is now available as open source project at GitHub.

Here is the public clone URL:
git://github.com/sasykes/Domain-Lister.git

Please contact me if you plan to modify or use the software. I am interested to see if anyone would be interested in future use/development.

~Stephen

[ Comments (0) ]



Free Agent

2009-08-02 15:16:37 Tags: catalyst perl programming work

I'm now a 'free agent' and looking for a Perl programming gig. If you know of any Perl shops that might be hiring, please give me a shout!

Preferences:
1) Catalyst MVC Web Framework based projects.
2) Modern shop.
3) Telecommute.

~Stephen

[ Comments (0) ]



Template::Plugin::HighlightPerl v0.03

2008-04-25 03:32:19 Tags: perl template toolkit cpan

Version 0.03 is now available on CPAN. This version fixes a bug where no line breaks were added when no code tags are used. This version is stable and probably will be the last update for a while.

Don't forget to restart httpd service after upgrade. ;)

[ Comments (0) ]



Domain Lister v1.0 - Catalyst MVC Application

2008-04-21 23:14:48 Tags: catalyst perl mvc mysql

I am currently hard at work developing a new domain name auction, well an offer/counter-offer, application for MySQLSoftware.net. This system, powered by the Catalyst MVC Web Framework, will replace my existing domain name auction software. I'll be updating the MySQLSoftware.net website soon with more detailed information regarding the release.

All previous software versions will not be considered deprecated, as I will no longer provide support for them. The new application will require a good bit of maintenance/support to new clients, so there will be a maintenance plan implemented once the new version is ready for deployment.

Stay tuned for further details, including a demo version via FastCGI implementation. Mainly administration features are needing finishing touches, including the ability to generate additional administrator accounts.

Screen Shot:


Regards,
Stephen

[ Comments (0) ]



Template::Plugin::HighlightPerl

2008-04-16 21:09:57 Tags: perl template toolkit cpan

CPAN Link:

http://search.cpan.org/perldoc?Template::Plugin::HighlightPerl

I just uploaded my new module to CPAN. The module is a TT2 (Template Toolkit) filter which can be used for blog posts where Perl code is to be shown. It is a sort of wrapper for the Syntax::Highlight::Perl module and is used within the template file (.tt2) as a filter. I say "sort of" because it is really much more than that. It will "dynamically" highlight all perl code based on syntax and includes a css div classes for custom formatting. It also can be used to format non-perl code by using a different set of tags.

Here's a sample of the dynamically generated syntax highlighting.

Perl Code:
package Template::Plugin::HighlightPerl;

use Syntax::Highlight::Perl;
use Template::Plugin::Filter;
use base qw( Template::Plugin::Filter );
use strict;

our $VERSION = '0.01';

sub init {
    my $self = shift;
    my $name = $self->{ _CONFIG }->{ name } || 'highlight_perl';
    $self->install_filter($name);
    return $self;
}


[ Comments (0) ]



MySQLSoftware.net

2008-04-12 03:51:29 Tags: perl software mysql sales

I spent the good part of two days getting mysqlsoftware.net setup on my Linode Fedora 8 VPS. Much work went into server configuration for SSL certification (OpenSSL) and the payment gateway API. When I have some free time I would like to write up a new server prep doc for future reference and for others who may be in need help regrading the same environment setup.

For now, I'll leave this post short. I really need to get back to work on the bulldogracingteam.com Catalyst application.

[stephen]

[ Comments (0) ]



New Blog Up

2008-04-08 17:57:14 Tags: catalyst perl blog software developer mvc

Spent a good deal of time today coding my new blog for stephensykes.us. I'll probably drop the old OpenBlog application as it was just a learning project for me when I started working with Catalyst MVC.

And since I need to test the code tag, here's some interesting code for your amusement. This is actually part of the soon to be implemented tag cloud feature for my blog.

Perl Code:
# Update TagCloud weight
foreach my $fields_dbic (
    $c->model('StephenSykesDB::ArticleTags')->search(
        article_id => $form->{article_id},
        {
         prefetch  => 'tag_cloud',
         },
    )
) {
    if ($fields_dbic->tag_cloud->weight > 0) {
        # Subtract 1 from weight and update tag cloud
        my $new_weight = ($fields_dbic->tag_cloud->weight - 1);
        $c->model('StephenSykesDB::TagCloud')->update_or_create({
            tag_id => $fields_dbic->tag_cloud->tag_id,
            descr  => $fields_dbic->tag_cloud->descr,
            weight => $new_weight,
        });
    }
}
# Delete all ArticleTags and then add new from form
$c->model('StephenSykesDB::ArticleTags')->search({ article_id => $form->{article_id} })->delete;
    
# Split tags on white space
my @tags = split(/ /, $form->{Tags});

foreach my $tag_rec (@tags) {
    $tag_rec =~ tr/[A-Z]/[a-z]/;
    my $tag_cloud_dbic = $c->model('StephenSykesDB::TagCloud')->find({ descr => $tag_rec });
    if ($tag_cloud_dbic) { # update existing tag
        my $new_weight = ($tag_cloud_dbic->weight + 1);
        $c->model('StephenSykesDB::TagCloud')->update_or_create({
            tag_id => $tag_cloud_dbic->tag_id,
            descr  => $tag_cloud_dbic->descr,
            weight => $new_weight,
        });
        # Add tags to site_tags table
        $c->model('StephenSykesDB::ArticleTags')->create({
            article_id => $form->{article_id},
            tag_id     => $tag_cloud_dbic->tag_id,
        });
    } else { # create new tag
        $c->model('StephenSykesDB::TagCloud')->create({
            tag_id => undef,
            descr  => $tag_rec,
            weight => '1',
        });
        # Get new tag_id
        my $tag_dbic = $c->model('StephenSykesDB::TagCloud')->find({ descr => $tag_rec });
        # Add tags to site_tags table
        $c->model('StephenSykesDB::ArticleTags')->create({
            article_id => $form->{article_id},
            tag_id     => $tag_dbic->tag_id,
        });
    }
}


[ Comments (0) ]