From 24ec6833f3bb6c665506612105137c71cd82debe Mon Sep 17 00:00:00 2001
From: Christian Pointner <equinox@helsinki.at>
Date: Thu, 28 Jul 2016 18:18:09 +0200
Subject: added tool rhrd-tool (most library functions are still missing)
diff --git a/MANIFEST b/MANIFEST
index 21da700..51691de 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,3 +13,4 @@ utils/rhrd-show
utils/rhrd-user
utils/rhrd-sanity-check
utils/rhrd-schedules
+utils/rhrd-pool
diff --git a/Makefile.PL b/Makefile.PL
index 99be55e..fb4e632 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
use 5.004;
-my @utils = qw(get-rd-token get-rd-week update-rd-tokens rhrd-user rhrd-group rhrd-schedules rhrd-show rhrd-sanity-check);
+my @utils = qw(get-rd-token get-rd-week update-rd-tokens rhrd-user rhrd-group rhrd-pool rhrd-schedules rhrd-show rhrd-sanity-check);
WriteMakefile(
NAME => 'RHRD',
diff --git a/debian/control b/debian/control
index 1d7f05c..4f8c5dc 100644
--- a/debian/control
+++ b/debian/control
@@ -15,7 +15,7 @@ Description: Radio Helsinki Rivendell Perl Modules
Package: rhrd-utils
Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends}, librhrd-perl, libstring-mkpasswd-perl, libcolor-scheme-perl
+Depends: ${misc:Depends}, ${perl:Depends}, librhrd-perl, libstring-mkpasswd-perl
Description: Radio Helsinki Rivendell Utilities
This package contains the following tools
* get-rd-token
@@ -26,3 +26,4 @@ Description: Radio Helsinki Rivendell Utilities
* rhrd-user
* rhrd-sanity-check
* rhrd-schedules
+ * rhrd-pool
diff --git a/debian/rhrd-utils.install b/debian/rhrd-utils.install
index 97effc6..4d6ff45 100644
--- a/debian/rhrd-utils.install
+++ b/debian/rhrd-utils.install
@@ -6,3 +6,4 @@ usr/bin/rhrd-show
usr/bin/rhrd-user
usr/bin/rhrd-sanity-check
usr/bin/rhrd-schedules
+usr/bin/rhrd-pool
diff --git a/utils/rhrd-pool b/utils/rhrd-pool
new file mode 100755
index 0000000..7d95082
--- /dev/null
+++ b/utils/rhrd-pool
@@ -0,0 +1,233 @@
+#!/usr/bin/perl -w
+#
+# rhrdlibs
+#
+# Copyright (C) 2015-2016 Christian Pointner <equinox@helsinki.at>
+#
+# This file is part of rhrdlibs.
+#
+# rhrdlibs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# any later version.
+#
+# rhrdlibs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU Affero General Public License for more details.
+#
+# You should have received a copy of the GNU Affero General Public License
+# along with rhrdlibs. If not, see <http://www.gnu.org/licenses/>.
+#
+
+use strict;
+use lib '../lib/';
+use RHRD::rddb;
+use RHRD::utils;
+use Date::Calc;
+
+sub print_usage
+{
+ print STDERR "Usage: rhrd-pool list\n" .
+ " rhrd-pool (show|remove) <short-name>\n" .
+ " rhrd-pool add <short-name> <groupname> <title>\n" .
+ " rhrd-pool edit <short-name> <title>\n";
+}
+
+sub list
+{
+ my ($ctx) = @_;
+
+ my @pools = RHRD::rddb::list_pools($ctx);
+ if(!defined $pools[0] && defined $pools[1]) {
+ print STDERR "$pools[1]: $pools[2]";
+ return 1;
+ }
+ for my $href (@pools) {
+ print $href->{'SHORTNAME'} . ": " . $href->{'TITLE'} . "\n";
+ }
+ return 0;
+}
+
+sub show
+{
+ my ($ctx, $shortname) = @_;
+
+ my ($pool, $status, $errorstring) = RHRD::rddb::get_pool_info($ctx, $shortname);
+ unless (defined $pool) {
+ print STDERR "$errorstring\n";
+ return 1;
+ }
+ print $pool->{'TITLE'} . "(" . $pool->{'NUM'} . "):\n";
+ print " group: " . $pool->{'GROUP'} . ", <...cart info...>\n"; # TODO print info about cart usage
+ return 0;
+}
+
+sub add__check_arguments
+{
+ my ($groupname, $shortname, $title) = @_;
+
+ if($groupname !~ m/^[-a-zA-Z0-9_]{1,10}$/) {
+ print STDERR "name '" . $groupname . "' contains illegal characters or is too long/short\n";
+ print STDERR " only a-z, A-Z, 0-9 and _,- are allowed and the length must be between 1 and 10\n";
+ return 1;
+ }
+
+ if($shortname !~ m/^P([0-9]{2})$/) {
+ print STDERR "short name '" . $shortname . "' must be a value between P00 and P99\n";
+ return 1;
+ }
+ my $color = RHRD::utils::POOL_COLORS->[int($1)];
+ return 0, $color;
+}
+
+sub add
+{
+ my ($ctx, $shortname, $groupname, $title) = @_;
+
+ my ($ret, $color) = add__check_arguments($groupname, $shortname, $title);
+ if($ret) {
+ return $ret;
+ }
+
+ print " * creating pool: '" . $title . "' (" . $shortname . ") with group '" . $groupname . "'\n";
+
+ my ($result, $status, $errorstring) = RHRD::rddb::check_group($ctx, $groupname);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+ if($result) {
+ print STDERR "group " . $groupname . " already exists!\n";
+ return 1
+ }
+
+ print " * creating group '" . $groupname . "'\n";
+ ($result, $status, $errorstring) = RHRD::rddb::create_pool_group($ctx, $groupname);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+
+ ($result, $status, $errorstring) = RHRD::rddb::create_pool_event($ctx, $shortname, $groupname);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+ print " * created event\n";
+
+ ($result, $status, $errorstring) = RHRD::rddb::create_pool_clock($ctx, $shortname, $color);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+ print " * created clock (color: " . $color . ")\n";
+
+ ($result, $status, $errorstring) = RHRD::rddb::create_show_dropbox($ctx, $groupname, $shortname);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+ print " * created dropbox for pool .. " . $result . " rows affected\n";
+
+ print " * finished\n";
+
+ return 0;
+}
+
+
+sub edit
+{
+ my ($ctx, $shortname, $title) = @_;
+
+ my ($result, $status, $errorstring) = RHRD::rddb::update_pool_title($ctx, $shortname, $title);
+ unless(defined $result) {
+ print STDERR $status . ": " . $errorstring . "\n";
+ return 1;
+ }
+ if ($result != 1) {
+ print "pool '" . $shortname ."' does not exist.\n";
+ return 1;
+ }
+
+ print "pool '" . $shortname . "' successfully changed!\n";
+ return 0;
+}
+
+sub remove
+{
+ my ($ctx, $shortname) = @_;
+
+ my @results = RHRD::rddb::remove_pool($ctx, $shortname);
+ if(!defined $results[0] && defined $results[2]) {
+ print STDERR $results[1] . ": " . $results[2] . "\n";
+ return 1;
+ }
+ for my $href (@results) {
+ print int($href->{cnt}) . " " . $href->{name} . " deleted\n";
+ }
+
+ return 0;
+}
+
+my $num_args = $#ARGV + 1;
+if($num_args < 1) {
+ print_usage();
+ exit(1);
+}
+my $cmd = $ARGV[0];
+my $ret = 0;
+
+my ($ctx, $status, $errorstring) = RHRD::rddb::init();
+if(defined $ctx) {
+ if($cmd eq "list") {
+ if($num_args > 1) {
+ print_usage();
+ $ret = 1;
+ } else {
+ $ret = list($ctx)
+ }
+ }
+ elsif($cmd eq "show") {
+ if($num_args != 2) {
+ print_usage();
+ $ret = 1;
+ } else {
+ $ret = show($ctx, $ARGV[1])
+ }
+ }
+ elsif($cmd eq "remove") {
+ if($num_args != 2) {
+ print_usage();
+ $ret = 1;
+ } else {
+ $ret = remove($ctx, $ARGV[1]);
+ }
+ }
+ elsif($cmd eq "add") {
+ if($num_args != 4) {
+ print_usage();
+ $ret = 1;
+ } else {
+ $ret = add($ctx, $ARGV[1], $ARGV[2], $ARGV[3]);
+ }
+ }
+ elsif($cmd eq "edit") {
+ if($num_args != 3) {
+ print_usage();
+ $ret = 1;
+ } else {
+ $ret = edit($ctx, $ARGV[1], $ARGV[2]);
+ }
+ }
+ else {
+ print_usage();
+ $ret = 1;
+ }
+ RHRD::rddb::destroy($ctx);
+} else {
+ print STDERR "$errorstring\n";
+ $ret = 1;
+}
+
+exit $ret;
--
cgit v0.10.2