Schrift
Wiki:Tipp zum Debugging: use Data::Dumper; local $Data::Dumper::Useqq = 1; print Dumper \@var;
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]9934[/thread]

string nach jeder 4000 Stelle ein TAB einsetzten



<< |< 1 2 3 >| >> 30 Einträge, 3 Seiten
Strat
 2007-08-02 14:32
#97262 #97262
User since
2003-08-04
5246 Artikel
ModeratorIn
[Homepage] [default_avatar]
vielleicht hilft auch CPAN:Text::Wrapper
perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/
mr-sansibar
 2007-08-02 13:42
#97265 #97265
User since
2006-04-13
90 Artikel
BenutzerIn
[default_avatar]
ein riesen string (18.000 Zeichen) an jeder 4000 stelle ein Tabulator (/t) einfügen.
wenn string kleiner ist als 4000 dann einfach 5 Tabulatoren anhängen .
ich versuche es mit unpack zu machen ein beispiel !

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

if($logFile =~ /^dn/ ) {
$laenge = length($tmp_line);                                    
if($laenge <=4000) {
print $frontend "$tmp_line\t\t\t\t\n";
}
elsif($laenge <= 8000) {
my ($a, $b) = unpack("A4000 A4000", $tmp_line);
print $frontend "$a\t$b\t\t\t\n";
}
elsif($laenge <= 12000) {
my ($a, $b, $c) = unpack("A4000 A4000 A4000", $tmp_line);
print $frontend "$a\t$b\t$c\t\t\n";

}
elsif($laenge <= 16000) {
my ($a, $b, $c, $d) = unpack("A4000 A4000 A4000 A4000", $tmp_line);
print $frontend "$a\t$b\t$c\t$d\t\n";

}
                                        }


Vielen Dank
renee
 2007-08-02 13:48
#97269 #97269
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Code (perl): (dl )
1
2
3
4
5
6

if( length $tmp_line < 4000 ){
    $tmp_line .= "\t" x 5;
}
else{
    $tmp_line =~ s/(.{4000})/$1\t/g;
}
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
bloonix
 2007-08-02 14:19
#97281 #97281
User since
2005-12-17
1615 Artikel
HausmeisterIn
[Homepage]
user image
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11

my $len = length($tmp_line);
my $pos = 0;
my $tab = 5;
while ( my $s = unpack("x$pos A4000", $tmp_line) ) { 
    $tab--;
    print $frontend "$s\t";
    $pos += 4000;
    last if $pos >= $len;
}   
print $frontend "\t" x $tab;
print $frontend "\n";
What is a good module? That's hard to say.
What is good code? That's also hard to say.
One man's Thing of Beauty is another's man's Evil Hack.
mr-sansibar
 2007-08-02 16:28
#97319 #97319
User since
2006-04-13
90 Artikel
BenutzerIn
[default_avatar]
vielen dank für die guten lösungen.
wenn ich mir meine lösung anschauen ist es von der bearbeitung sehr ineffizient.

jetzt geht es um die frage ob die lösung von @renee oder @opi schneller ist ???
bloonix
 2007-08-02 16:30
#97320 #97320
User since
2005-12-17
1615 Artikel
HausmeisterIn
[Homepage]
user image
ich habe einen benchmark ausgeführt und deine Lösung ist
die effizienteste von allen!
What is a good module? That's hard to say.
What is good code? That's also hard to say.
One man's Thing of Beauty is another's man's Evil Hack.
bloonix
 2007-08-02 16:37
#97322 #97322
User since
2005-12-17
1615 Artikel
HausmeisterIn
[Homepage]
user image
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

use strict;
use warnings;
use Benchmark;

my $tmp_line = 'x' x 18_000;

open my $frontend, '>>', '/dev/null' or die $!; 

Benchmark::cmpthese(-1, {
   _regex   => \&_regex,
   _unpack1 => \&_unpack1,
   _unpack2 => \&_unpack2
});

sub _regex {
    if( length $tmp_line < 4000 ){
        $tmp_line .= "\t" x 5;
    }   
    else{
        $tmp_line =~ s/(.{4000})/$1\t/g;
    }   
    print $frontend $tmp_line;
}

sub _unpack1 {
    my $laenge = length($tmp_line); 
    if($laenge <=4000) {
        print $frontend "$tmp_line\t\t\t\t\n";
    }   
    elsif($laenge <= 8000) {
        my ($a, $b) = unpack("A4000 A4000", $tmp_line);
        print $frontend "$a\t$b\t\t\t\n";
    }   
    elsif($laenge <= 12000) {
        my ($a, $b, $c) = unpack("A4000 A4000 A4000", $tmp_line);
        print $frontend "$a\t$b\t$c\t\t\n";
    }   
    elsif($laenge <= 16000) {
        my ($a, $b, $c, $d) = unpack("A4000 A4000 A4000 A4000", $tmp_line);
        print $frontend "$a\t$b\t$c\t$d\t\n";
    }   
}

sub _unpack2 {
    my $len = length($tmp_line);
    my $pos = 0;
    my $tab = 5;
    while ( my $s = unpack("x$pos A4000", $tmp_line) ) { 
        $tab--;
        print $frontend "$s\t";
        $pos += 4000;
        last if $pos >= $len;
    }   
    print $frontend "\t" x $tab;
    print $frontend "\n";
}


Ausgabe:

Code: (dl )
1
2
3
4
              Rate   _regex _unpack2 _unpack1
_regex      1172/s       --     -98%    -100%
_unpack2   48188/s    4012%       --     -97%
_unpack1 1557667/s  132813%    3133%       --
What is a good module? That's hard to say.
What is good code? That's also hard to say.
One man's Thing of Beauty is another's man's Evil Hack.
mr-sansibar
 2007-08-02 16:45
#97324 #97324
User since
2006-04-13
90 Artikel
BenutzerIn
[default_avatar]
das skript gefällt mir.
aber habe leider schwierigkeiten die ausgabe zu intepretieren.
meine ausgabe

Rate _regex _unpack2 _unpack1
_regex 1840/s -- -92% -100%
_unpack2 23659/s 1186% -- -99%
_unpack1 2044729/s 111046% 8542% --
bloonix
 2007-08-02 17:00
#97326 #97326
User since
2005-12-17
1615 Artikel
HausmeisterIn
[Homepage]
user image
Code: (dl )
1
2
3
4
              Rate   _regex _unpack2 _unpack1
_regex      1840/s       --     -92%    -100%
_unpack2   23659/s    1186%       --     -99%
_unpack1 2044729/s  111046%    8542%       --


Rate sagt aus, wie oft die Subfunktionen im Durchschnitt pro Sekunde
ausgeführt "werden können".

-1 sagt aus, dass die Subfunktionen 1 CPU-Sekunden ausgeführt werden.
Du kannst auch einen positiven Wert angeben.

Code: (dl )
Benchmark::cmpthese(100_000_000 ...


würde zum Beispiel heißen, dass die Subfunktionen 100.000.000 Mal
hintereinander ausgeführt werden. Die Zeiten werden dann miteinander
verglichen etc und Benchmark liefert einen kleinen Report.

_regex wird ca. 1.840 Mal pro Sekunde ausgeführt.
_unpack2 ca. 23.659
_unpack1 ca 2.044.729

Du siehst, das du spitzenreiter bist, was die Schnelligkeit angeht ;)
What is a good module? That's hard to say.
What is good code? That's also hard to say.
One man's Thing of Beauty is another's man's Evil Hack.
PerlProfi
 2007-08-02 17:00
#97327 #97327
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
An der Ausgabe kannst du erkennen, dass deine Lösung mit 2044729 Ausführungen pro Sekunde die schnellste ist.
Im Vegleich zur regex Lösung ist sie 111046% schneller und im Vergleich zur 2. unpack Lösung 8542%.

MfG

edit: opi war 7 Sekunden schneller ;)
<< |< 1 2 3 >| >> 30 Einträge, 3 Seiten



View all threads created 2007-08-02 13:42.