added tool rhrd-tool (most library functions are still missing)

5 files changed, 238 insertions, 2 deletions

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;