[Dresden-pm] Perl Mongers erhebet euch

[A. Pagaltzis]

* Sven Klemm <sven at elektro-klemm.de> [2006-01-19 10:45]:
>#!/usr/bin/env ruby
>
>raise ArgumentError, "Usage: #{$0} <file>" unless ARGV.length >= 1
>email = []
>File.new(ARGV[0]).read.scan(/([\w_.+-]+)@([\w.+_-]+\.)+(\w{2,3}|\d{1,3})/) do | user , server, tld |
>  email.push({:user=>user,:server=>server,:tld=>tld})
>end
>
>puts "Please set the sort order 1 = user, 2 = server, 3 = top level domain:\n"
>order = case STDIN.gets.strip
>  when '2' then [:server,:tld,:user] 
>  when '3' then [:tld,:server,:user]
>  else [:user,:server,:tld]
>end
>
>email.sort! do | a, b | 
>  d = 0
>  order.each do | o |
>    d = a[o].downcase <=> b[o].downcase 
>    break unless d == 0
>  end 
>  d
>end
>
>email.each do | e | puts "#{e[:user]}@#{e[:server]}#{e[:tld]}" end

Das ganze 1:1 in Perl:

#!/usr/bin/perl

my @email;

die "Usage: $0 <file>" if @ARGV > 1;

while( <> ) {
    while( /([\w_.+-]+)@([\w.+_-]+\.)+(\w{2,3}|\d{1,3})/g ) {
        push @email, { user => $1, server => $2, tld => $3 };
    }
}

print "Please set the sort order 1 = user, 2 = server, 3 = top level domain:\n";
my @order = do {
    $_ = <STDIN>;
    /^2$/ ? qw( server tld user ) :
    /^3$/ ? qw( tld server user ) :
            qw( user server tld );
};

@email = sort {
    my $d = 0;
    for( @order ) {
        $d = lc $a{ $_ } cmp lc $b{ $_ };
        last unless $d == 0;
    }
    $d;
};

for( @email ) {
    print "$$_{user}\@$$_{server}$$_{tld}";
}

__END__

Allerdings ist das »die« in der Perl-Version überflüssig, weil
der `<>`-Operator selbständig beliebig viele Eingabedateien
entgegennimmt (und bei Abwesenheit von Argumenten auf STDIN
ausweicht).

Und insgesamt ist das relativ holprig. Ich würd’s anders
ausdrücken.

Gruss,
-- 
#Aristoteles
*AUTOLOAD=*_;sub _{s/(.*)::(.*)/print$2,(",$\/"," ")[defined wantarray]/e;$1};
&Just->another->Perl->hacker;