sistema - ¿Cómo cuento los caracteres, palabras y líneas en un archivo, usando Perl?

perl linea de comandos

Question

¿Cuál es una buena / mejor manera de contar la cantidad de caracteres, palabras y líneas de un archivo de texto usando Perl (sin usar wc)?

Answer 1

Aquí está el código perl. Contar palabras puede ser algo subjetivo, pero solo digo que es cualquier cadena de caracteres que no sea un espacio en blanco.

open(FILE, "<file.txt") or die "Could not open file: $!";

my ($lines, $words, $chars) = (0,0,0);

while (<FILE>) {
    $lines++;
    $chars += length($_);
    $words += scalar(split(//s+/, $_));
}

print("lines=$lines words=$words chars=$chars/n");

Answer 2

La herramienta Conteo de palabras cuenta caracteres, palabras y líneas en archivos de texto

Answer 3

Leer el archivo en fragmentos de tamaño fijo puede ser más eficiente que leer línea por línea. El binario wc hace esto.

#!/usr/bin/env perl

use constant BLOCK_SIZE => 16384;

for my $file (@ARGV) {
    open my $fh, ''<'', $file or do {
        warn "couldn''t open $file: $!/n";
        continue;
    };

    my ($chars, $words, $lines) = (0, 0, 0);

    my ($new_word, $new_line);
    while ((my $size = sysread $fh, local $_, BLOCK_SIZE) > 0) {
        $chars += $size;
        $words += //s+/g;
        $words-- if $new_word && //A/s/;
        $lines += () = //n/g;

        $new_word = //s/Z/;
        $new_line = //n/Z/;
    }
    $lines-- if $new_line;

    print "/t$lines/t$words/t$chars/t$file/n";
}

Answer 4

Para poder contar CHARS y no bytes, considere esto:
(Pruébalo con letras chinas o cirílicas y el archivo guardado en utf8)

use utf8;

my $file=''file.txt'';
my $LAYER = '':encoding(UTF-8)'';
open( my $fh, ''<'', $file )
  || die( "$file couldn''t be opened: $!" );
binmode( $fh, $LAYER );
read $fh, my $txt, -s $file;
close $fh;

print length $txt,$/;
use bytes;
print length $txt,$/;

Answer 5

Respuesta no seria:

system("wc foo");

Answer 6

Una variación en la respuesta de bmdhacks que probablemente produzca mejores resultados es usar / s + (o incluso mejor / W +) como delimitador. Considere la cadena "The quick brown fox" (espacios adicionales si no es obvio). Usar un delimitador de un solo carácter en blanco dará un recuento de palabras de seis, no cuatro. Por lo tanto, intente:

open(FILE, "<file.txt") or die "Could not open file: $!";

my ($lines, $words, $chars) = (0,0,0);

while (<FILE>) {
    $lines++;
    $chars += length($_);
    $words += scalar(split(//W+/, $_));
}

print("lines=$lines words=$words chars=$chars/n");

Usar / W + como delimitador evitará que la puntuación (entre otras cosas) se cuente como palabras.

Answer 7

Aquí. Pruebe esta versión del programa de wc con una comprensión Unicode.

• Se salta argumentos que no son de archivo (tuberías, directorios, enchufes, etc.).

• Asume el texto UTF-8.

• Cuenta cualquier espacio en blanco Unicode como separador de palabras.

• También acepta codificaciones alternativas si hay un .ENCODING al final del nombre de archivo, como foo.cp1252 , foo.latin1 , foo.utf16 , etc.

• También funciona con archivos que se han comprimido en una variedad de formatos.

• Da recuentos de Párrafos, Líneas, Palabras, Grafemas, Caracteres y Bytes.

• Comprende todas las secuencias de salto de línea de Unicode.

• Advierte sobre archivos de texto corruptos con errores linebreak.

Aquí hay un ejemplo de ejecutarlo:

   Paras    Lines    Words   Graphs    Chars    Bytes File
       2     2270    82249   504169   504333   528663 /tmp/ap
       1     2404    11163    63164    63164    66336 /tmp/b3
    uwc: missing linebreak at end of corrupted textfiile /tmp/bad
      1*       2*        4       19       19       19 /tmp/bad
       1       14       52      273      273      293 /tmp/es
      57      383     1369    11997    11997    12001 /tmp/funny
       1   657068  3175429 31205970 31209138 32633834 /tmp/lw
       1        1        4       27       27       27 /tmp/nf.cp1252
       1        1        4       27       27       34 /tmp/nf.euc-jp
       1        1        4       27       27       27 /tmp/nf.latin1
       1        1        4       27       27       27 /tmp/nf.macroman
       1        1        4       27       27       54 /tmp/nf.ucs2
       1        1        4       27       27       56 /tmp/nf.utf16
       1        1        4       27       27       54 /tmp/nf.utf16be
       1        1        4       27       27       54 /tmp/nf.utf16le
       1        1        4       27       27      112 /tmp/nf.utf32
       1        1        4       27       27      108 /tmp/nf.utf32be
       1        1        4       27       27      108 /tmp/nf.utf32le
       1        1        4       27       27       39 /tmp/nf.utf7
       1        1        4       27       27       31 /tmp/nf.utf8
       1    26906   101528   635841   636026   661202 /tmp/o2
     131      346     1370     9590     9590     4486 /tmp/perl5122delta.pod.gz
     291      814     3941    25318    25318     9878 /tmp/perl51310delta.pod.bz2
       1     2551     5345   132655   132655   133178 /tmp/tailsort-pl.utf8
       1       89      334     1784     1784     2094 /tmp/til
       1        4       18       88       88      106 /tmp/w
     276     1736     5773    53782    53782    53804 /tmp/www

Aqui tienes:

#!/usr/bin/env perl 
#########################################################################
# uniwc - improved version of wc that works correctly with Unicode
#
# Tom Christiansen <[email protected]>
# Mon Feb 28 15:59:01 MST 2011
#########################################################################

use 5.10.0;

use strict;
use warnings FATAL => "all";
use sigtrap qw[ die untrapped normal-signals ];

use Carp;

$SIG{__WARN__}  = sub {
    confess("FATALIZED WARNING: @_")  unless $^S;
};

$SIG{__DIE__}  = sub {
    confess("UNCAUGHT EXCEPTION: @_")  unless $^S;
};

$| = 1;

my $Errors = 0;
my $Headers = 0;

sub yuck($) {
    my $errmsg = $_[0];
    $errmsg =~ s/(?<=[^/n])/z//n/;
    print STDERR "$0: $errmsg";
}

process_input(/&countem);

sub countem { 
    my ($_, $file) = @_;

    my (
        @paras, @lines, @words,
        $paracount, $linecount, $wordcount, 
        $grafcount, $charcount, $bytecount,
    );

    if ($charcount = length($_)) {
        $wordcount = eval { @words = split m{ /p{Space}+  }x }; 
        yuck "error splitting words: $@" if $@;

        $linecount = eval { @lines = split m{ /R     }x }; 
        yuck "error splitting lines: $@" if $@;

        $grafcount = 0;
        $grafcount++ while //X/g;
        #$grafcount = eval { @lines = split m{ /R     }x }; 
        yuck "error splitting lines: $@" if $@;

        $paracount = eval { @paras = split m{ /R{2,} }x }; 
        yuck "error splitting paras: $@" if $@;

        if ($linecount && !//R/z/) {
            yuck("missing linebreak at end of corrupted textfiile $file");
            $linecount .= "*";
            $paracount .= "*";
        } 
    }

    $bytecount = tell;
    if (-e $file) {
        $bytecount = -s $file;
        if ($bytecount != -s $file) {
            yuck "filesize of $file differs from bytecount/n";
            $Errors++;
        }
    } 
    my $mask = "%8s " x 6 . "%s/n";
    printf  $mask => qw{ Paras Lines Words Graphs Chars Bytes File } unless $Headers++;

    printf $mask => map( { show_undef($_) } 
                                $paracount, $linecount, 
                                $wordcount, $grafcount, 
                                $charcount, $bytecount,
                       ), $file;
} 

sub show_undef {
    my $value = shift;
    return defined($value)
             ? $value
             : "undef";
} 

END { 
    close(STDOUT) || die "$0: can''t close STDOUT: $!";
    exit($Errors != 0);
}

sub process_input {

    my $function = shift();

    my $enc;

    if (@ARGV == 0 && -t) {
        warn "$0: reading from stdin, type ^D to end or ^C to kill./n";
    }

    unshift(@ARGV, "-") if @ARGV == 0;

FILE:

    for my $file (@ARGV) {
        # don''t let magic open make an output handle

        next if -e $file && ! -f _;

        my $quasi_filename = fix_extension($file);

        $file = "standard input" if $file eq q(-);
        $quasi_filename =~ s/^(?=/s*[>|])/< /;

        no strict "refs";
        my $fh = $file;   # is *so* a lexical filehandle! ☺
        unless (open($fh, $quasi_filename)) {
            yuck("couldn''t open $quasi_filename: $!");
            next FILE;
        }
        set_encoding($fh, $file) || next FILE;

        my $whole_file = eval {
            use warnings "FATAL" => "all";
            local $/;
            scalar <$fh>;
        };

        if ($@) {
            $@ =~ s/ at /K.*? line /d+.*/$file line $./;
            yuck($@);
            next FILE;
        }

        $function->($whole_file, $file);

        unless (close $fh) {
            yuck("couldn''t close $quasi_filename at line $.: $!");
            next FILE;
        }

    } # foreach file

}

sub set_encoding(*$) {
    my ($handle, $path) = @_;

    my $enc_name = "utf8";

    if ($path && $path =~ m{ /. ([^/s.]+) /z }x) {
        my $ext = $1;
        die unless defined $ext;
        require Encode;
        if (my $enc_obj = Encode::find_encoding($ext)) {
            my $name = $enc_obj->name || $ext;
            $enc_name = "encoding($name)";
        }
    }

    return 1 if eval {
        use warnings FATAL => "all";
        no strict "refs";
        binmode($handle, ":$enc_name");
        1;
    };

    for ($@) {
        s/ at .* line /d+/.//;
        s/$/ for $path/;
    }

    yuck("set_encoding: $@");

    return undef;
}

sub fix_extension {
    my $path = shift();
    my %Compress = (
        Z       =>  "zcat",
        z       => "gzcat",            # for uncompressing
        gz      => "gzcat",
        bz      => "bzcat",
        bz2     => "bzcat",
        bzip    => "bzcat",
        bzip2   => "bzcat",
        lzma    => "lzcat",
    );

    if ($path =~ m{ /. ( [^./s] +) /z }x) {
        if (my $prog = $Compress{$1}) {
            return "$prog $path |";
        } 
    } 

    return $path;

}

Answer 8

Esto puede ser útil para los principiantes de Perl. Traté de simular funcionalidades de conteo de MS y agregué una característica más que no se muestra usando wc en Linux.

• número de líneas
• número de palabras
• número de personajes con espacio
• número de caracteres sin espacio (wc no dará esto en su salida pero las palabras de Microsoft lo muestran).

Aquí está la url: contar palabras, caracteres y líneas en un archivo

Answer 9

Existe el proyecto Perl Power Tools cuyo objetivo es reconstruir todas las utilidades de bin Unix, principalmente para aquellos en sistemas operativos privados de Unix. Sí, lo hicieron wc . La implementación es excesiva, pero cumple con POSIX .

Se pone un poco ridículo cuando observas la implementación verdadera de GNU.

Answer 10

Me encontré con esto mientras buscaba una solución de recuento de caracteres en Google. Es cierto que no sé casi nada sobre perl, por lo que parte de esto puede estar fuera de lugar, pero aquí están mis ajustes de la solución de newt.

En primer lugar, hay una variable de recuento de líneas incorporada de todos modos, así que acabo de usar eso. Esto es probablemente un poco más eficiente, supongo. Tal como están las cosas, el recuento de caracteres incluye caracteres de nueva línea, que probablemente no es lo que quieres, así que decidí $ _. Perl también se quejó de la forma en que se realiza la división () (división implícita, véase: ¿Por qué Perl se queja de que "el uso de división implícita en @_ está en desuso"? ) Así que lo modifiqué. Mis archivos de entrada son UTF-8, así que los abrí como tal. Eso probablemente ayude a obtener el recuento de caracteres correcto en el archivo de entrada que contiene caracteres que no son ASCII.

Aquí está el código:

open(FILE, "<:encoding(UTF-8)", "file.txt") or die "Could not open file: $!";

my ($lines, $words, $chars) = (0,0,0);
my @wordcounter;
while (<FILE>) {
    chomp($_);
    $chars += length($_);
    @wordcounter = split(//W+/, $_);
    $words += @wordcounter;
}
$lines = $.;
close FILE;
print "/nlines=$lines, words=$words, chars=$chars/n";