Initial Commit

database/perl/vendor/lib/Sys/Syslog/Win32.pm

@@ -0,0 +1,283 @@
+package Sys::Syslog::Win32;
+use strict;
+use warnings;
+use Carp;
+use File::Spec;
+
+# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING ===
+#
+# This file was generated by Sys-Syslog/win32/compile.pl on Wed Aug 22 01:33:58 2007
+# Any changes being made here will be lost the next time Sys::Syslog 
+# is installed. 
+#
+# Do NOT USE THIS MODULE DIRECTLY: this is a utility module for Sys::Syslog.
+# It may change at any time to fit the needs of Sys::Syslog therefore no 
+# warranty is made WRT to its API. You Have Been Warned.
+#
+# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING ===
+
+our $Source;
+my $logger;
+my $Registry;
+
+use Win32::EventLog;
+use Win32::TieRegistry 0.20 (
+    TiedRef     => \$Registry,
+    Delimiter   => "/",
+    ArrayValues => 1,
+    SplitMultis => 1,
+    AllowLoad   => 1,
+    qw(
+        REG_SZ
+        REG_EXPAND_SZ
+        REG_DWORD
+        REG_BINARY
+        REG_MULTI_SZ
+        KEY_READ
+        KEY_WRITE
+        KEY_ALL_ACCESS
+    ),
+);    
+
+my $is_Cygwin = $^O =~ /Cygwin/i;
+my $is_Win32  = $^O =~ /Win32/i;
+
+my %const = (
+    CAT_KERN => 1,
+    CAT_USER => 2,
+    CAT_MAIL => 3,
+    CAT_DAEMON => 4,
+    CAT_AUTH => 5,
+    CAT_SYSLOG => 6,
+    CAT_LPR => 7,
+    CAT_NEWS => 8,
+    CAT_UUCP => 9,
+    CAT_CRON => 10,
+    CAT_AUTHPRIV => 11,
+    CAT_FTP => 12,
+    CAT_LOCAL0 => 13,
+    CAT_LOCAL1 => 14,
+    CAT_LOCAL2 => 15,
+    CAT_LOCAL3 => 16,
+    CAT_LOCAL4 => 17,
+    CAT_LOCAL5 => 18,
+    CAT_LOCAL6 => 19,
+    CAT_LOCAL7 => 20,
+    CAT_NETINFO => 21,
+    CAT_REMOTEAUTH => 22,
+    CAT_RAS => 23,
+    CAT_INSTALL => 24,
+    CAT_LAUNCHD => 25,
+    CAT_CONSOLE => 26,
+    CAT_NTP => 27,
+    CAT_SECURITY => 28,
+    CAT_AUDIT => 29,
+    CAT_LFMT => 30,
+    MSG_KERNEL => 128,
+    MSG_USER => 129,
+    MSG_MAIL => 130,
+    MSG_DAEMON => 131,
+    MSG_AUTH => 132,
+    MSG_SYSLOG => 133,
+    MSG_LPR => 134,
+    MSG_NEWS => 135,
+    MSG_UUCP => 136,
+    MSG_CRON => 137,
+    MSG_AUTHPRIV => 138,
+    MSG_FTP => 139,
+    MSG_LOCAL0 => 140,
+    MSG_LOCAL1 => 141,
+    MSG_LOCAL2 => 142,
+    MSG_LOCAL3 => 143,
+    MSG_LOCAL4 => 144,
+    MSG_LOCAL5 => 145,
+    MSG_LOCAL6 => 146,
+    MSG_LOCAL7 => 147,
+    MSG_NETINFO => 148,
+    MSG_REMOTEAUTH => 149,
+    MSG_RAS => 150,
+    MSG_INSTALL => 151,
+    MSG_LAUNCHD => 152,
+    MSG_CONSOLE => 153,
+    MSG_NTP => 154,
+    MSG_SECURITY => 155,
+    MSG_AUDIT => 156,
+    MSG_LFMT => 157,
+    STATUS_SEVERITY_SUCCESS => 0,
+    STATUS_SEVERITY_INFORMATIONAL => 1,
+    STATUS_SEVERITY_WARNING => 2,
+    STATUS_SEVERITY_ERROR => 3,
+
+);
+
+my %id2name = (
+    Sys::Syslog::LOG_KERN() => 'KERN',
+    Sys::Syslog::LOG_USER() => 'USER',
+    Sys::Syslog::LOG_MAIL() => 'MAIL',
+    Sys::Syslog::LOG_DAEMON() => 'DAEMON',
+    Sys::Syslog::LOG_AUTH() => 'AUTH',
+    Sys::Syslog::LOG_SYSLOG() => 'SYSLOG',
+    Sys::Syslog::LOG_LPR() => 'LPR',
+    Sys::Syslog::LOG_NEWS() => 'NEWS',
+    Sys::Syslog::LOG_UUCP() => 'UUCP',
+    Sys::Syslog::LOG_CRON() => 'CRON',
+    Sys::Syslog::LOG_AUTHPRIV() => 'AUTHPRIV',
+    Sys::Syslog::LOG_FTP() => 'FTP',
+    Sys::Syslog::LOG_LOCAL0() => 'LOCAL0',
+    Sys::Syslog::LOG_LOCAL1() => 'LOCAL1',
+    Sys::Syslog::LOG_LOCAL2() => 'LOCAL2',
+    Sys::Syslog::LOG_LOCAL3() => 'LOCAL3',
+    Sys::Syslog::LOG_LOCAL4() => 'LOCAL4',
+    Sys::Syslog::LOG_LOCAL5() => 'LOCAL5',
+    Sys::Syslog::LOG_LOCAL6() => 'LOCAL6',
+    Sys::Syslog::LOG_LOCAL7() => 'LOCAL7',
+    Sys::Syslog::LOG_NETINFO() => 'NETINFO',
+    Sys::Syslog::LOG_REMOTEAUTH() => 'REMOTEAUTH',
+    Sys::Syslog::LOG_RAS() => 'RAS',
+    Sys::Syslog::LOG_INSTALL() => 'INSTALL',
+    Sys::Syslog::LOG_LAUNCHD() => 'LAUNCHD',
+    Sys::Syslog::LOG_CONSOLE() => 'CONSOLE',
+    Sys::Syslog::LOG_NTP() => 'NTP',
+    Sys::Syslog::LOG_SECURITY() => 'SECURITY',
+    Sys::Syslog::LOG_AUDIT() => 'AUDIT',
+    Sys::Syslog::LOG_LFMT() => 'LFMT',
+
+);
+
+my @priority2eventtype = (
+    EVENTLOG_ERROR_TYPE(),       # LOG_EMERG
+    EVENTLOG_ERROR_TYPE(),       # LOG_ALERT
+    EVENTLOG_ERROR_TYPE(),       # LOG_CRIT
+    EVENTLOG_ERROR_TYPE(),       # LOG_ERR
+    EVENTLOG_WARNING_TYPE(),     # LOG_WARNING
+    EVENTLOG_WARNING_TYPE(),     # LOG_NOTICE
+    EVENTLOG_INFORMATION_TYPE(), # LOG_INFO
+    EVENTLOG_INFORMATION_TYPE(), # LOG_DEBUG
+);
+
+
+# 
+# _install()
+# --------
+# Used to set up a connection to the eventlog.
+# 
+sub _install {
+    return $logger if $logger;
+
+    # can't just use basename($0) here because Win32 path often are a 
+    # a mix of / and \, and File::Basename::fileparse() can't handle that, 
+    # while File::Spec::splitpath() can.. Go figure..
+    my (undef, undef, $basename) = File::Spec->splitpath($0);
+    ($Source) ||= $basename;
+    
+    $Source.=" [SSW:1.0.1]";
+
+    #$Registry->Delimiter("/"); # is this needed?
+    my $root = 'LMachine/SYSTEM/CurrentControlSet/Services/Eventlog/Application/';
+    my $dll  = 'Sys/Syslog/PerlLog.dll';
+
+    if (!$Registry->{$root.$Source} || 
+        !$Registry->{$root.$Source.'/CategoryMessageFile'}[0] ||
+        !-e $Registry->{$root.$Source.'/CategoryMessageFile'}[0] ) 
+    {
+
+        # find the resource DLL, which should be along Syslog.dll
+        my ($file) = grep { -e $_ }  map { ("$_/$dll" => "$_/auto/$dll") }  @INC;
+        $dll = $file if $file;
+
+        # on Cygwin, convert the Unix path into absolute Windows path
+        if ($is_Cygwin) {
+            if ($] > 5.009005) {
+                chomp($file = Cygwin::posix_to_win_path($file, 1));
+            }
+            else {
+                local $ENV{PATH} = '';
+                chomp($dll = `/usr/bin/cygpath --absolute --windows "$dll"`);
+            }
+        }
+
+        $dll =~ s![\\/]+!\\!g;     # must be backslashes!
+        die "fatal: Can't find resource DLL for Sys::Syslog\n" if !$dll;
+
+        $Registry->{$root.$Source} = {
+            '/EventMessageFile'    => [ $dll, REG_EXPAND_SZ ],
+            '/CategoryMessageFile' => [ $dll, REG_EXPAND_SZ ],
+            '/CategoryCount'       => [ '0x0000001e', REG_DWORD ],
+            #'/TypesSupported'      => [ '0x0000001e', REG_DWORD ],
+        };
+
+        warn "Configured eventlog to use $dll for $Source\n" if $Sys::Syslog::DEBUG;
+    }
+
+    #Carp::confess("Registry has the wrong value for '$Source', possibly mismatched dll!\nMine:$dll\nGot :$Registry->{$root.$Source.'/CategoryMessageFile'}[0]\n")
+    #    if $Registry->{$root.$Source.'/CategoryMessageFile'}[0] ne $dll;
+
+    # we really should do something useful with this but for now
+    # we set it to "" to prevent Win32::EventLog from warning
+    my $host = "";
+
+    $logger = Win32::EventLog->new($Source, $host) 
+        or Carp::confess("Failed to connect to the '$Source' event log");
+
+    return $logger;
+}
+
+
+# 
+# _syslog_send()
+# ------------
+# Used to convert syslog messages into eventlog messages
+# 
+sub _syslog_send {
+    my ($buf, $numpri, $numfac) = @_;
+    $numpri ||= EVENTLOG_INFORMATION_TYPE();
+    $numfac ||= Sys::Syslog::LOG_USER();
+    my $name = $id2name{$numfac};
+
+    my $opts = {
+        EventType   => $priority2eventtype[$numpri], 
+        EventID     => $const{"MSG_$name"},
+        Category    => $const{"CAT_$name"}, 
+        Strings     => "$buf\0", 
+        Data        => "",
+    };
+
+    if ($Sys::Syslog::DEBUG) {
+        require Data::Dumper;
+        warn Data::Dumper->Dump(
+            [$numpri, $numfac, $name, $opts], 
+            [qw(numpri numfac name opts)]
+        );
+    }
+
+    return $logger->Report($opts);
+}
+
+
+=head1 NAME
+
+Sys::Syslog::Win32 - Win32 support for Sys::Syslog
+
+=head1 DESCRIPTION
+
+This module is a back-end plugin for C<Sys::Syslog>, for supporting the Win32 
+event log. It is not expected to be directly used by any module other than 
+C<Sys::Syslog> therefore it's API may change at any time and no warranty is 
+made with regards to backward compatibility. You Have Been Warned. 
+
+=head1 SEE ALSO
+
+L<Sys::Syslog>
+
+=head1 AUTHORS
+
+SE<eacute>bastien Aperghis-Tramoni and Yves Orton
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;