logbuch: comparison log.pl

equal deleted inserted replaced

-:10c207a978e2
+:714d4a0ea0bc
 #   - On opening/reading the log file: convert from UTF-8 -> current codeset
 #   - If this fails, issue a warning, use "head <something>" to show the
 #     last LOG entry directly and then fire up the editor with an
 #     empty file (or just added notice why we do not show the old
 #     messages)
-#   - After editing: convert the current messsage to from the current
+#   - After editing: convert the current messsage from the current
-#     codeset UTF-8
+#     codeset to UTF-8
 #   - The same is for message on command line (but this is more easy, we
 #     do not have to cope with the old message log
 use strict;
 use warnings;
 use DBI;
 use MIME::QuotedPrint;
 use I18N::Langinfo qw(langinfo CODESET);
 use Text::Iconv;
 use Pod::Usage;
+use Sys::Hostname;
 use Logbuch::HG;
 use lib "/etc/logbuch";
 use config;
 my $DSN  = "DBI:mysql:logbuch:pu.schlittermann.de";
 my $USER = "logbuch";
 my $PW   = "HIDDEN";
-my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
+my $EDITOR   = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
-my $MAGIC = "#--- all changes below are ignored ---#\n";
+my $MAGIC    = "#--- all changes below are ignored ---#\n";
+my $NODENAME = (split /\./, hostname)[0];
 my $opt_db      = 1;
 my $opt_mail    = 1;
 my $opt_message = "";
 my $opt_apt     = "";
 my $opt_initdir = "";
-my $opt_file    = "$ENV{HOME}/LOG";
+my $opt_file    = defined $config::logfile    # use it twice
+? $config::logfile
+: "/root/LOG.$NODENAME";
 my $Dbh;
 sub identity();
-sub hostname();
 sub mailto();
 sub check_hg_bin();
+sub full_hostname();
+sub word_encoded($);
 MAIN: {
 GetOptions(
 "db!"         => \$opt_db,
 "  * $opt_message",
 "\n",
 $auto_message,
 "\n", $MAGIC, "\n";
+# LOG.<hostname> wird in Zukunft genutzt und LOG nur ein Symlink
+# dorthin
+if ($opt_file =~ /(.*)\.$NODENAME$/ and !(-e $opt_file) and (-f $1)) {
+rename($1 => $opt_file) or die "Can't rename $1 => $opt_file: !\n";
+symlink($opt_file, $1) or die "Can't symlink $1 => $opt_file: $!\n";
+}
 if (!-e $opt_file) {
 open(X, $_ = ">>$opt_file") or die "Can't open $_: $!\n";
 close X;
 }
 if ($opt_db and $Dbh) {
 my $sth = $Dbh->prepare("
 		    INSERT INTO log (host, date, user, mailto, text)
 		    VALUES(?, now(), ?, ?, ?)");
-$sth->execute(hostname(), $user, $mailto, $text);
+$sth->execute(full_hostname(), $user, $mailto, $text);
 print STDERR "Database entry inserted\n";
 }
 if ($opt_mail and $mailto) {
 my $mailer = new Mail::Mailer "sendmail"
 or die "Can't create Mailer: $!\n";
 my $subject = (split /\n/, $text)[0];
 $subject =~ s/^\s*\S\s//;    # cut the "itemizer"
-$subject = encode_qp("Service [" . hostname() . "]: $subject\n");
-$subject =~ s/\n(.)/\n\t$1/g;
+	     # and now convert to quoted printable (UTF-8)
+	     # =?utf-8?q?St=C3=BCmper_am_Werk=3A_Shellscripte_aus_der?=
+$subject = word_encoded("Service [" . full_hostname() . "]: $subject");
 $mailer->open(
 {
 "Content-Type"              => "text/plain; charset=utf-8",
 "Content-Transfer-Encoding" => "8bit",
 chomp $user;
 $user .= " [" . ($ENV{IUS_PROFILE} || $ENV{REMOTE_USER} || "-") . "]";
 return $user;
 }
-sub hostname() {
+sub full_hostname() {
 my $r = `hostname -f`;
 chomp($r);
 return $r;
 }
 sub mailto() {
 return join(", ", @config::mailto);
 }
+sub word_encoded($) {
+my $line = shift;
+# to get "Q" word encoding, we've to fix the result a bit
+# http://en.wikipedia.org/wiki/MIME
+# FIXME: The line may be longer than expected!
+$line = encode_qp($line);
+$line =~ s/([_?])/sprintf "=%02X", ord($1)/ige;
+$line =~ s/[ \t]/_/g;
+return join "\t", map { "=?UTF-8?Q?$_?=\n" } split /=\n/, $line;
+}
 sub check_hg_bin() {
 if (not Logbuch::HG::hg_available()) {
 die <<'EOF';

changeset 28	714d4a0ea0bc
parent 27	10c207a978e2
child 32	68f8a7003db3