Как подсчитать символы, слова и строки в файле, используя Perl? - PullRequest
Новая
       22

Как подсчитать символы, слова и строки в файле, используя Perl?

15 голосов
/ 23 апреля 2009

Каков хороший / лучший способ подсчета количества символов, слов и строк текстового файла с использованием Perl (без использования wc)?

Ответы [ 10 ]

22 голосов
/ 23 апреля 2009

Вот код Perl. Подсчет слов может быть несколько субъективным, но я просто говорю, что любая строка символов не является пробелом. 

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");
7 голосов
/ 23 апреля 2009

Вариант ответа bmdhacks, который, вероятно, даст лучшие результаты, заключается в использовании \ s + (или даже лучше \ W +) в качестве разделителя. Рассмотрим строку «Быстрая коричневая лиса» (дополнительные пробелы, если это не очевидно). Использование разделителя из одного символа пробела даст количество слов шесть, а не четыре. Итак, попробуйте: 

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");

Использование \ W + в качестве разделителя предотвратит пунктуацию (среди прочего) в качестве слов.

4 голосов
/ 23 апреля 2009

Инструмент Подсчет слов считает символы, слова и строки в текстовых файлах

3 голосов
/ 01 марта 2011

Здесь. Попробуйте эту Uncode-версию программы wc.

  • Пропускает не файловые аргументы (каналы, каталоги, сокеты и т. Д.).

  • Предполагается текст UTF-8.

  • Считает любые пробелы Юникода как разделитель слов.

  • Он также принимает альтернативные кодировки, если в конце имени файла есть .ENCODING, например foo.cp1252, foo.latin1, foo.utf16 и т. Д.

  • Он также работает с файлами, которые были сжаты в различных форматах.

  • Он дает число Абзацы, строки, слова, графемы, символы и Байт.

  • Он понимает все последовательности перевода строки Unicode.

  • Предупреждает о поврежденных текстовых файлах с ошибками перевода строки.

Вот пример запуска: 

   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

Вот, пожалуйста, 

#!/usr/bin/env perl 
#########################################################################
# uniwc - improved version of wc that works correctly with Unicode
#
# Tom Christiansen <tchrist@perl.com>
# 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;

}

2 голосов
/ 29 августа 2010

Я наткнулся на это, пока гуглил решение для подсчета символов. Следует признать, что я почти ничего не знаю о Perl, поэтому некоторые из них могут быть неосновными, но вот мои настройки решения Тритона.

Во-первых, в любом случае есть встроенная переменная подсчета строк, так что я просто использовал это. Наверное, это немного более эффективно. На самом деле, количество символов включает символы новой строки, что, вероятно, не то, что вы хотите, поэтому я выбрал $ _. Perl также жаловался на то, как выполняется split () (неявное split, см .: Почему Perl жалуется на "Использование неявного split для @_ устарело"? ), поэтому я настроил это. Мои входные файлы - UTF-8, поэтому я открыл их как таковые. Это, вероятно, помогает получить правильное количество символов во входном файле, содержащем не-ASCII символы.

Вот код: 

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";
2 голосов
/ 24 апреля 2009

Существует проект Perl Power Tools , целью которого является реконструкция всех утилит Unix bin, в первую очередь для тех, которые работают в операционных системах, лишенных Unix. Да, они сделали туалет . Реализация излишняя, но она POSIX-совместимая .

Это немного смешно, когда вы смотрите на совместимую с GNU реализацию true .

1 голос
/ 24 апреля 2009

Чтобы иметь возможность считать CHARS, а не байты, учтите следующее:
(Попробуйте китайскими или кириллическими буквами и сохраните файл в 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,$/;
1 голос
/ 23 апреля 2009

Чтение файла фрагментами фиксированного размера может быть более эффективным, чем построчное чтение. Бинарный файл wc делает это. 

#!/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";
}
1 голос
/ 23 апреля 2009

Несерьезный ответ: 

system("wc foo");
0 голосов
/ 18 февраля 2014

Это может быть полезно для начинающих Perl. Я попытался смоделировать функции подсчета MS-слов и добавил еще одну функцию, которая не показана при использовании wc в Linux.

  • количество строк
  • количество слов
  • количество символов с пробелом
  • количество символов без пробела (wc не выдаст это в выводе, но слова Microsoft показывают это.)

Вот URL: Подсчет слов, символов и строк в файле

...