1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
201.1 201(27,28,3,4,83,84,890,897,898,9)
201.1 2054
201.2 201(1,20-26,29,80-82,891-896,899)
201.3 201(52-54,6,75,76,85-88)
201.4 201(50,51,55-59,70-74,77-79)
202.1 202(20-24,28,29,4,75,8,90-92,94,95,97-99)
202.2 202(1,27,3,70-74,76-79,93)
202.3 202(25,26,5,6,96)
203.1 203(1-3,41-45,9)
203.1 206
203.2 203(40,46-49,5,8)
203.3 203(6,7)
2041.1 204
2051.1 2051
2051.1 2052
2051.1 2053
2051.1 2056
2051.1 2058
1
2
3
4
5
6
7
8
9
10
201.1 20127
201.1 20128
201.1 2013
201.1 2014
201.1 20183
201.1 20184
201.1 201890
201.1 201897
201.1 201898
201.1 2019
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
use warnings; use strict; my @new_lines; while (my $line = <DATA>) { my ($key, $prefix, $extension) = $line =~ /\A(.+?)\t(\d+)(?:\((.+?)\))?/; if (defined $extension) { my @extensions = split(/,/, $extension); for my $item (@extensions) { if ($item =~ /(\d+)-(\d+)/) { # erste Zahl muss kleiner sein for my $i ($1..$2) { push @new_lines, "$key\t$prefix$i"; } } else { push @new_lines, "$key\t$prefix$item"; } } } else { push @new_lines, "$key\t$prefix"; } } print "$_\n" for sort(@new_lines); __DATA__ 201.1 201(27,28,3,4,83,84,890,897,898,9) 201.1 2054 201.2 201(1,20-26,29,80-82,891-896,899) 201.3 201(52-54,6,75,76,85-88) 201.4 201(50,51,55-59,70-74,77-79) 202.1 202(20-24,28,29,4,75,8,90-92,94,95,97-99) 202.2 202(1,27,3,70-74,76-79,93) 202.3 202(25,26,5,6,96) 203.1 203(1-3,41-45,9) 203.1 206 203.2 203(40,46-49,5,8) 203.3 203(6,7) 2041.1 204 2051.1 2051 2051.1 2052 2051.1 2053 2051.1 2056 2051.1 2058
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
201.1 20128
201.1 2013
201.1 2014
201.1 20183
201.1 20184
201.1 201890
201.1 201897
201.1 201898
201.1 2019
201.1 20127
201.1 20128
201.1 2013
201.1 2014
201.1 20183
201.1 20184
201.1 201890
201.1 201897
201.1 201898
201.1 2019
201.1 2054
201.1 20127
201.1 20128
201.1 2013
201.1 2014
201.1 20183
201.1 20184
201.1 201890
201.1 201897
201.1 201898
201.1 2019
201.1 2054
201.2 2011
201.2 20120
201.2 20121
201.2 20122
201.2 20123
201.2 20124
201.2 20125
201.2 20126
201.2 20129
201.2 20180
201.2 20181
201.2 20182
201.2 201891
201.2 201892
201.2 201893
201.2 201894
201.2 201895
201.2 201896
201.2 201899
201.1 20127
201.1 20128
201.1 2013
201.1 2014
201.1 20183
201.1 20184
201.1 201890
201.1 201897
.
.
.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
my $regex = qr[ \A (.+?) \t # zwischen Anfang und erstem TAB => $key (\d+) # $prefix (?: # Klammern nicht behalten \( # ( (.+?) # Inhalt zwischen Klammern => $extension \) # ) )? # nur falls vorhanden ]x; while (my $line = <DATA>) { my ($key, $prefix, $extension) = $line =~ /$regex/; # usw.
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
use v6;
my $in = q[201.1 201(27,28,3,4,83,84,890,897,898,9)
201.1 2054
201.2 201(1,20-26,29,80-82,891-896,899)
201.3 201(52-54,6,75,76,85-88)
201.4 201(50,51,55-59,70-74,77-79)
202.1 202(20-24,28,29,4,75,8,90-92,94,95,97-99)
202.2 202(1,27,3,70-74,76-79,93)
202.3 202(25,26,5,6,96)
203.1 203(1-3,41-45,9)
203.1 206
203.2 203(40,46-49,5,8)
203.3 203(6,7)
2041.1 204
2051.1 2051
2051.1 2052
2051.1 2053
2051.1 2056
2051.1 2058];
for $in.lines {
my ($left, $right) = .words;
if $right ~~ /'(' (.*) ')'/ {
my $prefix = $right.substr(0, $/.from);
say "$left\t$prefix$_" for $0.split: ',';
}
else {
.say;
}
}
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
use warnings; use strict; my $in_file = "DeineDatei.csv"; my $out_file = "DeineAndereDatei.csv"; my %new_lines; my $regex = qr[ \A (.+?) \t # zwischen Anfang und erstem TAB => $key (\d+) # $prefix (?: # Klammern nicht behalten \( # ( (.+?) # Inhalt zwischen Klammern => $extension \) # ) )? # nur falls vorhanden ]x; open (my $in_fh, '<', $in_file) or die "kann $in_file nicht lesen!\n"; while (my $line = <$in_fh>) { my ($key, $prefix, $extension) = $line =~ /$regex/; if (defined $extension) { my @extensions = split(/,/, $extension); ITEM: for my $item (@extensions) { # Zahlenbereich angegeben? if ($item =~ /(\d+)-(\d+)/) { if ($2 < $1) { print "fehlerhafte Bereichsangabe: '$item' in Zeile $.\n"; next ITEM; } for my $i ($1..$2) { push @{$new_lines{$key}}, "$prefix$i"; } } elsif ($item =~ /(\d+)/) { # nur Zahlen verwenden push @{$new_lines{$key}}, "$prefix$1"; } } } else { push @{$new_lines{$key}}, "$prefix"; } } close($in_fh); open (my $out_fh, '>', $out_file) or die "kann $out_file nicht schreiben!\n"; for my $key (sort {$a <=> $b} keys %new_lines) { for my $value (sort {$a <=> $b} @{$new_lines{$key}}) { print $out_fh "$key\t$value\n"; } } close($out_fh); print "fertig.\n";