path: root/rhautoimport.pm

#!/usr/bin/perl -w
#
#
#  rhautoimport
#
#  Copyright (C) 2009-2016 Christian Pointner <equinox@helsinki.at>
#
#  This file is part of rhautoimport.
#
#  rhautoimport 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.
#
#  rhautoimport 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 rhautoimport. If not, see <http://www.gnu.org/licenses/>.
#

use strict;

package rhautoimport;

use File::Basename;
use File::Temp;
use File::Slurp;
use LWP::Simple;
use XML::Feed;
use RHRD::rddb;
use RHRD::utils;
use JSON::MaybeXS;
use URI::QueryParam;


use constant {
  RD_USER => 'autoimport',
  RHIMPORTD_WATCH_DIR => '/run/rhimportd/watch',
  RHIMPORTD_TIMEOUT => 10,
  CBA_API_KEY => '/etc/cba-api.key'
};

sub report_title_and_last
{
  my ($title, $last_run) = @_;

  $title = "" unless $title;
  $last_run = 0 unless $last_run;

  if (open my $handle, '>&=3') {
    print $handle $title . "\n";
    print $handle $last_run . "\n";
  }
}

sub get_dropboxes
{
  my ($groupname) = @_;

  my ($ctx, $status, $errorstring) = RHRD::rddb::init();
  if(!defined $ctx) {
    return ($ctx, $errorstring);
  }
  my @allowed_dbs = RHRD::rddb::get_dropboxes($ctx, RD_USER, $groupname, 'show');
  RHRD::rddb::destroy($ctx);

  return @allowed_dbs;
}

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

  my $uri = URI->new($url);
  if (defined $queries) {
    while(my ($name, $value) = each %{$queries}) {
      $uri->query_param($name => $value);
    }
  }

  $ua_str = "Radio Helsinki - Automatic Import" unless $ua_str;
  my $ua  = LWP::UserAgent->new;
  $ua->agent($ua_str);
  $ua->env_proxy;
  if (defined $headers) {
    while(my ($field, $value) = each %{$headers}) {
      $ua->default_header($field, $value);
    }
  }

  my $res = URI::Fetch->fetch($uri, UserAgent => $ua);
  return (0, URI::Fetch->errstr) unless $res;
  return (0, "This feed has been permanently removed") if $res->status == URI::Fetch::URI_GONE();

  my $xml = $res->content;

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

sub fetch_parse_rss_cba
{
  my ($url, $ua_str, $headers, $queries) = @_;

  my $api_key = undef;
  if (open my $api_key_file, '<', CBA_API_KEY) {
    $api_key =  <$api_key_file>;
    close $api_key_file;
  }
  if (defined $api_key) {
    chomp $api_key;
    if (defined $queries) {
      $queries->{'c'} = $api_key;
    } else {
      $queries = { 'c' => $api_key };
    }
  }
  return fetch_parse_rss($url, $ua_str, $headers, $queries);
}

sub fetch_parse_json
{
  my ($url, $ua_str, $headers, $queries) = @_;

  $ua_str = "Radio Helsinki - Automatic Import" unless $ua_str;
  return RHRD::utils::fetch_parse_json($url, $ua_str, $headers, $queries);
}

sub fetch_parse_json_audioboom
{
  my ($url, $ua_str, $headers, $queries) = @_;

  if (defined $headers) {
    $headers->{'Accept'} = 'application/json; version=1';
  } else {
    $headers = { 'Accept' => 'application/json; version=1' };
  }
  return fetch_parse_json($url, $ua_str, $headers, $queries);
}

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;
}

#########################################
## rhimportd - watchDir Control Interface

sub parse_result
{
  my ($donefile) = @_;

  my $log = "";
  my $result_json;
  eval {
    $result_json = read_file($donefile, binmode => ':utf8');
    1;
  } or do {
    $log .= "!! error reading import result file !!\n";
    unlink($donefile);
    return (1, $log)
  };

  my $result;
  eval {
    my $j = JSON::MaybeXS->new(utf8 => 0);
    $result = $j->decode($result_json);
    1;
  } or do {
    $log .= "\n!! error parsing import result !!\n";
    unlink($donefile);
    return (1, $log);
  };

  my $response_code = %$result{'RESPONSE_CODE'};
  my $error_string = %$result{'ERROR_STRING'};
  my $cart = %$result{'CART_NUMBER'};
  $cart = 0 unless defined($cart);
  my $cut = %$result{'CUT_NUMBER'};
  $cut = 0 unless defined($cut);
  my $source_file = %$result{'SOURCE_FILE'};

  if(!defined($response_code) || $response_code != 200) {
    if(defined($error_string)) {
      $log .= "rhimportd returnd error: " . $error_string . "\n";
    } else {
      $log .= "rhimportd return invalid result !!\n";
    }
    unlink($donefile);
    return (1, $log);
  }

  $log .= "rhimportd returned: OK (Cart: " . $cart . ", Cut: " . $cut;
  $log .= ", source file: '" . $source_file . "'" if(defined($source_file) && $source_file ne "");
  $log .= ")\n";

  unlink($donefile);
  return (0, $log, $source_file);
}

sub import_uri
{
  my ($show_id, $uri, $file_policy) = @_;

  my %request;
  $request{'LOGIN_NAME'} = RD_USER;
  $request{'SHOW_ID'} = int($show_id);
  $request{'CLEAR_SHOW_CARTS'} = JSON->true;
	$request{'SOURCE_URI'} = $uri;
	$request{'SOURCE_FILE_POLICY'} = $file_policy if $file_policy;

  my $fh = File::Temp->new(TEMPLATE => 'rhautoimport-XXXXXXXX',
                           DIR      => RHIMPORTD_WATCH_DIR,
                           SUFFIX   => '.new');
  return (1, "can't create request file in watchdir\n") unless($fh);

  chmod(0660, $fh);
  my $requestfile = $fh->filename;
  my $log = "request file written to '$requestfile' ... ";

  my $j = JSON::MaybeXS->new(utf8 => 0);
  print $fh $j->encode(\%request);
  print $fh "\n";
  close $fh;

  $requestfile =~ s/.new$//;
  my $runningfile = $requestfile . ".running";
  my $donefile = $requestfile . ".done";

  $log .= "waiting for rhimportd to respond\n";
  for my $i (1..RHIMPORTD_TIMEOUT) {
    sleep(1);
    last if(-e $runningfile || -e $donefile);

    if($i >= RHIMPORTD_TIMEOUT) {
      $log .= "!! timeout waiting for rhimportd ... is it running?\n";
      unlink($requestfile);
      return (1, $log);
    }
  }

  $log .= "import is running ... waiting for result\n";
  my $duration = 0;
  while(1) {
    last if(-e $donefile);
    sleep(1);
    $duration++;
  }
  $log .= "import is done ... took " . $duration . " seconds!\n";

  my ($ret, $tmplog, $keptfile_uri) = parse_result($donefile);
  return $ret, $log . $tmplog, $keptfile_uri;
}

#########################################
## PV

sub pv_add_note
{
  my ($title, $text, $id, $date, $type, $index) = @_;
  my @args = ($id, $date, $type);
  push(@args , $index) if defined($index);

  return RHRD::utils::pv_execute_action('addnote', $title . "\n" . $text, @args);
}

1;