path: root/rhimport.pm

#!/usr/bin/perl -w
#
#
#  rhimport
#
#  Copyright (C) 2009 Christian Pointner <equinox@helsinki.at>
#
#  This file is part of rhimport.
#
#  rhimport is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation, either version 3 of the License, or
#  any later version.
#
#  rhimport 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 General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with rhimport. If not, see <http://www.gnu.org/licenses/>.
#

use strict;

package rhimport;

use IO::Handle;
use IPC::Open3;
use File::Spec;

my $ssh_host = "airplay";
my $ssh_user = "rhimport";
my $ssh_key_file = "id_dsa";
my $ssh_dir = "/programm/.rhimport";
my $rdimport_wrapper = "/usr/local/bin/dropbox_newfile.pl";

sub get_dropboxes
{
  my ($dbh, $user) = @_;

  my $sql = qq{select USER_PERMS.GROUP_NAME,DROPBOXES.PATH,DROPBOXES.TO_CART from USER_PERMS, DROPBOXES where USER_PERMS.USER_NAME='$user' and DROPBOXES.GROUP_NAME=USER_PERMS.GROUP_NAME;};
  my $sth = $dbh->prepare($sql);
  $sth->execute();
  my @allowed_dbs;
  while(my ($group, $path, $to_cart) = $sth->fetchrow_array()) {
    $path =~ s/\/\*$//;
    my $name = $path;
    $name =~ s/^\/programm\///;
    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]+)\/programmvorschau_(.*)$/) {
      $name = "Programmvorschau - $1 - $2";
    }
    elsif($name =~ /^([0-9]{2}-[A-Za-z]+)\/jingle$/ || $name =~ /^jingles\/(.*)$/) {
      $name = "Jingles - $1";
    }
    elsif($name =~ /^pool\/pool(.*)$/) {
      $name = "Pool - $1";
    }
    elsif($name =~ /^pool\/(.*)$/) {
      $name = "Pool - $1";
    }
    elsif($name =~ /^sondersendungen\/(.*)$/) {
      $name = "Sondersendungen - $1";
    }
    my $perm = {};
    $perm->{'GROUP'} = $group;
    $perm->{'PATH'} = $path;
    $perm->{'TO_CART'} = $to_cart;
    $perm->{'NAME'} = $name;
    push @allowed_dbs, $perm;
  }
  $sth->finish();

  return sort { uc($a->{'NAME'}) cmp uc($b->{'NAME'}) } @allowed_dbs;
}

sub get_cart_range
{
  my ($dbh, $group) = @_;

  my $sql = qq{select DEFAULT_LOW_CART,DEFAULT_HIGH_CART from GROUPS where NAME='$group';};
  my $sth = $dbh->prepare($sql);
  $sth->execute();
  my @carts;
  my ($low_cart, $high_cart) = $sth->fetchrow_array();
  $sth->finish();

  return ($low_cart, $high_cart);
}

sub get_used_carts
{
  my ($dbh, $group) = @_;

  my ($low_cart, $high_cart) = get_cart_range($dbh, $group);
  my @carts;
  return @carts;
}

sub clear_carts
{
  my ($dbh, $group, $to_cart) = @_;

  my ($low_cart, $high_cart) = ($to_cart, $to_cart);
  if($to_cart == 0) {
    ($low_cart, $high_cart) = get_cart_range($dbh, $group);
  }

  print "clearing Carts $low_cart - $high_cart\n";
  my $cart = $low_cart;
  while($cart <= $high_cart) {
    my $sql = qq{select CUT_NAME from CUTS where CART_NUMBER='$cart';};
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    while(my $cut_name = $sth->fetchrow_array()) {
##    TODO:  Error handling would be nice!
      delete_file("/var/snd/$cut_name.wav");
    }
    $sth->finish();
    
    $sql = qq{delete from CUTS where CART_NUMBER='$cart';};
    $sth = $dbh->prepare($sql);
    $sth->execute();
    $sth->finish();
    
    $sql = qq{delete from CART where NUMBER='$cart';};
    $sth = $dbh->prepare($sql);
    $sth->execute();
    $sth->finish();
    
    $cart++;
  }
}

sub import_playlist
{
  my ($playlist, $dropbox, $progress_cb, $error_cb) = @_;

  print "Starting import from playlist $playlist to $dropbox";
  my @entries;
  open (FILE, $playlist) or die "can't open playlist $playlist: $!";
  while (my $entry = <FILE>) {
    next if($entry =~ /^#/);
    next if($entry =~ /^\s/);
    $entry =~ s/\n$//;
    push @entries, $entry;    
  }
  close(FILE);
  my $num_entries = scalar(@entries);
  print " ($num_entries Files in list)\n";
  
  my $cnt = 0;
  my $ret = 0;
  for my $entry ( @entries ) {
    $progress_cb->($cnt, $num_entries, $entry) if($progress_cb);

    $ret = import_file($entry, $dropbox, $error_cb);
    last if($ret == 0);

    $cnt++;
  }

  $progress_cb->($num_entries, $num_entries, "Import abgeschlossen!") if($progress_cb);

  return $ret;
}

sub import_single
{
  my ($file, $dropbox, $progress_cb, $error_cb) = @_;
  print "Starting import from file $file to $dropbox\n";
  $progress_cb->(0, 1, $file) if($progress_cb);
  my $ret = import_file($file, $dropbox, $error_cb);
  $progress_cb->(1, 1, "Import abgeschlossen!") if($progress_cb);
  return $ret;
}

sub scp_put_file {
  my ($file) = @_;
  my @cmd = ( 'scp', '-prqB' , '-i', $ssh_key_file, $file, "$ssh_user\@$ssh_host:$ssh_dir/" );
  my ($reader, $writer, $error ) = ( new IO::Handle, new IO::Handle, new IO::Handle );
  $writer->autoflush(1);
  local $SIG{CHLD} = 'DEFAULT';
  my $pid = open3($writer, $reader, $error, @cmd);
  waitpid $pid, 0;
  my $errstr = "";
  if ( $? >> 8 ) {
    $errstr = join('', <$error>);
  }
  return $errstr;
}

sub ssh_exec_command {
  my ($command) = @_;
  my @cmd = ( 'ssh', '-q' , '-i', $ssh_key_file, "$ssh_user\@$ssh_host" , $command );
  my ($reader, $writer, $error ) = ( new IO::Handle, new IO::Handle, new IO::Handle );
  $writer->autoflush(1);
  local $SIG{CHLD} = 'DEFAULT';
  my $pid = open3($writer, $reader, $error, @cmd);
  waitpid $pid, 0;
  my $out = join('', <$reader>);
  my $errstr = "";
  if ( $? >> 8 ) {
    $errstr = join('', <$error>);
    $errstr = "unkown error" if($errstr eq "");
  }
  return ($out, $errstr);
}

sub import_file
{
  my ($file, $dropbox, $error_cb) = @_;

  print " - importing $file to $dropbox .. ";
  $| = 1;

  ### copy file to master server and
  my $err = scp_put_file($file);
  if($err ne "") {
    print "Transfer Error\n";
    if($error_cb) {
      return $error_cb->($err);
    }
    return 0;
  }
  print "transferred .. ";

  ### remotely call rdimport 
  my ($volume, $directories, $remote_file) = File::Spec->splitpath($file);
  $remote_file = "$ssh_dir/$remote_file"; 
  my ($out ,$error) = ssh_exec_command("$rdimport_wrapper --path \"$dropbox\" --file \"$remote_file\"");
  if($error ne "") {
    print "Import Error\n";
    delete_file($remote_file);
    if($error_cb) {
      return $error_cb->($err);
    }
    return 0;
  }

  print "imported OK\n";
  return 1;
}

sub delete_file
{
  my ($filename) = @_;

  print " - deleting $filename\n";
  my ($out ,$err) = ssh_exec_command("rm \"$filename\"");
  if($err ne "") {
    return 0;
  }
  return 1;
}

1;