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
use Text::xSV; use file::Copy qw/ move /; # open original my $csv = new Text::xSV( sep => ';' ); $csv->open_file("foo.csv"); my $header = $csv->read_header(); # open new my $csv2 = Text::xSV->new( sep => ';', filename => "foo2.csv", # muss noch geändert werden, hab auf die schnelle keine methode # gefunden, einfach ein array auszulesen header => [keys %$header], ); $csv2->print_header(); while (my $row = $csv->get_row()) { for my $field (@$row) { if (length $field > 30) { substr($field, 29, -1, ""); } } # print to new file $csv2->print_row(@$row); } # move new file to original move "foo2.csv", "foo.csv";
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
use warnings; use strict; my $infile = 'exportiert.csv'; open (my $infile_fh, '<', $infile) or die "Kann $infile nicht lesen\n"; my $outfile = 'kurz.csv'; open (my $outfile_fh, '>', $outfile) or die "Kann $outfile nicht schreiben\n"; while (my $line = <$infile_fh>) { my @fields = split /;/, $line; for my $field (@fields) { if (length($field) > 30) { $field = substr($field, 0, 30); } } print $outfile_fh join(';', @fields); }
perl -pi.bak -e "s/([^;]{30})[^;]+/$1/g" exportiert.csv
1 2 3 4 5 6 7
use strict; use warnings; my @arr = qw( Hallo Welt. Der Mond ist aufgegangen. ); # Nur das erste und vierte Element nutzen print join " ", @arr[0,3];
Hallo Mond
1 2 3 4 5 6 7 8 9 10 11 12 13
# ... my @output_cols = (0,1,2,5); # Wunschfelder festlegen (1.-3. und 6.) while (my $line = <$infile_fh>) { chomp $line; # Linefeed entfernen my @fields = split /;/, $line; for my $field (@fields) { if (length($field) > 30) { $field = substr($field, 0, 30); } } # Gewünschte Felder mit abschließendem Linefeed ausgeben print $outfile_fh join(';', @fields[@output_cols]) . "\n"; }
2013-05-03T14:20:37 FIFODer Nachteil an solchem Code ist, dass er z.B. nur funktioniert, wenn die Felder nicht gequotet sind (und also auch kein Semikolon innerhalb eines Feldes auftreten kann).
2013-05-08T08:47:05 MuffiWenns aber eine einmalige Konvertierung sein soll, bei der die Randbedingungen stimmen fang ich nicht an Module zu installieren, wenns ein Perl -e auch tut.
2013-05-08T08:32:52 bloonixKorrekt. Ich verstehe dann nicht, warum man nicht auf dem Beispiel von pq aufbaut und überhaupt so ein Beispiel aufzeigt, was ganz bestimmt nicht immer funktioniert und das Skript dann wieder umgeschrieben werden muss.
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
#!/usr/bin/perl use warnings; use strict; open A, '<Partnerliste_05_13.csv' or die $!; open B, '>neu.csv' or die $!; while (<A>) { s/Versicherungsmakler/Vers.-Makler/i; s/Versicherungs-/Vers.-/i; s/Versicherungs/Vers.-/i; s/Versicherungen/Vers./i; s/Versicherung/Vers./i; s/unabhängiger/unabh./i; s/unabhängige/unabh./i; s/unabhängig/unabh./i; s/Unabhängiger/unabh./i; s/Unabhängige/unabh./i; s/Unabhängig/unabh./i; s/Geschäftsstelle/GSt./i; s/(haftungsbeschränkt)//i; s/haftungsbeschränkt//i; print B; } close A; close B; #Ende Teil 1 my $infile = 'neu.csv'; open (my $infile_fh, '<', $infile) or die "Kann $infile nicht lesen\n"; my $outfile = 'neu2.csv'; open (my $outfile_fh, '>', $outfile) or die "Kann $outfile nicht schreiben\n"; my @output_cols = (1,2,3,4,5); while (my $line = <$infile_fh>) { chomp $line; my @fields = split /;/, $line; for my $field (@fields) { if (length($field) > 30) { $field = substr($field, 0, 30); } } print $outfile_fh join(';', @fields[@output_cols]) . "\n"; } #Ende Teil 2 open C, '<neu2.csv' or die $!; open D, '>endprodukt.csv' or die $!; while (<C>) { #GmbH soll bleiben, Gmb/Gm/G soll gelöscht werden print D } close C; close D; #Ende Teil 3
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
#!/usr/bin/perl use warnings; use strict; my $infile = 'Partnerlist_05_13.csv'; my $outfile = 'neu.csv'; open my $INFH, '<', $infile or die "open(ro,$infile): $!\n"; open m< $OUTFH, '>' $outfile or die "open(w,$outfile): $!\n"; while (local $_ = <$INFH>) { # Teil 1 s{Versicherungsmakler}{Vers.-Makler}i; # Reihenfolge der Alternativen ist wichtig s{Versicherung(?:s-?|en|)}{Vers.-}i; # da Gross/klein egal ist (/i), braucht es kein Match für "Unab.." s{unabhängig(?:er?)}{unabh.}i; s{Geschäftsstelle}{GSt.}i; # () als Suchstring muessen maskiert werden! s{\(?haftungsbeschränkt\)?}{}i; # Teil 2 chomp; my @fields = split /;/, $_; for my $field ( @fields ) { if ( length($field) > 30 ) { $field = substr($field, 0, 30 ); } } # $/ wurde durch chomp() entfernt, hier fuegen wir es wieder an $_ = join( ';', @fields ) . $/; # Teil 3 # dort wo "Gmb" oder "Gm" oder "G" als Wort endet, wird es entfernt # kann klappen, muss aber nicht; ein "GmbH & Co KG" verliert auch das letzte "G" !!!! s{(?Gmb|Gm|G)\b}{}g; # daher vielleicht lieber auch vorne auf Wortgrenze pruefen #s{\b(?Gmb|Gm|G)\b}{}g; print OUTFH; } close $INFH; close $OUTFH or die "close($outfile): $!\n";
QuoteCode (perl): (dl )1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21open A, '<Partnerliste_05_13.csv' or die $!; open B, '>neu.csv' or die $!; while (<A>) { print B; } my $infile = 'neu.csv'; open (my $infile_fh, '<', $infile) or die "Kann $infile nicht lesen\n"; my $outfile = 'neu2.csv'; open (my $outfile_fh, '>', $outfile) or die "Kann $outfile nicht schreiben\n"; while (my $line = <$infile_fh>) { print $outfile_fh ... } open C, '<neu2.csv' or die $!; open D, '>endprodukt.csv' or die $!; while (<C>) { print D }
open my $fh, '<', $path or die $!;
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
use warnings; use strict; my @replacements = ( ['Versicherungs' => 'Vers.-'], ['Versicherung(?:en)?' => 'Vers.'], ['unabhängig(er|es|e)?' => 'unabh.'], ['\(?haftungsbeschränkt\)?' => ''], ['Geschäftsstelle' => 'GSt.'], ); # Wörter, die abgeschnitten werden, falls unvollständig my @cut_incomplete = qw( GmbH Ltd oHG ); my $infile = 'neu.csv'; open (my $infile_fh, '<', $infile) or die "Kann $infile nicht lesen\n"; my $outfile = 'neu2.csv'; open (my $outfile_fh, '>', $outfile) or die "Kann $outfile nicht schreiben\n"; my @output_cols = (0,1,2,3,4); my @replace_cols = (3,4); # diese Spalten sollen bearbeitet werden my $cut_pos_default = 30; # Default-Maximallänge while (my $line = <$infile_fh>) { chomp $line; my @fields = split /;/, $line; # Ersetzungen in gewünschten Spalten erledigen. Wenn das in allen Ausgabe- # spalten sein soll: @replace_cols durch @output_cols ersetzen COLUMN: for my $field (@fields[@replace_cols]) { # Ersetzungen gem. Tabelle for my $sr (@replacements) { $field =~ s{$sr->0}{$sr->1}i; } next COLUMN if length($field) <= $cut_pos_default; # Standard-Maximallänge my $cut_pos = $cut_pos_default; # KOORIGIERT AB HIER # Bah-Wörter am Schluss abschneiden CUT_CANDIDATE: for my $cut_candidate (@cut_incomplete) { my $new_cut_pos = $cut_pos; for (1..length($cut_candidate) - 1) { $new_cut_pos--; if ($field =~ /\A.{$new_cut_pos}$cut_candidate/) { $cut_pos = $new_cut_pos ; last CUT_CANDIDATE; } } } # BIS HIER # Länge begrenzen $field =~ s{(.{$cut_pos}).*}{$1}; # falls gewünscht: Whitespace am Ende kappen $field =~ s/\s+$//; } print $outfile_fh join(';', @fields[@output_cols]) . "\n"; }