summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2008-04-07 16:11:08 +0000
committerAndreas Brachold <vdr07@deltab.de>2008-04-07 16:11:08 +0000
commit4661c74cdb300f64e3058cbc384148d76c703d56 (patch)
treee9415a41777b589a44bc2bac854e5694f98b925c /lib
parent00bd3aff2a832d6b7379fc02ccbd5c884acc6d7c (diff)
downloadxxv-4661c74cdb300f64e3058cbc384148d76c703d56.tar.gz
xxv-4661c74cdb300f64e3058cbc384148d76c703d56.tar.bz2
* Remove String::Escape, use now regular expression to remove unwanted part of unicode as last character
* Reformat message 'Couldn't load perl module...' * different ways to load binary/text files * RECORDS: Prepare list of commands at perl code and not into template code * RECORDS: Load images less strictness * Reorder locale routines
Diffstat (limited to 'lib')
-rw-r--r--lib/Bundle/Xxv.pm1
-rw-r--r--lib/Tools.pm48
-rw-r--r--lib/XXV/MODULES/AUTOTIMER.pm5
-rw-r--r--lib/XXV/MODULES/CHANNELS.pm5
-rw-r--r--lib/XXV/MODULES/CHRONICLE.pm5
-rw-r--r--lib/XXV/MODULES/CONFIG.pm5
-rw-r--r--lib/XXV/MODULES/EPG.pm5
-rw-r--r--lib/XXV/MODULES/EVENTS.pm5
-rw-r--r--lib/XXV/MODULES/GRAB.pm5
-rw-r--r--lib/XXV/MODULES/HTTPD.pm5
-rw-r--r--lib/XXV/MODULES/INTERFACE.pm5
-rw-r--r--lib/XXV/MODULES/LOGREAD.pm5
-rw-r--r--lib/XXV/MODULES/MEDIALIB.pm5
-rw-r--r--lib/XXV/MODULES/MOVETIMER.pm5
-rw-r--r--lib/XXV/MODULES/MUSIC.pm5
-rw-r--r--lib/XXV/MODULES/RECORDS.pm29
-rw-r--r--lib/XXV/MODULES/REMOTE.pm5
-rw-r--r--lib/XXV/MODULES/REPORT.pm5
-rw-r--r--lib/XXV/MODULES/ROBOT.pm5
-rw-r--r--lib/XXV/MODULES/SHARE.pm5
-rw-r--r--lib/XXV/MODULES/STATUS.pm5
-rw-r--r--lib/XXV/MODULES/STREAM.pm5
-rw-r--r--lib/XXV/MODULES/SVDRP.pm5
-rw-r--r--lib/XXV/MODULES/TELNET.pm5
-rw-r--r--lib/XXV/MODULES/TIMERS.pm5
-rw-r--r--lib/XXV/MODULES/USER.pm5
-rw-r--r--lib/XXV/MODULES/VTX.pm5
-rw-r--r--lib/XXV/MODULES/WAPD.pm5
-rw-r--r--lib/XXV/MODULES/XMLTV.pm7
-rw-r--r--lib/XXV/OUTPUT/Ajax.pm7
-rw-r--r--lib/XXV/OUTPUT/Console.pm5
-rw-r--r--lib/XXV/OUTPUT/Dump.pm5
-rw-r--r--lib/XXV/OUTPUT/Html.pm34
-rw-r--r--lib/XXV/OUTPUT/NEWS/JABBER.pm5
-rw-r--r--lib/XXV/OUTPUT/NEWS/MAIL.pm5
-rw-r--r--lib/XXV/OUTPUT/NEWS/RSS.pm5
-rw-r--r--lib/XXV/OUTPUT/NEWS/VDR.pm5
-rw-r--r--lib/XXV/OUTPUT/Wml.pm11
38 files changed, 212 insertions, 80 deletions
diff --git a/lib/Bundle/Xxv.pm b/lib/Bundle/Xxv.pm
index f02c88b..aa1be5c 100644
--- a/lib/Bundle/Xxv.pm
+++ b/lib/Bundle/Xxv.pm
@@ -50,7 +50,6 @@ Proc::Killfam
Proc::ProcessTable
SOAP::Lite
SOAP::Transport::HTTP
-String::Escape
Template
Time::Local
Time::HiRes
diff --git a/lib/Tools.pm b/lib/Tools.pm
index f7d1864..e4a1b5d 100644
--- a/lib/Tools.pm
+++ b/lib/Tools.pm
@@ -352,12 +352,16 @@ or use the script contrib/update-xxv to upgrade the database!
sub load_file {
#--------------------------------------------------------
my $file = shift || return error('No file defined!');
+ my $binmode = shift || 'text';
- lg sprintf('Load file "%s"',
- $file,
- );
+ lg sprintf('Load file "%s" (%s)',$file, $binmode);
+
+ my $mode = '<';
+# if($binmode ne 'binary') {
+# $mode .= ':utf8' if($CHARSET && $CHARSET eq 'UTF-8');
+# }
- my $fh = IO::File->new("< $file")
+ my $fh = IO::File->new($file,$mode)
or return error(sprintf("Couldn't open %s : %s!",$file,$!));
my $data;
while ( defined (my $l = <$fh>) ) {
@@ -370,22 +374,26 @@ sub load_file {
#--------------------------------------------------------
sub save_file {
#--------------------------------------------------------
- my ($file, $data) = @_;
- return unless($file);
+ my $file = shift || return error('No file defined!');
+ my $data = shift || '';
+ my $binmode = shift || 'text';
- $data =~ s/\r\n/\n/sig;
+ return unless($file);
- lg sprintf('Save file %s(%s)',
- $file,
- convert(length($data))
- );
+ lg sprintf('Save file %s(%s)',$file,convert(length($data)));
+ my $mode = '>';
- my $fhi = new IO::File("> $file")
- or return error(sprintf("Couldn't write %s : %s!",$file,$!));
- print $fhi $data;
- $fhi->close;
+ if($binmode ne 'binary') {
+ $data =~ s/\r\n/\n/sig;
+# $mode .= ':utf8' if($CHARSET && $CHARSET eq 'UTF-8');
+ }
+
+ my $fh = IO::File->new($file,$mode)
+ or return error(sprintf("Couldn't write %s : %s!",$file,$!));
+ print $fh $data;
+ $fh->close;
- return $file
+ return $file
}
@@ -629,7 +637,9 @@ sub entities {
$s =~ s/>/&gt;/g;
$s =~ s/</&lt;/g;
$s =~ s/\"/&quot;/g;
- if($CHARSET ne 'UTF-8') {
+ if($CHARSET eq 'UTF-8') {
+ $s =~ s/(\~)/sprintf("&#x%02x;",ord($1))/eg;
+ } else {
$s =~ s/([^a-zA-Z0-9&%;:,\.\!\?\(\)\_\|\'\r\n ])/sprintf("&#x%02x;",ord($1))/eg;
}
$s =~ s/\r\n/<br \/>/g;
@@ -642,9 +652,7 @@ sub reentities {
# ------------------
my $s = shift || return '';
- if($CHARSET ne 'UTF-8') {
- $s =~ s/\&\#x([a-fA-F0-9][a-fA-F0-9])\;/pack("C", hex($1))/eg;
- }
+ $s =~ s/\&\#x([a-fA-F0-9][a-fA-F0-9])\;/pack("C", hex($1))/eg;
$s =~ s/&amp;/&/g;
$s =~ s/&gt;/>/g;
$s =~ s/&lt;/</g;
diff --git a/lib/XXV/MODULES/AUTOTIMER.pm b/lib/XXV/MODULES/AUTOTIMER.pm
index 74617ab..8f54038 100644
--- a/lib/XXV/MODULES/AUTOTIMER.pm
+++ b/lib/XXV/MODULES/AUTOTIMER.pm
@@ -249,7 +249,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/CHANNELS.pm b/lib/XXV/MODULES/CHANNELS.pm
index c7cbce1..d821ca6 100644
--- a/lib/XXV/MODULES/CHANNELS.pm
+++ b/lib/XXV/MODULES/CHANNELS.pm
@@ -156,7 +156,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/CHRONICLE.pm b/lib/XXV/MODULES/CHRONICLE.pm
index 29237f4..2b1b790 100644
--- a/lib/XXV/MODULES/CHRONICLE.pm
+++ b/lib/XXV/MODULES/CHRONICLE.pm
@@ -73,7 +73,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/CONFIG.pm b/lib/XXV/MODULES/CONFIG.pm
index 717cb52..bbe8751 100644
--- a/lib/XXV/MODULES/CONFIG.pm
+++ b/lib/XXV/MODULES/CONFIG.pm
@@ -83,7 +83,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the Configdata
diff --git a/lib/XXV/MODULES/EPG.pm b/lib/XXV/MODULES/EPG.pm
index c15ac20..35631e3 100644
--- a/lib/XXV/MODULES/EPG.pm
+++ b/lib/XXV/MODULES/EPG.pm
@@ -177,7 +177,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/EVENTS.pm b/lib/XXV/MODULES/EVENTS.pm
index 24c5539..f6b3937 100644
--- a/lib/XXV/MODULES/EVENTS.pm
+++ b/lib/XXV/MODULES/EVENTS.pm
@@ -81,7 +81,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/GRAB.pm b/lib/XXV/MODULES/GRAB.pm
index 3eb6120..996ac90 100644
--- a/lib/XXV/MODULES/GRAB.pm
+++ b/lib/XXV/MODULES/GRAB.pm
@@ -149,7 +149,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# create Template object
diff --git a/lib/XXV/MODULES/HTTPD.pm b/lib/XXV/MODULES/HTTPD.pm
index 589e6ac..2106d75 100644
--- a/lib/XXV/MODULES/HTTPD.pm
+++ b/lib/XXV/MODULES/HTTPD.pm
@@ -144,7 +144,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/INTERFACE.pm b/lib/XXV/MODULES/INTERFACE.pm
index db7c4ee..243ac15 100644
--- a/lib/XXV/MODULES/INTERFACE.pm
+++ b/lib/XXV/MODULES/INTERFACE.pm
@@ -70,7 +70,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/LOGREAD.pm b/lib/XXV/MODULES/LOGREAD.pm
index ae3118d..a211922 100644
--- a/lib/XXV/MODULES/LOGREAD.pm
+++ b/lib/XXV/MODULES/LOGREAD.pm
@@ -82,7 +82,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
return $self;
diff --git a/lib/XXV/MODULES/MEDIALIB.pm b/lib/XXV/MODULES/MEDIALIB.pm
index e38bb6f..76eb612 100644
--- a/lib/XXV/MODULES/MEDIALIB.pm
+++ b/lib/XXV/MODULES/MEDIALIB.pm
@@ -175,7 +175,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/MOVETIMER.pm b/lib/XXV/MODULES/MOVETIMER.pm
index 93d2b20..648359c 100644
--- a/lib/XXV/MODULES/MOVETIMER.pm
+++ b/lib/XXV/MODULES/MOVETIMER.pm
@@ -89,7 +89,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/MUSIC.pm b/lib/XXV/MODULES/MUSIC.pm
index afe6e61..d15e4d9 100644
--- a/lib/XXV/MODULES/MUSIC.pm
+++ b/lib/XXV/MODULES/MUSIC.pm
@@ -177,7 +177,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/RECORDS.pm b/lib/XXV/MODULES/RECORDS.pm
index 13505c7..51d6dea 100644
--- a/lib/XXV/MODULES/RECORDS.pm
+++ b/lib/XXV/MODULES/RECORDS.pm
@@ -249,7 +249,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load modul!: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
@@ -1452,12 +1455,15 @@ where
}
$obj->_loadreccmds;
+ my @reccmds = @{$obj->{reccmds}};
+ map {
+ $_ =~ s/\s*\:.*$//;
+ } @reccmds;
my $param = {
- reccmds => [@{$obj->{reccmds}}],
+ reccmds => \@reccmds,
};
-
- $console->table($erg, $param);
+ $console->table($erg,$param);
}
# ------------------
@@ -2645,19 +2651,22 @@ sub image {
my $obj = shift || return error('No object defined!');
my $watcher = shift || return error('No watcher defined!');
my $console = shift || return error('No console defined!');
- my $record = shift;
+ my $data = shift;
return $console->err(gettext("Sorry, get image is'nt supported"))
if ($console->{TYP} ne 'HTML');
return $console->status404('NULL','Wrong image parameter')
- unless($record);
+ unless($data);
- my @rec = split(/_/, $record);
+ my ($recordid, $frame)
+ = $data =~ /^([0-9a-f]{32}).(.*)$/si;
return $console->status404('NULL','Wrong image parameter')
- if(scalar @rec != 2 );
-
- return $console->datei(sprintf('%s/%s_shot/%08d.jpg', $obj->{previewimages}, $rec[0], int($rec[1])));
+ unless($recordid && $frame);
+ if(length($frame) < 8) {
+ $frame = sprintf("%08d",$frame);
+ }
+ return $console->datei(sprintf('%s/%s_shot/%s.jpg', $obj->{previewimages}, $recordid, $frame));
}
1;
diff --git a/lib/XXV/MODULES/REMOTE.pm b/lib/XXV/MODULES/REMOTE.pm
index a7fa6c8..e313672 100644
--- a/lib/XXV/MODULES/REMOTE.pm
+++ b/lib/XXV/MODULES/REMOTE.pm
@@ -92,7 +92,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->init or return error('Problem to initialize modul!');
diff --git a/lib/XXV/MODULES/REPORT.pm b/lib/XXV/MODULES/REPORT.pm
index 857ad00..eb6edcf 100644
--- a/lib/XXV/MODULES/REPORT.pm
+++ b/lib/XXV/MODULES/REPORT.pm
@@ -95,7 +95,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{LastReportTime} = time;
diff --git a/lib/XXV/MODULES/ROBOT.pm b/lib/XXV/MODULES/ROBOT.pm
index 6425074..6e88113 100644
--- a/lib/XXV/MODULES/ROBOT.pm
+++ b/lib/XXV/MODULES/ROBOT.pm
@@ -64,7 +64,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
return $self;
diff --git a/lib/XXV/MODULES/SHARE.pm b/lib/XXV/MODULES/SHARE.pm
index b2aae3e..3a78718 100644
--- a/lib/XXV/MODULES/SHARE.pm
+++ b/lib/XXV/MODULES/SHARE.pm
@@ -111,7 +111,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# The Initprocess
diff --git a/lib/XXV/MODULES/STATUS.pm b/lib/XXV/MODULES/STATUS.pm
index 78e4270..1b0dc60 100644
--- a/lib/XXV/MODULES/STATUS.pm
+++ b/lib/XXV/MODULES/STATUS.pm
@@ -144,7 +144,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# Interval to read timers and put to DB
diff --git a/lib/XXV/MODULES/STREAM.pm b/lib/XXV/MODULES/STREAM.pm
index b9933d8..9f96a3d 100644
--- a/lib/XXV/MODULES/STREAM.pm
+++ b/lib/XXV/MODULES/STREAM.pm
@@ -146,7 +146,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# The Initprocess
diff --git a/lib/XXV/MODULES/SVDRP.pm b/lib/XXV/MODULES/SVDRP.pm
index b7d245d..0a02831 100644
--- a/lib/XXV/MODULES/SVDRP.pm
+++ b/lib/XXV/MODULES/SVDRP.pm
@@ -83,7 +83,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/TELNET.pm b/lib/XXV/MODULES/TELNET.pm
index e53e9e5..1564bc5 100644
--- a/lib/XXV/MODULES/TELNET.pm
+++ b/lib/XXV/MODULES/TELNET.pm
@@ -107,7 +107,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/TIMERS.pm b/lib/XXV/MODULES/TIMERS.pm
index ef28a4d..f788af9 100644
--- a/lib/XXV/MODULES/TIMERS.pm
+++ b/lib/XXV/MODULES/TIMERS.pm
@@ -379,7 +379,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/USER.pm b/lib/XXV/MODULES/USER.pm
index c5f91bc..95cf1f3 100644
--- a/lib/XXV/MODULES/USER.pm
+++ b/lib/XXV/MODULES/USER.pm
@@ -168,7 +168,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/VTX.pm b/lib/XXV/MODULES/VTX.pm
index 0b0f59b..bc7ba39 100644
--- a/lib/XXV/MODULES/VTX.pm
+++ b/lib/XXV/MODULES/VTX.pm
@@ -89,7 +89,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
return $self;
diff --git a/lib/XXV/MODULES/WAPD.pm b/lib/XXV/MODULES/WAPD.pm
index d04a1bd..ff5dcc6 100644
--- a/lib/XXV/MODULES/WAPD.pm
+++ b/lib/XXV/MODULES/WAPD.pm
@@ -112,7 +112,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
diff --git a/lib/XXV/MODULES/XMLTV.pm b/lib/XXV/MODULES/XMLTV.pm
index 9bc5b6a..753ffcd 100644
--- a/lib/XXV/MODULES/XMLTV.pm
+++ b/lib/XXV/MODULES/XMLTV.pm
@@ -98,7 +98,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# read the DB Handle
@@ -118,7 +121,7 @@ sub new {
) || return error("Can't create Template instance!");
- $self->{xml} = XML::Simple->new( NumericEscape => $self->{charset} eq 'UTF-8' ? 0 : 1 )
+ $self->{xml} = XML::Simple->new( NumericEscape => ($self->{charset} eq 'UTF-8' ? 0 : 1) )
|| return error("Can't create XML instance!");
# The Initprocess
diff --git a/lib/XXV/OUTPUT/Ajax.pm b/lib/XXV/OUTPUT/Ajax.pm
index 1cc97e4..927e4f6 100644
--- a/lib/XXV/OUTPUT/Ajax.pm
+++ b/lib/XXV/OUTPUT/Ajax.pm
@@ -57,7 +57,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{handle} = $attr{'-handle'}
@@ -89,7 +92,7 @@ sub new {
$self->{json} = JSON->new()
|| return error("Can't create JSON instance!");
} elsif($self->{outtype} eq 'xml') {
- $self->{xml} = XML::Simple->new( NumericEscape => $self->{charset} eq 'UTF-8' ? 0 : 1 )
+ $self->{xml} = XML::Simple->new( NumericEscape => ($self->{charset} eq 'UTF-8' ? 0 : 1) )
|| return error("Can't create XML instance!");
} elsif($self->{outtype} eq 'text') {
# ...
diff --git a/lib/XXV/OUTPUT/Console.pm b/lib/XXV/OUTPUT/Console.pm
index ac1516d..9bed898 100644
--- a/lib/XXV/OUTPUT/Console.pm
+++ b/lib/XXV/OUTPUT/Console.pm
@@ -58,7 +58,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{handle} = $attr{'-handle'}
diff --git a/lib/XXV/OUTPUT/Dump.pm b/lib/XXV/OUTPUT/Dump.pm
index e7a9fe4..3c57b6e 100644
--- a/lib/XXV/OUTPUT/Dump.pm
+++ b/lib/XXV/OUTPUT/Dump.pm
@@ -45,7 +45,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{TYP} = 'INTERFACE';
diff --git a/lib/XXV/OUTPUT/Html.pm b/lib/XXV/OUTPUT/Html.pm
index 235fe06..5884fc1 100644
--- a/lib/XXV/OUTPUT/Html.pm
+++ b/lib/XXV/OUTPUT/Html.pm
@@ -24,7 +24,6 @@ sub module {
# 'Template' => 'Front-end module to the Template Toolkit',
# 'Compress::Zlib' => 'Interface to zlib compression library',
'HTML::TextToHTML' => 'convert plain text file to HTML. ',
- 'String::Escape qw(elide)' => 'Registry of string functions, including backslash escapes'
},
Description => gettext('This receives and sends HTML messages.'),
Version => (split(/ /, '$Revision$'))[1],
@@ -233,20 +232,30 @@ sub parseTemplateFile {
if(scalar @text > 1)
{
my @lines;
- foreach my $line (@text)
+ foreach my $z (@text)
{
- $line = elide( $line,$c );
+ if ( length( $z ) > $c ) {
+ $z = substr( $z, 0, ( $c - 3 ) );
+ $z =~ s/([\x80-\xFF \.])+$//g; # remove part of unicode at last character
+ $z .= '...';
+ }
--$l;
last if($l < 0);
- push(@lines,$line);
+ push(@lines,$z);
}
$s = join("\r\n",@lines);
} else {
- $s = elide( $s,($c * $l) );
+ if ( length( $s ) > ($c * $l) ) {
+ $s = substr( $s, 0, ( ($c * $l) - 3 ) );
+ $s =~ s/([\x80-\xFF \.])+$//g; # remove part of unicode at last character
+ $s .= '...';
+ }
}
}
- else {
- $s = elide($s,$c);
+ elsif ( length( $s ) > $c ) {
+ $s = substr( $s, 0, ( $c - 3 ) );
+ $s =~ s/([\x80-\xFF \.])+$//g; # remove part of unicode at last character
+ $s .= '...';
}
return entities($s);
} else {
@@ -260,9 +269,14 @@ sub parseTemplateFile {
# translate string, usage : gettext(foo,truncate) or gettext(foo)
# value for truncate are optional
gettext => sub{
- my $t = gettext($_[0]);
- $t = elide( $t, $_[1] ) if(defined $_[1]);
- return entities($t);
+ my $s = gettext($_[0]);
+ if(defined $_[1] && length($s)>$_[1]) {
+ my $y;
+ $s = substr($s,0,$_[1]);
+ $s =~ s/([\x80-\xFF \.])+$//g; # remove part of unicode at last character
+ $s .= '...';
+ }
+ return entities($s);
},
version => sub{ return main::getVersion },
loadfile => sub{ return load_file(@_) },
diff --git a/lib/XXV/OUTPUT/NEWS/JABBER.pm b/lib/XXV/OUTPUT/NEWS/JABBER.pm
index 3175397..481dd8d 100644
--- a/lib/XXV/OUTPUT/NEWS/JABBER.pm
+++ b/lib/XXV/OUTPUT/NEWS/JABBER.pm
@@ -168,7 +168,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{TYP} = 'text/plain';
diff --git a/lib/XXV/OUTPUT/NEWS/MAIL.pm b/lib/XXV/OUTPUT/NEWS/MAIL.pm
index 7283af8..66d9a5c 100644
--- a/lib/XXV/OUTPUT/NEWS/MAIL.pm
+++ b/lib/XXV/OUTPUT/NEWS/MAIL.pm
@@ -156,7 +156,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
# create Template object
diff --git a/lib/XXV/OUTPUT/NEWS/RSS.pm b/lib/XXV/OUTPUT/NEWS/RSS.pm
index d4b56f8..376a438 100644
--- a/lib/XXV/OUTPUT/NEWS/RSS.pm
+++ b/lib/XXV/OUTPUT/NEWS/RSS.pm
@@ -102,7 +102,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{TYP} = 'application/xhtml+xml';
diff --git a/lib/XXV/OUTPUT/NEWS/VDR.pm b/lib/XXV/OUTPUT/NEWS/VDR.pm
index 4761f12..9f90c01 100644
--- a/lib/XXV/OUTPUT/NEWS/VDR.pm
+++ b/lib/XXV/OUTPUT/NEWS/VDR.pm
@@ -99,7 +99,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{TYP} = 'text/plain';
diff --git a/lib/XXV/OUTPUT/Wml.pm b/lib/XXV/OUTPUT/Wml.pm
index a64b42a..196cee9 100644
--- a/lib/XXV/OUTPUT/Wml.pm
+++ b/lib/XXV/OUTPUT/Wml.pm
@@ -57,7 +57,10 @@ sub new {
# Try to use the Requirments
map {
eval "use $_";
- return panic("\nCouldn't load perl module: $_\nPlease install this module on your system:\nperl -MCPAN -e 'install $_'") if($@);
+ if($@) {
+ my $m = (split(/ /, $_))[0];
+ return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
+ }
} keys %{$self->{MOD}->{Prereq}};
$self->{handle} = $attr{'-handle'}
@@ -152,7 +155,7 @@ sub parseTemplate {
return entities($t);
},
version => sub{ return main::getVersion },
- loadfile => sub{ return load_file(@_) },
+ loadfile => sub{ return load_file(@_, 'binary') },
writefile => sub{
my $filename = shift || return error('No Filename to write');
my $data = shift || return error('Nothing data to write');
@@ -162,7 +165,7 @@ sub parseTemplate {
# absolut Path to file
my $file = sprintf('%s/%s', $dir, $filename);
# absolut Path to file
- if(save_file($file, $data)) {
+ if(save_file($file, $data, 'binary')) {
# return the relative Path
my ($relpath) = $file =~ '/(.+?/.+?)$';
return sprintf('tempimages/%s', $filename);
@@ -346,7 +349,7 @@ sub image {
my $typ = shift || $self->{mime}->{lc((split('\.', $file))[-1])}
or return error("No Type in Mimehash or File: $file");
- my $data = load_file($file)
+ my $data = load_file($file, 'binary')
or return $self->status404($file,$!);
$self->out($data, $typ);