log.pl
changeset 38 8cef3bca3096
parent 36 52cf4f39024c
child 48 a1b051269c2e
equal deleted inserted replaced
37:08527fba71ae 38:8cef3bca3096
    70 my $opt_initdir = "";
    70 my $opt_initdir = "";
    71 my $opt_file    = defined $config::logfile    # use it twice
    71 my $opt_file    = defined $config::logfile    # use it twice
    72   ? $config::logfile
    72   ? $config::logfile
    73   : "/root/LOG.$NODENAME";
    73   : "/root/LOG.$NODENAME";
    74 
    74 
    75 
       
    76 my $Dbh;
    75 my $Dbh;
    77 
    76 
    78 sub identity();
    77 sub identity();
    79 sub mailto();
    78 sub mailto();
    80 sub check_hg_bin();
    79 sub check_hg_bin();
    88         "mail!"       => \$opt_mail,
    87         "mail!"       => \$opt_mail,
    89         "m|message=s" => \$opt_message,
    88         "m|message=s" => \$opt_message,
    90         "type=s"      => \$opt_apt,
    89         "type=s"      => \$opt_apt,
    91         "init-dir=s"  => \$opt_initdir,
    90         "init-dir=s"  => \$opt_initdir,
    92         "f|file=s"    => \$opt_file,
    91         "f|file=s"    => \$opt_file,
    93         "man"         => sub { pod2usage(-verbose => 2, -exit => 0) },
       
    94         "help"        => sub { pod2usage(-verbose => 0, -exit => 0) },
    92         "help"        => sub { pod2usage(-verbose => 0, -exit => 0) },
       
    93         "man"         => sub {
       
    94             pod2usage(
       
    95                 -verbose   => 2,
       
    96                 -exit      => 0,
       
    97                 -noperldoc => system("perldoc -V 2>/dev/null 1>/dev/null")
       
    98             );
       
    99         },
    95     ) or pod2usage();
   100     ) or pod2usage();
    96 
   101 
    97     if ($opt_message =~ /^@(.*)/) {
   102     if ($opt_message =~ /^@(.*)/) {
    98         @ARGV = $1;
   103         @ARGV = $1;
    99         $opt_message = join "", <>;
   104         $opt_message = join "", <>;
   151     }
   156     }
   152 
   157 
   153     if ($opt_db) {
   158     if ($opt_db) {
   154         END { $Dbh->disconnect() if $Dbh; }
   159         END { $Dbh->disconnect() if $Dbh; }
   155         $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 0 })
   160         $Dbh = DBI->connect($DSN, $USER, $PW, { RaiseError => 0 })
   156 	    or warn $DBI::errstr;
   161           or warn $DBI::errstr;
   157     }
   162     }
   158 
   163 
   159     # Temporärfile öffnen
   164     # Temporärfile öffnen
   160     my ($fh, $file) = tempfile(DIR => "/tmp", UNLINK => 1);
   165     my ($fh, $file) = tempfile(DIR => "/tmp", UNLINK => 1);
   161 
   166 
   242               or die "Can't create Mailer: $!\n";
   247               or die "Can't create Mailer: $!\n";
   243 
   248 
   244             my $subject = (split /\n/, $text)[0];
   249             my $subject = (split /\n/, $text)[0];
   245             $subject =~ s/^\s*\S\s//;    # cut the "itemizer"
   250             $subject =~ s/^\s*\S\s//;    # cut the "itemizer"
   246 
   251 
   247 	     # and now convert to quoted printable (UTF-8)
   252             # and now convert to quoted printable (UTF-8)
   248 	     # =?utf-8?q?St=C3=BCmper_am_Werk=3A_Shellscripte_aus_der?=
   253             # =?utf-8?q?St=C3=BCmper_am_Werk=3A_Shellscripte_aus_der?=
   249             $subject = word_encoded("Service [" . full_hostname() . "]: $subject");
   254             $subject =
       
   255               word_encoded("Service [" . full_hostname() . "]: $subject");
   250 
   256 
   251             $mailer->open(
   257             $mailer->open(
   252                 {
   258                 {
   253                     "Content-Type"              => "text/plain; charset=utf-8",
   259                     "Content-Type"              => "text/plain; charset=utf-8",
   254                     "Content-Transfer-Encoding" => "8bit",
   260                     "Content-Transfer-Encoding" => "8bit",
   298     return join(", ", @config::mailto);
   304     return join(", ", @config::mailto);
   299 }
   305 }
   300 
   306 
   301 sub word_encoded($) {
   307 sub word_encoded($) {
   302     my $line = shift;
   308     my $line = shift;
       
   309 
   303     # to get "Q" word encoding, we've to fix the result a bit
   310     # to get "Q" word encoding, we've to fix the result a bit
   304     # http://en.wikipedia.org/wiki/MIME
   311     # http://en.wikipedia.org/wiki/MIME
   305     # FIXME: The line may be longer than expected!
   312     # FIXME: The line may be longer than expected!
   306     $line = encode_qp($line);
   313     $line = encode_qp($line);
   307     $line =~ s/([_?])/sprintf "=%02X", ord($1)/ige;
   314     $line =~ s/([_?])/sprintf "=%02X", ord($1)/ige;