summaryrefslogtreecommitdiff
path: root/rhautoimport.pm
diff options
context:
space:
mode:
Diffstat (limited to 'rhautoimport.pm')
-rw-r--r--rhautoimport.pm247
1 files changed, 247 insertions, 0 deletions
diff --git a/rhautoimport.pm b/rhautoimport.pm
new file mode 100644
index 0000000..76e3893
--- /dev/null
+++ b/rhautoimport.pm
@@ -0,0 +1,247 @@
+#!/usr/bin/perl -w
+#
+#
+# rhautoimport
+#
+# Copyright (C) 2009-2015 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 IO::Handle;
+use IPC::Open3;
+use File::Spec;
+use File::Basename;
+use URI::Escape;
+use LWP::Simple;
+use XML::Feed;
+
+my $ssh_host = "airplay";
+my $ssh_user = "rhautoimport";
+my $ssh_key_file = "$ENV{'HOME'}/.rhautoimport/import.key";
+my $ssh_dir = "/programm/.rhautoimport";
+my $rdimport_wrapper = "/usr/local/bin/dropbox_newfile.pl";
+
+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 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 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 = ('python', '/srv/pv/pv/manage.py', '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;