listen to records

After the end of a show, the audio recordings are uploaded to a
directory "listen_dir" under a secret name, beginning with the
transmission date "yyyy-mm-dd hh_mm". The directory is available as URL
"listen_url", but must not be listable.  In order to gain access to the
recording for 7 days after the show, a check is done to determine
whether the file is available. A random key for the show is stored in
the database if a file matching the date is found in listen_dir.  With
this key as a name, a symbolic link to the original audio file is
created.  The random name can be used in public documents.  If the show
data is read again, the key will be retrieved from the database. File
access can be restricted by the Apache2 handler ListenerAccess.pm. With
it, access to the public symlink is possible for one week.

lib/calcms/events.pm

@@ -5,6 +5,9 @@ use warnings;
 no warnings 'redefine';
 
 use Data::Dumper;
+use MIME::Base64();
+use Encode();
+
 use DBI();
 use template();
 
@@ -176,6 +179,8 @@ sub modify_results ($$$$) {
         }
 
         $result = calc_dates( $config, $result, $params, $previous_result, $time_diff );
+        
+        set_listen_key($config, $result);
 
         $result->{event_uri} = '';
         if ( ( defined $result->{program} ) && ( $result->{program} ne '' ) ) {
@@ -535,6 +540,63 @@ sub calc_dates {
     return $result;
 }
 
+sub set_listen_key($$){
+    my ($config, $event) =@_;
+    
+    my $time_zone = $config->{date}->{time_zone};
+    my $start = time::datetime_to_utc( $event->{start_datetime}, $time_zone );
+    my $now = time::datetime_to_utc( time::time_to_datetime( time() ), $time_zone);
+    my $over_since = $now-$start;
+    return if $over_since < 0;
+    return if $over_since > 7*24*60*60;
+
+    my $archive_url = $config->{locations}->{listen_url};
+    if (defined $event->{listen_key}){
+        $event->{listen_url} = $archive_url . '/' . $event->{listen_key};
+        return;
+    }
+
+    my $datetime = $event->{start_datetime};
+    if ( $datetime =~ /(\d\d\d\d\-\d\d\-\d\d)[ T](\d\d)\:(\d\d)/ ) {
+        $datetime = $1 . '\ ' . $2 . '_' . $3;
+    } else {
+        print STDERR "update_recording_link: no valid datetime found $datetime\n";
+        return;
+    }
+    my $archive_dir = $config->{locations}->{local_archive_dir};
+    my @files = glob( $archive_dir . '/' . $datetime . '*.mp3' );
+    return if @files <= 0;
+
+    my $key  = int( rand(99999999999999999) );
+    $key = MIME::Base64::encode_base64($key);
+    $key =~ s/[^a-zA-Z0-9]//g;
+    $key .='.mp3';
+
+    my $audio_file = Encode::decode( "UTF-8", $files[0] );
+    my $link = $archive_dir . '/' . $key;
+    symlink $audio_file, $link or die "cannot create $link, $!";
+    $event->{listen_url} = $archive_url . '/' . $key;
+    $event->{listen_key} = $key;
+    events::update_listen_key($config, $event);
+}
+
+sub update_listen_key($$){
+    my ($config, $event) = @_; 
+                    
+    return undef unless defined $event->{event_id};
+    return undef unless defined $event->{listen_key};
+    print STDERR "set listen_key=$event->{listen_key} for ".$event->{start}." ".$event->{title}."\n";
+    my $bindValues = [ $event->{listen_key}, $event->{event_id} ];
+
+    my $query = qq{
+        update calcms_events
+        set listen_key=? 
+        where id=?;
+    };
+    my $dbh = db::connect($config);
+    my $recordings = db::put( $dbh, $query, $bindValues );
+}
+
 sub add_recordings($$$$) {
     my ($dbh, $config, $request, $events) = @_;