2 files changed, 75 insertions, 26 deletions

diff --git a/lib/rddb.pm b/lib/rddb.pm
index f307d51..226c415 100755
--- a/lib/rddb.pm
+++ b/lib/rddb.pm
@@ -56,16 +56,16 @@ sub check_token
 
   my $sql = qq{select PASSWORD from USERS where LOGIN_NAME = ?;};
   my $sth = $dbh->prepare($sql)
-    or return (0, 'ERROR', "Database Error: " . $dbh->errstr);
+    or return (undef, 'ERROR', "Database Error: " . $dbh->errstr);
 
   $sth->execute($username)
-    or return (0, 'ERROR', "Database Error: " . $sth->errstr);
+    or return (undef, 'ERROR', "Database Error: " . $sth->errstr);
 
   my ($token_result) = $sth->fetchrow_array;
   $sth->finish();
 
   unless(defined $token_result) {
-    return (0, 'ERROR', "user '" . $username . "' not known by rivendell")
+    return (undef, 'ERROR', "user '" . $username . "' not known by rivendell")
   }
 
   if($token_result == $token) {
@@ -74,36 +74,50 @@ sub check_token
   return (0, 'ERROR', "wrong password");
 }
 
-sub get_cart_range
+sub get_dropboxes
 {
-  my ($dbh, $group) = @_;
-
-  my $sql = qq{select DEFAULT_LOW_CART,DEFAULT_HIGH_CART from GROUPS where NAME = ?;};
-  my $sth = $dbh->prepare($sql)
-    or return (undef, undef, 'ERROR', "Database Error: " . $dbh->errstr);
-
-  $sth->execute($group)
-    or return (undef, undef, 'ERROR', "Database Error: " . $sth->errstr);
+  my ($dbh, $username) = @_;
 
-  my ($low_cart, $high_cart) = $sth->fetchrow_array();
-  $sth->finish();
+  my $sql = qq{select USER_PERMS.GROUP_NAME,DROPBOXES.PATH,DROPBOXES.TO_CART,GROUPS.DESCRIPTION from USER_PERMS, DROPBOXES, GROUPS where USER_PERMS.USER_NAME= ? and DROPBOXES.GROUP_NAME=USER_PERMS.GROUP_NAME and DROPBOXES.GROUP_NAME=GROUPS.NAME;};
 
-  unless(defined $low_cart && defined $high_cart) {
-    return (undef, undef, 'ERROR', "group '" . $group . "' not known by rivendell")
-  }
-  return ($low_cart, $high_cart, 'OK', 'success');
-}
+  my $sth = $dbh->prepare($sql)
+    or return (undef, 'ERROR', "Database Error: " . $dbh->errstr);
 
-sub get_num_carts
-{
-  my ($dbh, $group) = @_;
+  $sth->execute($username)
+    or return (undef, 'ERROR', "Database Error: " . $sth->errstr);
 
-  my ($low_cart, $high_cart, $status, $errorstring) = get_cart_range($dbh, $group);
-  unless(defined $low_cart && defined $high_cart) {
-    return (undef, $status, $errorstring);
+  my @allowed_dbs;
+  while(my ($group, $path, $to_cart, $desc) = $sth->fetchrow_array()) {
+    $path =~ s/\/\*$//;
+    my $name = $path;
+    if($name =~ /^([0-9]{2}-[A-Za-z]+)\/([0-9]{2})([0-9]{2})-([01]{4})-([0-9]{3})\/(.*)$/) {
+      $name = "$1 - $2:$3 - $6 ($4, $5)";
+    }
+    elsif($name =~ /^([0-9]{2}-[A-Za-z]+)\/jingle$/ || $name =~ /^jingles\/(.*)$/) {
+      $name = "Jingles - $1";
+    }
+    elsif($name =~ /^pool\/pool(.*)$/) {
+      $name = "Pool $1 - $desc";
+    }
+    elsif($name =~ /^pool\/(.*)$/) {
+      $name = "Pool - $1";
+    }
+    elsif($name =~ /^sondersendungen\/(.*)$/) {
+      $name = "Sondersendungen - $1";
+    }
+    elsif($name =~ /^autoimport\/(.*)$/) {
+      $name = "autoimport - $1";
+    }
+    my $perm = {};
+    $perm->{'GROUP'} = $group;
+    $perm->{'PATH'} = $path;
+    $perm->{'TO_CART'} = $to_cart;
+    $perm->{'NAME'} = $name;
+    push @allowed_dbs, $perm;
   }
+  $sth->finish();
 
-  return ($high_cart - $low_cart + 1, 'OK', 'success');
+  return sort { uc($a->{'NAME'}) cmp uc($b->{'NAME'}) } @allowed_dbs;
 }
 
 
diff --git a/listdrobpoxes.cgi b/listdrobpoxes.cgi
new file mode 100755
index 0000000..4f7050a
--- /dev/null
+++ b/listdrobpoxes.cgi
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use File::Basename;
+use lib dirname( __FILE__ ) . '/lib';
+use rddb;
+
+my $status = 'ERROR';
+my $errorstring = 'unknown';
+my $responsecode = 500;
+
+my $username = '';
+my $token = '';
+
+
+my $dbh;
+$dbh, $status, $errorstring) = rddb::opendb();
+if(defined $dbh) {
+  ($result, $status, $errorstring) = rddb::check_token($dbh, $username, $token);
+  if($result == 1) {
+    $responsecode = 200;
+  } elsif($result == 0) {
+    $responsecode = 403;
+  } else {
+    $responsecode = 500;
+  }
+  rddb::closedb($dbh);
+}
+
+print "Content-type: application/xml\n\n";
+
+print "<RDWebResult>\n";
+print "  <ResponseCode>" . $responsecode . "</ResponseCode>\n";
+print "  <ErrorString>" . $errorstring . "</ErrorString>\n";
+print "</RDWebResult>\n";