Thread RDW #1 - Rätsel der Woche Nummer eins (112 answers)
Opened by Crian at 2004-07-08 21:52

Crian
 2004-07-11 23:33
#83982 #83982
User since
2003-08-04
5866 Artikel
ModeratorIn
[Homepage]
user image
Ja .... seufz :-/

Also, die erste Loesung kam von pq und sieht so aus:

Code: (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
#!/usr/bin/perl
use strict;
use warnings;
use File::Find; # Faulheit =)
use File::Spec; # Portabilit??t
use Getopt::Std; # standard
my %opts;
# -e: folge symlinks
# -d path: path anstelle .
# -i n: wieviele Leerzeichen zur Einr??ckung (default 2)
getopts('ed:i:', \%opts);

my $indent = defined $opts{i} ? $opts{i} : 2;

my $dir = defined $opts{d}? $opts{d} : ".";
{
my %dirs;
find( {wanted => sub {
my $name = $File::Find::name;
# Pfad in einzelne Directories splitten
my @dirs = File::Spec->splitdir($name);
shift @dirs; # das erste . verschwinden lassen
# im falle eines verzeichnisses eine hashref, ansonsten
# der leere string
pushref(\%dirs, @dirs, -d $_ ? {} : "");
}, follow => $opts{e}}, $dir);
print_nice(\%dirs,0);
}
sub print_nice {
my ($hash, $level) = @_;
foreach my $key (sort keys %$hash) {
print " " x ($level * $indent); # einr??ckung
print $key;
my $value = $hash->{$key};
print "/" if ref $value;
print $/;
if (ref $value) {
print_nice($value, $level + 1);
}
}
}
sub pushref {
# gegeben eine reihe von strings, etwa A, B, C, werden
# in einen hash eingef??gt: $dir->{A}->{B}->{C} = $value
my $value = pop;
my ($dir,@dirs) = @_;
my $ref = \$dir;
for (@dirs) {
$ref = \$$ref->{$_};
}
$$ref = $value;
$_[0] = $dir;
}


Die zweite Loesung kommt von sri und sieht so aus:

Code: (dl )
1
2
3
perl -MData::Dumper -e 'do{for(glob"$_*"){split m[/]and$.=\%.and
push@.,"$_/";$.=$.->{$_[$_]}||=$_==$#_?"":{}for
0..$#_;}}while($_=shift@.);&_;sub _{print Dumper\%.}'


Die dritte Loesung ist meine Sample-Loesung:

Code: (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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#!/usr/bin/perl
#------------------------------------------------------------------------------
# program     : r d w 0 1 _ c r i a n . p l
#------------------------------------------------------------------------------
# author      : Christian Duehl
# created     : 2004-07-08
# last change : 2004-07-08
# task        : Solution to RDW #1
# parameter   : none
#------------------------------------------------------------------------------
use strict;
use warnings;

#------------------------------------------------------------------------------
# packages:
#------------------------------------------------------------------------------
use Cwd          qw//;
use Data::Dumper qw/Dumper/;

#------------------------------------------------------------------------------
# prototypes:
#------------------------------------------------------------------------------
sub rdir ($$);
sub pdir ($);

#------------------------------------------------------------------------------
# constants:
#------------------------------------------------------------------------------
use constant SEP => '/';

#------------------------------------------------------------------------------
# main:
#------------------------------------------------------------------------------
my %Dir;
rdir(Cwd::cwd(), \%Dir);
pdir(\%Dir);
exit;


sub rdir ($$) {
   #--------------------------------------------------------------------------
   # sub          : r d i r
   #--------------------------------------------------------------------------
   # author       : Christian Duehl
   # task         : Reads the working directory into the data structure.
   # parameters   : 1) starting directory
   #                2) structure (hash) to store the result
   # return value : the blessed new object
   #--------------------------------------------------------------------------
   # 0.0.1 - 2004-07-08 - CD - created
   #--------------------------------------------------------------------------

   my ($start, $dir) = @_;

   my $read;

   opendir($read, $start) or die "can't opendir '$start' : $!";
   while (my $entry = readdir($read)) {
       next if $entry eq '..' or $entry eq '.';
       if (-d $start . SEP . $entry) {
           my %tdir;
           rdir($start . SEP . $entry, \%tdir);
           $dir->{$entry} = { %tdir };
       }
       else {
           $dir->{$entry} = '';
       }
   }
   closedir($read) or warn "can't closedir '$start' : $!";
} # sub rdir


sub pdir ($) {
   #--------------------------------------------------------------------------
   # sub          : p d i r
   #--------------------------------------------------------------------------
   # author       : Christian Duehl
   # task         : Dump the given structure.
   # parameters   : 1) reference to the structure
   # return value : the blessed new object
   #--------------------------------------------------------------------------
   # 0.0.1 - 2004-07-08 - CD - created
   #--------------------------------------------------------------------------

   my ($dir) = @_;

   $Data::Dumper::Indent    = 3;
   $Data::Dumper::Varname   = 'dir';
   $Data::Dumper::Quotekeys = 0;
   $Data::Dumper::Sortkeys  = 1;
   
   print Dumper($dir);
} # sub pdir


Ich wollte meine Beipiellösung eigentlich noch erweitern, vielleicht mache ich das auch nochmal. Testbericht etc. folgt später, ich weiß auch noch von mindestens einem Kandidaten, der noch an einer Lösung brütet, aber da ich ihn von gestern auf heute besucht habe, sind wir beide nicht dazu gekommen =)
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite
Antworten mit Zitat

View full thread RDW #1 - Rätsel der Woche Nummer eins