185 lines
4.0 KiB
Perl
185 lines
4.0 KiB
Perl
#!/bin/env perl
|
|
|
|
#
|
|
# This is a simple exception class to aid in error checking and validation.
|
|
#
|
|
package Ticker::TickerException;
|
|
use base qw(Error);
|
|
use overload ('""'=>'stringify');
|
|
|
|
sub new {
|
|
my $self = shift;
|
|
my $text = "" . shift;
|
|
my @args = ();
|
|
|
|
local $Error::Depth = $Error::Depth + 1;
|
|
local $Error::Debug = 1;
|
|
|
|
$self->SUPER::new(-text => $text, @args);
|
|
}
|
|
|
|
|
|
#
|
|
# The model (or 'business logic') for the Ticker application.
|
|
#
|
|
package Ticker;
|
|
use strict;
|
|
use warnings;
|
|
use lib '/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin';
|
|
use Links qw(:objects);
|
|
|
|
#
|
|
# Creates the Ticker table.
|
|
#
|
|
sub create_table() {
|
|
my $p = $DB->creator('Ticker');
|
|
$p->cols([
|
|
ticker_id => { type => 'INT', not_null => 1 },
|
|
ticker_text => { type => 'TEXT', not_null => 1},
|
|
ticker_link => { type => 'TEXT', not_null => 1},
|
|
]);
|
|
|
|
$p->pk('ticker_id');
|
|
$p->ai('ticker_id');
|
|
|
|
if(!$p->create and $GT::SQL::errcode eq 'TBLEXISTS') {
|
|
$p->set_defaults();
|
|
$p->save_schema();
|
|
}
|
|
}
|
|
|
|
#
|
|
# Validates messages.
|
|
#
|
|
sub validate_message($) {
|
|
my $msg = shift;
|
|
unless(defined $msg) {
|
|
throw Ticker::TickerException("Message must be defined.");
|
|
}
|
|
if((length($msg) == 0) || (length($msg) > 255)) {
|
|
throw Ticker::TickerException("Message must be between 1 and 255 characters in length.");
|
|
}
|
|
if($msg !~ /^[\w\s\$\&\.\-\!]+$/) {
|
|
throw Ticker::TickerException("Message can only contain letters, numbers, spaces, and the special characters \"\$\& -.!\".");
|
|
}
|
|
}
|
|
|
|
|
|
#
|
|
# Validates links.
|
|
#
|
|
sub validate_link($) {
|
|
my $link = shift;
|
|
unless(defined $link) {
|
|
throw Ticker::TickerException("Link must be defined.");
|
|
}
|
|
if((length($link) == 0) || (length($link) > 255)) {
|
|
throw Ticker::TickerException("Link must be between 1 and 255 characters in length.");
|
|
}
|
|
if($link !~ /^http:\/\// && $link !~ /^https:\/\//) {
|
|
throw Ticker::TickerException("Links must begin with http:// or https://");
|
|
}
|
|
}
|
|
|
|
|
|
#
|
|
# Validates ids.
|
|
#
|
|
sub validate_id($) {
|
|
my $id = shift;
|
|
if($id !~ /^\d+$/) {
|
|
throw Ticker::TickerException("Invalid ticker ID.");
|
|
}
|
|
}
|
|
|
|
|
|
#
|
|
# Returns a hashref, keyed on the id, of all tickers present in the database.
|
|
#
|
|
sub read_tickers() {
|
|
my $sth = $DB->table('Ticker')->select();
|
|
return $sth->fetchall_hashref('ticker_id');
|
|
}
|
|
|
|
|
|
#
|
|
# Returns an xml-formatted string of all tickers present in the database.
|
|
#
|
|
sub read_tickers_xml() {
|
|
my $results = read_tickers();
|
|
my $xml = qq{<?xml version="1.0" encoding="iso-8859-1"?>\n};
|
|
$xml .= qq{<?xml-stylesheet type="text/xsl" href="http://www.slowtwitch.com/xsl/ticker.xsl"?>\n};
|
|
$xml .= "<scroller>";
|
|
foreach my $v(@$results) {
|
|
my $line = qq{\n\t<lineitem marquee="} .
|
|
$v->{ticker_text} .
|
|
qq{" link="} .
|
|
$v->{ticker_link} .
|
|
qq{"/>};
|
|
$xml .= $line;
|
|
}
|
|
$xml .= "\n</scroller>";
|
|
return $xml;
|
|
}
|
|
|
|
|
|
#
|
|
# Returns a hashref, keyed on the id, of one ticker.
|
|
#
|
|
sub read_ticker($) {
|
|
my ($id) = @_;
|
|
|
|
validate_id($id);
|
|
|
|
return $DB->table('Ticker')->get($id);
|
|
}
|
|
|
|
|
|
#
|
|
# Adds a ticker to the database, taking the message and link as arguments.
|
|
#
|
|
sub create_ticker($$) {
|
|
my ($msg, $link) = @_;
|
|
|
|
validate_message($msg);
|
|
validate_link($link);
|
|
|
|
return $DB->table('Ticker')->add({
|
|
ticker_text => $msg,
|
|
ticker_link => $link
|
|
});
|
|
}
|
|
|
|
|
|
#
|
|
# Update a ticker in the database, taking the old id and new message and
|
|
# link as arguments.
|
|
#
|
|
sub update_ticker($$$) {
|
|
my ($id, $msg, $link) = @_;
|
|
|
|
validate_id($id);
|
|
validate_message($msg);
|
|
validate_link($link);
|
|
|
|
return $DB->table('Ticker')->modify({
|
|
ticker_id => $id,
|
|
ticker_text => $msg,
|
|
ticker_link => $link
|
|
});
|
|
}
|
|
|
|
|
|
#
|
|
# Deletes a ticker from the database, taking the id to remove.
|
|
#
|
|
sub delete_ticker($) {
|
|
my ($id) = @_;
|
|
|
|
validate_id($id);
|
|
|
|
return $DB->table('Ticker')->delete($id);
|
|
}
|
|
|
|
1;
|