Programemos Cosas

use strict; use feature "switch"; open my $outfh, '>:encoding(utf8)', 'user-list.txt'; my %NOT_COLLECTED; my @UNCLASSIFIED_FILE; sub print_not_collected {   print $outfh "-----------------------------------------\n";   for (keys %NOT_COLLECTED) {     print $outfh $_ . ' ' . join(' ', keys %{+{map +($_ => undef), @{$NOT_COLLECTED{$_}}}}) . "\n";   }   print $outfh "-----------------------------------------\n";   print $outfh join "\n", @UNCLASSIFIED_FILE;   close($outfh);   exit(0); } use sigtrap 'handler' => \&print_not_collected, qw(INT QUIT); my @tmp_PIV; while(<user-pivot-*.txt>) {   my ($class) = /\d+/g;   open my $ph, "<:encoding(utf8)", $_;   push @tmp_PIV, \%{+{map {/(.*)/; $1=>$class} grep /.+/, <$ph>}}; } my %DUP; for my $i (0..$#tmp_PIV-1) {   for my $j ($i+1..$#tmp_PIV) {     for (keys %{$tmp_PIV[$i]}) {       $DUP{$_}{$tmp_PIV[$i]{$_}} ...

Tokens: Programme to discover tokens, where there are not. Now available at  https://puszcza.gnu.org.ua/projects/tokens/ This is Version 2, for  version 1, go here . Synopsis: use TokensV2; sub printFile; my @FORMAT = ( ['<Message Date=".*?" Time=".*?" DateTime=".*?" SessionID=".*?"><From>(?:<User FriendlyName=".*?"/>)+</From><To>(?:<User FriendlyName=".*?"/>)+</To><Text(?: Style=".*?")?>.*?</Text></Message>',   sub {     my $fh = $_[1];     my ($d, $t, $f, $s, $T) = $_[0] =~ m|<Message Date="(.*?)" Time="(.*?)" DateTime=".*?" SessionID=".*?">(<From>(?:<User FriendlyName=".*?"/>)+</From>)<To>(?:<User FriendlyName=".*?"/>)+</To><Text(?: Style="(.*?)")?>(.*?)</Text></Message>|;     my $F = join '<br />', ...

# Lee un archivo mixto UTF-8 - no UTF-8 # output: # Repeticiones de las líneas de texto: # "bin: " byte-inicial-secuencia-no-UTF-8 byte-final-secuencia-no-UTF-8 # "txt: " byte-inicial-secuencia-UTF-8 byte-final-secuencia-UTF-8 # por orden de aparición de las secuencias (orden normal de los bytes dentro del archivo) open my $fh, "<:raw", @ARGV[0] or die "cannot open < @ARGV[0]: $!"; my $i = 0; my $ini_ciclo_bin = 1; my $length = read $fh, my $byte, 1; $i += $length; # print "a ".unpack("B*", $byte) . "\n"; my $ini_bin; my $fin_bin; my $ini_txt; my $fin_txt; while($length) { # ciclo bin while($length and not unpack("B*", $byte) =~ /^(0|110|1110|11110|111110|1111110).*/) { $length = read $fh, $byte, 1; $i += $length; # print "b ".unpack("B*", $byte) . "\n"; } # ciclo txt # inicialización secuencia txt $ini_txt = $i; $fin_txt = 0; ...

Interpretación provisoria. No está basada en la teoría, sino en el caso empírico dado. perl -w o bien use strict deberían quejarse de la mayoría de estos casos. Código: @ARY = ( [ qw(vilma palma vampiro) ], [ qw(zapallo zanahoria zapallito) ] ); print "@ARY\n";   # 1) Testigo print ARY[1];   # 2) La expresión de derreferenciamiento requiere un caracter de tipo bien al principio. El subscript [] no es suficiente para que Perl sepa que nos estamos refiriendo al array ARY. print "\n"; print "@{ARY[1]}\n";   # 3) Adentro de {}: no rige la regla del caso (2). Afuera de {}: derreferenciamento impropio de un escalar con @. print "@ARY[1]\n"; # 4) El caracter de tipo tiene mayor precedencia que el subscript de matrices [] (perldsc sobre Perl 5.12.5, "Caveat on precedence"), excepto que la regla (2) tiene mayor prioridad. Mismo mecanismo que el caso (3). print "@{@ARY[1]}\n"; # 5) Adentro de {}: Si hay un @ bien al principio...

Sinopsis use Tokens; open my $regex_fh, '&lt;', $ARGV[0]; #regex.txt open my $target_fh, '&lt;', $ARGV[1]; #file.txt my $target; {   local $/ = undef;   $target = &lt;$target_fh&gt;; #the content   $target =~ s/\n/ /g; } my $regex; {   local $/ = undef;   $regex = &lt;$regex_fh&gt;; #the content } printAll parse $target, $regex;   Códio (archivo: Tokens.pm): =pod  Copyright 2013 Gabriel Czernikier     This program is free software: you can redistribute it and/or modify     it under the terms of the GNU General Public License as published by     the Free Software Foundation, either version 3 of the License, or     (at your option) any later version.     This program is distributed in the hope that it will be useful,     but WITHOUT ANY WARRANTY; without even the implied warranty of     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  Se...

Adaptaciones sobre el módulo LDAP Server para Windows (Strawberry Perl) Lista de adaptaciones (continúa más abajo): - Relajación de condiciones de bind:     - Cuenta principal (principal account)     - Validación de contraseñas Ubicación del archivo: %Strawberry_Perl%\site\lib\net\ldap\SimpleServer\ProtocolHandler.pm CPAN: http://search.cpan.org/~russoz/Net-LDAP-SimpleServer-0.0.17/lib/Net/LDAP/SimpleServer.pm Código: package Net::LDAP::SimpleServer::ProtocolHandler; use strict; use warnings; # ABSTRACT: LDAP protocol handler used with Net::LDAP::SimpleServer our $VERSION = '0.0.17';    # VERSION use Net::LDAP::Server; use base 'Net::LDAP::Server'; use fields qw(store root_dn root_pw allow_anon); use Carp; use Net::LDAP::LDIF; use Net::LDAP::Util qw{canonical_dn}; use Net::LDAP::FilterMatch; use Net::LDAP::Constant (     qw/LDAP_SUCCESS LDAP_AUTH_UNKNOWN LDAP_INVALID_CREDENTIALS/,   ...