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;
use File::Basename;
use URI::Escape;
use POSIX;
use DateTime;
use DateTime::TimeZone;
use LWP::Simple;
use XML::Feed;

my $ssh_host = "airplay";
my $ssh_user = "rhimport";
my $ssh_key_file = "$ENV{'HOME'}/.rhimport/import.key";
my $ssh_dir = "/programm/.rhimport";
my $rdimport_wrapper = "/usr/local/bin/dropbox_newfile.pl";

sub get_rd_week
{
  #
  # This computes the current Rivendell Week based on the number
  # of weeks since epoch.
  #
  # Explanation:
  #  epoch was at 01.01.1970 which was a Thursday.
  #  Monday in that week is (s-from-epoch + 3*24*60*60) seconds ago.
  #  This needs to be adjusted by the timezone offset for Europe/Vienna
  #  which is of course not constant (damn you daylight savings time)
  #  Divide this by (7*24*60*60) and you get the number of
  #  weeks since the Monday in the week of epoch adjusted for timezone offsets.
  #  This week had week number 3 so add an offset of 2 and
  #  get the modulo of 4. This rounded down gives you the current week
  #  with 0 meaning Week 1. So add 1 to that number and you will get
  #  the current RD week.
  #
  my $now = DateTime->now();
  my $tz = DateTime::TimeZone->new(name => 'Europe/Vienna');
  my $tz_offset = $tz->offset_for_datetime($now);
  my $sEpoch = $now->epoch() + $tz_offset;  
  my $week = floor(((($sEpoch + 259200)/604800) + 2) % 4) + 1;

  return $week;
}

sub fetch_parse_rss
{
  my ($url, $ua_str) = @_;

  my $uri = URI->new($url);
  $ua_str = "Radio Helsinki - Automatic Import" unless $ua_str;

  my $ua  = LWP::UserAgent->new;
  $ua->agent($ua_str);
  $ua->env_proxy;
  my $res = URI::Fetch->fetch($uri, UserAgent => $ua)
    or die URI::Fetch->errstr;
  die "This feed has been permanently removed"
    if $res->status == URI::Fetch::URI_GONE();

  my $xml = $res->content;

  return XML::Feed->parse(\$xml);
}

sub check_key_file
{
  if(-e "$ssh_key_file") {
    return 1;
  }
  return 0;
}

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

  my $sql = "";
  if($group) {
    $sql = qq{select USER_PERMS.GROUP_NAME,DROPBOXES.PATH,DROPBOXES.TO_CART,GROUPS.DESCRIPTION from USER_PERMS, DROPBOXES, GROUPS where USER_PERMS.USER_NAME='$user' and DROPBOXES.GROUP_NAME=USER_PERMS.GROUP_NAME and DROPBOXES.GROUP_NAME=GROUPS.NAME and DROPBOXES.GROUP_NAME='$group';};
  } else {
    $sql = qq{select USER_PERMS.GROUP_NAME,DROPBOXES.PATH,DROPBOXES.TO_CART,GROUPS.DESCRIPTION from USER_PERMS, DROPBOXES, GROUPS where USER_PERMS.USER_NAME='$user' and DROPBOXES.GROUP_NAME=USER_PERMS.GROUP_NAME and DROPBOXES.GROUP_NAME=GROUPS.NAME;};
  }
  my $sth = $dbh->prepare($sql);
  $sth->execute();
  my @allowed_dbs;
  while(my ($group, $path, $to_cart, $desc) = $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 - $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 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 get_num_carts
{
  my ($dbh, $group) = @_;

  my ($low_cart, $high_cart) = get_cart_range($dbh, $group);
  return $high_cart - $low_cart + 1;
}

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

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

  my $log = "clearing Carts $low_cart - $high_cart\n";
  print $log;
  my $cart = $low_cart;
  while($cart <= $high_cart) {
    $progress_cb->($cart - $low_cart, $high_cart + 1 - $low_cart, "deleting $cart") if($progress_cb);

    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()) {
      delete_file("/var/snd/$cut_name.wav");
      $log .= " - deleting 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++;
  }

  return $log;
}

sub check_file_extension
{
  my ($file) = @_;

  my $ext = uc((fileparse($file, qr/\.[^.]*/))[2]);
  foreach (".MP3", ".OGG", ".FLAC", ".WAV") {
    if($ext eq $_) {
      return 1;
    }
  }
  return 0;
}

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

  print "Starting import from playlist $playlist to $dropbox";
  my @entries;
  open (FILE, $playlist) or die "can't open playlist $playlist: $!";
  binmode(FILE, ":utf8");
  while (my $entry = <FILE>) {
    next if($entry =~ /^#/);
    next if($entry =~ /^\s/);
    $entry =~ s/\n$//;
    $entry =~ s/^file:\/\///;
    $entry = uri_unescape($entry);
    next if(-d $entry);
    next if(!-r $entry);
    push @entries, $entry;
  }
  close(FILE);
  my $num_entries = scalar(@entries);
  print " ($num_entries Files in list -> $num_carts available)\n";

  if($num_carts < $num_entries) {
    if($error_cb) {
      my $ret = $error_cb->("Achtung!\nDie Playlist beinhaltet mehr als $num_carts Dateien. Es werden nur die ersten $num_carts Dateien importiert.");
      if(!$ret) {
        return 0, "too many files in playlist";
      }

      $#entries = $num_carts-1;
      $num_entries = scalar(@entries);
    }
  }
  print "will import $num_entries files\n";

  my $cnt = 0;
  my $ret = 0;
  my $log = "";
  prepare_import($user);
  for my $entry ( @entries ) {
    $progress_cb->($cnt, $num_entries, $entry) if($progress_cb);

    my $out;
    ($ret, $out) = import_file($entry, $dropbox, $user, $error_cb);
    $log .= "\n--- $entry ---\n$out\n" if $out;
    last if($ret == 0);

    $cnt++;
  }

  if($ret) {
    $progress_cb->($num_entries, $num_entries, "Import abgeschlossen!") if($progress_cb);
  } else {
    $progress_cb->($cnt, $num_entries, "Import abgebrochen!") if($progress_cb);
  }

  return ($ret, $log);
}

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

sub scp_put_file
{
  my ($file, $user, $host, $path) = @_;
  my @cmd = ( 'scp', '-prqB', '-i', $ssh_key_file, $file, "$user\@$host:$path/" );
  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);
  binmode($reader, ":utf8");
  binmode($writer, ":utf8");
  binmode($error, ":utf8");
  waitpid $pid, 0;
  my $errstr = "";
  if ( $? >> 8 ) {
    $errstr = join('', <$error>);
  }
  return $errstr;
}

sub ssh_exec_command
{
  my ($command) = @_;
  my @cmd = ( 'ssh' , '-q', '-o', 'BatchMode=yes', '-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);
  binmode($reader, ":utf8");
  binmode($writer, ":utf8");
  binmode($error, ":utf8");
  waitpid $pid, 0;
  my $out = join('', <$reader>);
  my $errstr = "";
  if ( $? >> 8 ) {
    $errstr = join('', <$error>);
    $errstr = "unkown error" if($errstr eq "");
  }
  return ($out, $errstr);
}

sub prepare_import
{
  my ($user) = @_;

  ### create user directory
  ssh_exec_command("umask 002; mkdir -p \"$ssh_dir/$user\"");
}

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

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

  ### copy file to master server
  my $err = scp_put_file($file, $ssh_user, $ssh_host, "$ssh_dir/$user");
  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/$user/$remote_file";
  my ($out ,$error) = ssh_exec_command("$rdimport_wrapper --path \"$dropbox\" --file \"$remote_file\"");
  my $lastline = $1 if $out =~ /\n(.*)$/;
  if($error ne "" || $lastline !~ /^[0-9:\- ]+:\s+Deleted file/) {
    print "Import Error\n";
    delete_file($remote_file);
    if($error_cb) {
      if($error) {
        return $error_cb->("Import Fehler: $error");
      }
      else {
        return $error_cb->("Import Fehler: \n$out");
      }
    }
    return 0;
  }

  print "imported OK\n";
  return (1, $out);
}

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

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

sub pv_add_note
{
  my ( $title, $text, $id, $date, $type, $index ) = @_;
  my @script = ('/usr/bin/ssh', 'root@web', 'addnote', $id, $date, $type);
  push(@script , $index) unless (!defined $index);

  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, @script);
  binmode($reader, ":utf8");
  binmode($writer, ":utf8");
  binmode($error, ":utf8");
  print $writer $title . "\n" . $text;
  close $writer;
  waitpid $pid, 0;
  my $err_out = join('', <$error>);
  my $read_out = join('', <$reader>);
  if ( $? >> 8 ) {
    print "\n\nPV: adding note returned non-zero value\n";
    print "STDERR:\n" . $err_out . "\n" unless $err_out eq '';
    print "STDOUT:\n" . $read_out . "\n" unless $read_out eq '';
    print "Ignoring failed headline import!\n";
  } else {
    print $read_out . "\n" unless $read_out eq '';
    print $err_out . "\n" unless $err_out eq '';
  }
}

1;