discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/admin/Ticker.pm

185 lines
4.0 KiB
Perl
Raw Permalink Normal View History

2024-06-17 11:49:12 +00:00
#!/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;