* Fix: Modification of a read-only value attempted at Tools.pm line 154

* RECORDS: Calc free recording capacity, now based on used file size

13 files changed, 63 insertions, 42 deletions

diff --git a/lib/Tools.pm b/lib/Tools.pm
index 1e55df2..8830ef8 100644
--- a/lib/Tools.pm
+++ b/lib/Tools.pm
@@ -127,7 +127,7 @@ sub lg {
 # ------------------
 sub event {
 # ------------------
-    my $msg = sprintf(shift, @_);
+    my $msg = shift;
 
     my ($package, $filename, $line, $subroutine) = caller(3);
 
@@ -141,7 +141,7 @@ sub event {
 # ------------------
 sub debug {
 # ------------------
-    my $msg = sprintf(shift, @_);
+    my $msg = shift;
 
     &lg('ERR:250 ' . $msg, 2, 2);
 
@@ -151,7 +151,7 @@ sub debug {
 # ------------------
 sub error {
 # ------------------
-    my $msg = sprintf(shift, @_);
+    my $msg = shift;
 
     &lg('ERR:501 ' . $msg, 1, 2);
 
@@ -161,7 +161,7 @@ sub error {
 # ------------------
 sub panic {
 # ------------------
-    my $msg = sprintf(shift, @_);
+    my $msg = shift;
 
     &lg('ERR:550 ' . $msg, 1, 2);
 
@@ -601,7 +601,7 @@ sub touch {
     lg sprintf("Call touch file '%s'", $file );
     utime ($now, $now, $file)
         || open (TMP, ">>$file")
-        || error ("Couldn't touch '%s' : %s",$file,$!);
+        || error sprintf("Couldn't touch '%s' : %s",$file,$!);
 }
 
 1;
diff --git a/lib/XXV/MODULES/CHANNELS.pm b/lib/XXV/MODULES/CHANNELS.pm
index 2721821..e4f74fb 100644
--- a/lib/XXV/MODULES/CHANNELS.pm
+++ b/lib/XXV/MODULES/CHANNELS.pm
@@ -599,7 +599,7 @@ sub getChannelType {
         }
       }
     }
-    error("Unknown channel! Couldn't identify type of channel with id: %s", $id);
+    error sprintf("Unknown channel! Couldn't identify type of channel with id: %s", $id);
     return 'UNKNOWN';
 }
 
diff --git a/lib/XXV/MODULES/EPG.pm b/lib/XXV/MODULES/EPG.pm
index 1870766..440c629 100644
--- a/lib/XXV/MODULES/EPG.pm
+++ b/lib/XXV/MODULES/EPG.pm
@@ -399,7 +399,7 @@ sub compareEpgData {
         }
       }
     } 
-    debug 'Finish .. %d events created, %d events replaced, %d events deleted', $changedData, $updatedData, $deleteData;
+    debug sprintf('Finish .. %d events created, %d events replaced, %d events deleted', $changedData, $updatedData, $deleteData);
 
     return ($changedData + $updatedData + $deleteData);
 }
@@ -486,7 +486,6 @@ sub readEpgData {
     my $channelname;
     my $event;
 
-    #debug 'Read %d lines in EPG Database from %d', scalar @$vdata,$offset;
     for(;$count < scalar (@$vdata);$count++) {
       my $line = @{$vdata}[$count];
 
@@ -531,7 +530,7 @@ sub readEpgData {
       # Next channel 
       if($mark eq 'C') {
         if($channel) {
-          debug 'Missing channel endtag c at line %d',$count;
+          debug sprintf('Missing channel endtag c at line %d',$count);
           return ($dataHash,$channel,$channelname,$count) if(scalar keys %$dataHash);
         }
         undef $event->{channel};
@@ -567,7 +566,6 @@ sub readEpgData {
         $event->{vpstime} = $data;
       }
     }
-#   debug 'Finish Read %d lines in EPG Database at %d', scalar @$vdata,$count;
     return ($dataHash,$channel,$channelname,$count);
 }
 
@@ -1191,7 +1189,7 @@ sub getId {
         return $erg
             if($erg);
     }
-    lg("Event %d does not exist!", $id);
+    lg sprintf("Event %d does not exist!", $id);
     return {};
 }
 
@@ -1203,7 +1201,7 @@ sub suggest {
     my $console = shift || return error('No console defined!');
     my $search = shift;
     my $params  = shift;
-
+  
     if($search) {
         my $ch = '';
         if($params->{channel}) {
diff --git a/lib/XXV/MODULES/GRAB.pm b/lib/XXV/MODULES/GRAB.pm
index 0a07b63..aa84fff 100644
--- a/lib/XXV/MODULES/GRAB.pm
+++ b/lib/XXV/MODULES/GRAB.pm
@@ -179,7 +179,7 @@ sub grab {
     } else {
 
         if(-e $file) {
-          unlink($file) || error("Couldn't remove '%s' : %s",$file,$!);
+          unlink($file) || error sprintf("Couldn't remove '%s' : %s",$file,$!);
         }
         # the command
         my $cmd = sprintf('grab %s jpeg %d %d %d',
diff --git a/lib/XXV/MODULES/INTERFACE.pm b/lib/XXV/MODULES/INTERFACE.pm
index febe9ed..60fc584 100644
--- a/lib/XXV/MODULES/INTERFACE.pm
+++ b/lib/XXV/MODULES/INTERFACE.pm
@@ -98,7 +98,7 @@ sub init {
             )
             -> dispatch_to('SOAPService');
 
-        debug("Install the SOAP server at %s", $daemon->url);
+        debug sprintf("Install the soap server at %s", $daemon->url);
         my ($sock, $httpd) = $daemon->getDaemon();
 
         Event->io(
diff --git a/lib/XXV/MODULES/MUSIC.pm b/lib/XXV/MODULES/MUSIC.pm
index ea66421..13906af 100644
--- a/lib/XXV/MODULES/MUSIC.pm
+++ b/lib/XXV/MODULES/MUSIC.pm
@@ -772,7 +772,7 @@ sub stream {
             $file = $obj->{path} . "/" . $file
                 if($obj->{mdbh});
 
-            debug('Stream file "%s" to client: %s',
+            debug sprintf('Stream file "%s" to client: %s',
                 $file,$client);
             my $erg = $obj->{ICE}->stream($file,0,$client)
                 || last;
@@ -1103,7 +1103,7 @@ sub ConnectToMuggleDB {
         if($mdbh) {
             $mdbh->{InactiveDestroy} = 1;
             $mdbh->{mysql_auto_reconnect} = 1;
-            debug('Connect to database: %s successful.', $dsn);
+            debug sprintf('Connect to database: %s successful.', $dsn);
             return $mdbh;
         } else {
             debug('GiantDisc database not found! Use standard music database!');
diff --git a/lib/XXV/MODULES/RECORDS.pm b/lib/XXV/MODULES/RECORDS.pm
index 3a35565..7ff3801 100644
--- a/lib/XXV/MODULES/RECORDS.pm
+++ b/lib/XXV/MODULES/RECORDS.pm
@@ -257,19 +257,20 @@ sub _init {
     }
 
     # remove old table, if updated rows
-    tableUpdated($obj->{dbh},'RECORDS',10,1);
+    tableUpdated($obj->{dbh},'RECORDS',11,1);
 
     # Look for table or create this table
     my $version = main::getVersion;
     $obj->{dbh}->do(qq|
       CREATE TABLE IF NOT EXISTS RECORDS (
           eventid bigint unsigned NOT NULL,
-          RecordId int(11) unsigned not NULL,
+          RecordId int unsigned not NULL,
           RecordMD5 varchar(32) NOT NULL,
           Path text NOT NULL,
           Prio tinyint NOT NULL,
           Lifetime tinyint NOT NULL,
           State tinyint NOT NULL,
+          FileSize int unsigned default '0', 
           Marks text,
           Type enum('TV', 'RADIO', 'UNKNOWN') default 'TV',
           addtime timestamp,
@@ -406,6 +407,7 @@ sub readData {
     my $stat = $obj->{svdrp}->command('stat disk');
     my ($total, $totalUnit, $free, $freeUnit, $percent);    
     my $totalDuration = 0;
+    my $totalSpace = 0;
 
     if($stat->[1] and $stat->[1] =~ /^250/s) {
         #250 473807MB 98028MB 79%
@@ -450,6 +452,7 @@ sub readData {
                         UNIX_TIMESTAMP(e.addtime) as addtime,
                         r.Path as path,
                         r.Type as type,
+                        r.FileSize,
                         r.Marks as marks,
                         r.RecordMD5
                  from RECORDS as r,OLDEPG as e 
@@ -507,6 +510,7 @@ sub readData {
               }
           } 
           $totalDuration += $db_data->{$h}->{duration};
+          $totalSpace += $db_data->{$h}->{FileSize};
           
           push(@merkIds,$db_data->{$h}->{eventid});
 
@@ -527,6 +531,7 @@ sub readData {
           my $anahash = $obj->analyze($event);
           if(ref $anahash eq 'HASH') {
               $totalDuration += $anahash->{Duration};
+              $totalSpace += $anahash->{FileSize};
 
               if($obj->insert($anahash)) {
                   push(@merkIds,$anahash->{eventid});
@@ -555,16 +560,13 @@ sub readData {
     debug sprintf 'Finish .. %d recordings inserted, %d recordings updated, %d recordings removed',
            $insertedData, $updatedState, $db_data ? scalar keys %$db_data : 0;
 
-    $obj->{CapacityTotal} = $totalDuration;
-    $obj->{CapacityPercent}  = (100.0 / $total) * ($total - $free)
-        if($total && $totalUnit eq $freeUnit);
 
+    error sprintf("Unsupported unit '%s' to calc free capacity",$freeUnit) unless($freeUnit eq 'MB');
     # use store capacity and recordings length to calc free capacity
-    if($totalDuration > 3600) {
-      $obj->{CapacityFree} = ($totalDuration * 100.0 / $obj->{CapacityPercent}) - $totalDuration;
-    } else {
-      $obj->{CapacityFree} = $free * 3600 / 2000; # use 2GB at one hour 
-    }
+    $obj->{CapacityTotal} = $totalDuration;
+    $obj->{CapacityFree} = ($free * $totalDuration) / $totalSpace;
+    $obj->{CapacityPercent}  = ($totalSpace * 100 / ($free + $totalSpace))
+      unless($obj->{CapacityPercent});
 
     # Previews im fork erzeugen
     if(scalar @{$obj->{JOBS}}) {
@@ -672,8 +674,8 @@ sub insert {
     my $sth = $obj->{dbh}->prepare(
     qq|
      REPLACE INTO RECORDS
-        (eventid, RecordId, RecordMD5, Path, Prio, Lifetime, State, Marks, Type )
-     VALUES (?,?,md5(?),?,?,?,?,?,?)
+        (eventid, RecordId, RecordMD5, Path, Prio, Lifetime, State, FileSize, Marks, Type )
+     VALUES (?,?,md5(?),?,?,?,?,?,?,?)
     |);
 
     $attr->{Marks} = ""
@@ -687,6 +689,7 @@ sub insert {
         $attr->{Prio},
         $attr->{Lifetime},
         $attr->{State},
+        $attr->{FileSize},
         $attr->{Marks},
         $attr->{Type},
     );
@@ -780,7 +783,8 @@ sub analyze {
         Lifetime  => $info->{Lifetime},
         eventid => $event->{eventid},
         Type  => $info->{type} || 'UNKNOWN',
-        State => $recattr->{state}
+        State => $recattr->{state},
+        FileSize => $info->{FileSize}
     };
     $ret->{Marks} = join(',', @{$info->{marks}})
         if(ref $info->{marks} eq 'ARRAY');
@@ -840,6 +844,25 @@ sub videoInfo {
 
         $status->{duration} = $obj->_recordinglength($path);
 
+
+        # Calc used disc space (MB)
+        my $sizeMB;
+        my $mb = (1024 * 1024);
+        my $size = 0;
+        $status->{FileSize} = 0;
+        foreach my $f (@files) {
+          $size += stat($f)->size;
+          if($size > $mb) {
+            $sizeMB = int($size / $mb);
+            $size -= $sizeMB * $mb;
+            $status->{FileSize} += $sizeMB;
+          }
+        }
+        if($size > 0) {
+          $sizeMB = int($size / $mb);
+          $status->{FileSize} += $sizeMB;
+        }
+
         # Schnittmarken ermitteln
         my $marks = sprintf("%s/marks.vdr", $path);
         if(-r $marks) {
diff --git a/lib/XXV/MODULES/REPORT.pm b/lib/XXV/MODULES/REPORT.pm
index 232693e..9aafd8d 100644
--- a/lib/XXV/MODULES/REPORT.pm
+++ b/lib/XXV/MODULES/REPORT.pm
@@ -142,7 +142,7 @@ sub init {
         );
 
         unless($mod) {
-            error('Problem to load Module %s!',$moduleName);
+            error sprintf('Problem to load modul %s!',$moduleName);
             next;
         }
 
@@ -150,11 +150,11 @@ sub init {
 
         main::addModule($moduleName, $obj->{NEWSMODS}->{$moduleName});
 
-        debug sprintf("Load NEWS Module %s(%s)\n",
+        debug sprintf("Load news modul %s(%s)\n",
             $moduleName,
             (ref $obj->{NEWSMODS}->{$moduleName})
                 ? $obj->{NEWSMODS}->{$moduleName}->{MOD}->{Version}
-                : 'Problem!');
+                : 'failed!');
     }
 
     return 1;
@@ -281,7 +281,7 @@ sub scala {
     if($typ and exists $obj->{SCALA}->{$typ}) {
         return $obj->{SCALA}->{$typ};
     } else {
-        return error("Level %s does not exist! Please use %s", $typ, join(',', keys %{$obj->{SCALA}}));
+        return error sprintf("Level %s does not exist! Please use %s", $typ, join(',', keys %{$obj->{SCALA}}));
     }
 }
 
diff --git a/lib/XXV/MODULES/SHARE.pm b/lib/XXV/MODULES/SHARE.pm
index aef7d4d..f37d777 100644
--- a/lib/XXV/MODULES/SHARE.pm
+++ b/lib/XXV/MODULES/SHARE.pm
@@ -123,7 +123,7 @@ sub _init {
         $obj->{SOAP} = $obj->ConnectToService($obj->{SessionId},$obj->{rating});
 
         unless($obj->{SOAP}) {
-            error("Couldn't connect to popularity web service %s!", $obj->{rating});
+            error sprintf("Couldn't connect to popularity web service %s!", $obj->{rating});
             return 0;
         } else {
             my $servertime = $obj->getServerTime();
diff --git a/lib/XXV/MODULES/TIMERS.pm b/lib/XXV/MODULES/TIMERS.pm
index f7759c6..e9fde8b 100644
--- a/lib/XXV/MODULES/TIMERS.pm
+++ b/lib/XXV/MODULES/TIMERS.pm
@@ -465,7 +465,7 @@ sub saveTimer {
                 ], $pos);
     }
 
-    event('Save timer "%s" with id: "%d"', $data->{File}, $pos);
+    event sprintf('Save timer "%s" with id: "%d"', $data->{File}, $pos);
 
     return $erg;
 }
@@ -1014,7 +1014,7 @@ sub readData {
     if($oldTimers) {
         my $timers = $obj->getNewTimers($oldTimers);
         foreach my $timerdata (@$timers) {
-            event('New timer "%s" with id: "%d"', $timerdata->{File}, $timerdata->{Id});
+            event sprintf('New timer "%s" with id: "%d"', $timerdata->{File}, $timerdata->{Id});
         }
         $obj->updated() if(scalar @$timers);
     }
diff --git a/lib/XXV/MODULES/USER.pm b/lib/XXV/MODULES/USER.pm
index 93be4b2..5043828 100644
--- a/lib/XXV/MODULES/USER.pm
+++ b/lib/XXV/MODULES/USER.pm
@@ -805,7 +805,7 @@ sub checkCmdSyntax {
         foreach my $cmdName (sort keys %{$modCfg->{Commands}}) {
             my $short = $modCfg->{Commands}->{$cmdName}->{short} || $cmdName;
             if(exists $shorts->{$short} ) {
-                return error("[ERROR] In %s::%s double short name %s, also in %s!",
+                return error sprintf("[ERROR] In %s::%s double short name %s, also in %s!",
                     $modName, $cmdName, $short, $shorts->{$short});
             } else {
                 $shorts->{$short} = $modName.'::'.$cmdName;
diff --git a/lib/XXV/OUTPUT/NEWS/JABBER.pm b/lib/XXV/OUTPUT/NEWS/JABBER.pm
index 09300a4..ca8061e 100644
--- a/lib/XXV/OUTPUT/NEWS/JABBER.pm
+++ b/lib/XXV/OUTPUT/NEWS/JABBER.pm
@@ -184,7 +184,7 @@ sub jconnect {
 
     my ($user, $server) = split('\@', $obj->{user});
 
-    debug ("Connecting to jabber server: %s ...", $server);
+    debug sprintf("Connecting to jabber server: %s ...", $server);
 
     my @res = $jcon->Connect(
         hostname    =>  $server,
@@ -192,7 +192,7 @@ sub jconnect {
     return
         unless($obj->xmpp_check_result("Connect",\@res,$jcon));
 
-    debug ("Authentificat with User:%s ...", $user);
+    debug sprintf("Authentificat with User:%s ...", $user);
 
     @res = $jcon->AuthSend(
       'hostname'=>$server,
@@ -285,12 +285,12 @@ sub xmpp_check_result {
 
     # result can be true or 'ok'
     if ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') {
-	    return debug "%s: %s", $txt, $$res[0];
+	    return debug sprintf("%s: %s", $txt, $$res[0]);
     # otherwise, there is some error
     } else {
 	    my $errmsg = $cnx->GetErrorCode() || '?';
         $cnx->Disconnect();
-	    return error("Error %s: %s [%s]", $txt, join (': ',@$res), $errmsg);
+	    return error sprintf("Error %s: %s [%s]", $txt, join (': ',@$res), $errmsg);
     }
 }
 
diff --git a/lib/XXV/OUTPUT/NEWS/MAIL.pm b/lib/XXV/OUTPUT/NEWS/MAIL.pm
index 78089b6..ae3a1dd 100644
--- a/lib/XXV/OUTPUT/NEWS/MAIL.pm
+++ b/lib/XXV/OUTPUT/NEWS/MAIL.pm
@@ -218,7 +218,7 @@ sub send {
         subject => "News from your XXV System!" ,
         msg     => $content,
         msgid   => $obj->{COUNT},
-    ) || return error('Problem to send Mail: %s', $Mail::SendEasy::ER);
+    ) || return error sprintf('Problem to send mail: %s', $Mail::SendEasy::ER);
 
     $obj->{LastReportTime} = time;