Leser: 23
1 2 3 4 5
my @db; open(my $fh, "<", $config{db}) or die "$config{db}: $!"; while (<$fh>){ push(@db, $_); }
1 2 3 4
my @db; open(my $fh, "<", $config{db}) or die "$config{db}: $!"; my @db=<$fh> chomp(@db); # <= \n entfernen dann gibt es keine Probleme damit
1 2 3 4 5
my @db; open(my $fh, "<", $config{db}) or die "$config{db}: $!"; my @db=<$fh> chomp(@db); # <= \n entfernen dann gibt es keine Probleme damit $_=[split(/;/,$_)] for(@db);
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 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
#!/usr/bin/perl use strict; use warnings; use Class::Date qw(:errors date localdate gmdate now -DateParse -EnvC); # Paket: libclass-date-perl use Text::CSV; use Data::Dumper; $Class::Date::DATE_FORMAT="%Y-%m-%d"; my %config = ( "debug" => 3, # debug-level 0 or upto 3 "sendmail" => "/usr/sbin/sendmail -t", "from" => "root", # mail from header-field "db_file" => "./birthdaydb.csv", # database "reminder" => 5, # $reminder ); $config->{db}=load_db(\%config); for my $row (@{$config->{db}}) { print Dumper($row) if ($config{debug}>0); next unless( $row->[0] ); print "\tdate: $row->[0]\n". "\tname: $row->[1]\n". "\tmail: $row->[2]\n" if ($config{debug}>1); my $date = Class::Date->new("$row->[0]"); my $today = Class::Date->new(time); my $age = $today->year - $date->year; print "\tToday: $today; Birthday: $date\n" if ($config{debug}>1); $today -= [$age,0,-1]; print "\t? Today+1: $today == $date\n" if ($config{debug}>1); if ( $date->string ne $today->string ) { next if ( $config{reminder} <= 0 ); $today += [0,0,$config{reminder}-1]; print "\t? Today+$config{reminder}: $today == $date (reminder)\n" if ($config{debug}>1); next if ( $date->string ne $today->string ); } print "\tHAPPY ${age}th BIRTHDAY!\n" if ($config{debug}>0); $date += [$age,0,0]; sendmail(\%config, $row->[1], $row->[2], $date, $age); } ################################################################ sub load_db { my $config=shift; my @db; my $csv = Text::CSV->new(); open(my $fh, '<', $config->{db_file}) or die "error open $file ($!)\n"; while(my $row=$csv->$csv->getline($fh)) { push(@db,$row); } close($fh) or die "error close $file ($!)\n"; return \@db; } sub get_addresses { my $config=shift; my $exclude = shift; # exclude birthday child (by name) my $s; for my $row (@{$config->{db}}) { $s .= $row->[2]."," if (length($row->[2]) && $row->[1] ne $exclude); } print "\texclude: $exclude\n\t$s\n" if ($config->{debug}>1); return $s; } sub sendmail { my $config=shift; my $user=shift; my $reply=shift; my $date=shift; my $age=shift; my $to=get_addresses($config, $user); my $mail=<<EOM; From: $config->{from} Reply-To: $reply To: $to Subject: Der Geburtstag von $user User-Agent: HAPPY BIRTHDAY! !!! Test Betrieb der beta-Version vom HAPPY BIRTHDAY! Mailer !!! Hallo, diese Mail soll daran erinnern, das $user am $date $age Jahre alt wird. Mit freundlichen Grüßen \tIhr HAPPY BIRTHDAY! Team. PS: Diese E-Mail wurde automatisch verschickt. . EOM print $mail if ($config->{debug}>2); # open(SENDMAIL, "|-", $config->{sendmail}) || die ("$config->{sendmail}: $!\n"); # print SENDMAIL $mail; # close(SENDMAIL); }
1 2 3 4 5 6
my $config_file = new Config::General( -ConfigFile => "./config.txt" ); my %config = $config_file->getall(); my $config->{db}=load_db(\%config);
2011-02-03T16:35:46 mikaIn get_adressen musste es my @config=shift; sein, nicht my $config=shift;. Aber das war sicher ein copy'n'past fehler. sonst läuft es - Dankeschön!
QuoteDie Funktion chomp war mir neu und $_=split(/;/,$_) for(@db); liegt ja eigentlich auf der Hand...
1
2
3
perl -wle 'my $line = split(/;/, "a;b;c"); print $line'
Use of implicit split to @_ is deprecated at -e line 1.
3
2011-02-03T16:37:24 Linuxer2011-02-03T16:35:46 mikaIn get_adressen musste es my @config=shift; sein, nicht my $config=shift;. Aber das war sicher ein copy'n'past fehler. sonst läuft es - Dankeschön!
shift holt das erste Element aus @_; damit ist $config IMHO schon korrekt.
Hast Du dazu einen Fehler oder eine Warnung bekommen?
Oder warum glaubst Du, dass my $config = shift; falsch wäre?
2011-02-03T16:37:24 LinuxerQuoteDie Funktion chomp war mir neu und $_=split(/;/,$_) for(@db); liegt ja eigentlich auf der Hand...
Hier bin ich eher irritiert.
Jede gelesene Zeile wird am Semikolon in Felder gesplittet. Das Ergebnis (eine Liste) wird eben dem Skalar,
der zuvor die Zeile enthielt, wieder zugewiesen. Somit steht nun die Anzahl der Listenelemente in dem Skalar.
(Zuweisung einer Liste an einen Skalar).
Ist das so erwünscht? (Ich gebe zu, nicht den gesamten Code betrachtet/analysiert zu haben.)
Was übersehe ich?
Quicktest:
Code: (dl )1
2
3perl -wle 'my $line = split(/;/, "a;b;c"); print $line'
Use of implicit split to @_ is deprecated at -e line 1.
3
Nur so Gedanken meinerseits.
2011-02-03T17:37:28 mikaGut aufgepasst, da denkst du richtig. Es sollte wenn schon eine Liste/Array bleiben statt ein Skalar/String... Jetzt wo du es sagst, aber so Fit bin ich in Perl nicht.
Doch nun ist dieser Teil ja irrelevant da ich hierfür das Text::CSV Modul nutze.
2011-02-03T17:37:28 mikaFalsch ist es nicht, nur funktioniert es in meinem Code so nicht... Warum kann ich nicht sagen. Es geht um die Funktion sendmail.
$config{db} = load_db(\%config);
QuoteIch erhalte so keinen Fehler, aber es wird auch nicht in die for-Schleife gesprungen. Wenn ich es so mache wie hier (Mit my @config=shift; tuts das.)
1 2 3
... next if (substr($date->string,5,5) ne substr($today->string,5,5)) { ...
strcmp($date->string,$today->string,5,5)
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
#! /usr/bin/perl # vim:ts=4 sw=4 sts=4 et nu fdc=3: use strict; use warnings; use Benchmark qw( cmpthese ); my $date1 = '2010-08-24'; # my $date2 = '2009-13-22'; # invalid date, but who cares #> sub routines #> ---------------------------------------------------------------------------- sub strcmp1 { my ($d1,$d2,$p,$l) = @_; substr($d1,$p,$l) ne substr($d2,$p,$l) } #> main script #> ---------------------------------------------------------------------------- cmpthese( -1, { direct => sub { substr($date1,5,5) ne substr($date2,5,5) }, regex => sub { ($date1=~/^.....(.{5})/)[0] ne ($date2=~/^.....(.{5})/)[0] }, sub1 => sub { strcmp1($date1,$date2,5,5) }, }); __END__
1
2
3
4
Rate regex sub1 direct
regex 608962/s -- -29% -76% # slowest
sub1 860159/s 41% -- -66%
direct 2541562/s 317% 195% -- # fastest
1 2 3 4 5 6 7
if ( $date->error != $date->E_OK ) { print STDERR Dumper($row); print STDERR "E: ".$date->errstr; next; } else { print Dumper($row) if ($config{debug}>0); }
1 2 3 4 5 6 7
my $date = Class::Date->new($row->[0]); if ( $row->[0] !~ m/^\d*-\d\d\-\d\d$/ || $date->error != $date->E_OK ){ print STDERR Dumper($row); print STDERR "E: Invalid date. ".$date->errstr; next; } else { ...