Imported Upstream version 1.7
This commit is contained in:
commit
ccecbd3ce6
15
Changes
Normal file
15
Changes
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
1.7
|
||||||
|
Fix for https://github.com/dimentox/Log-Log4perl-Appender-Graylog/issues/1
|
||||||
|
|
||||||
|
1.6
|
||||||
|
Decided on a full Version bump due to the way i reworked its internals.
|
||||||
|
|
||||||
|
1.5.1
|
||||||
|
Adding script for further testing
|
||||||
|
|
||||||
|
1.5
|
||||||
|
Switched form custom parser to Log::GELF::Util
|
||||||
|
Added chunking and tpc or udp sending.
|
||||||
|
|
||||||
|
1.4
|
||||||
|
Added Gzip.
|
379
LICENSE
Normal file
379
LICENSE
Normal file
@ -0,0 +1,379 @@
|
|||||||
|
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as the Perl 5 programming language system itself.
|
||||||
|
|
||||||
|
Terms of the Perl programming language system itself
|
||||||
|
|
||||||
|
a) the GNU General Public License as published by the Free
|
||||||
|
Software Foundation; either version 1, or (at your option) any
|
||||||
|
later version, or
|
||||||
|
b) the "Artistic License"
|
||||||
|
|
||||||
|
--- The GNU General Public License, Version 1, February 1989 ---
|
||||||
|
|
||||||
|
This software is Copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software, licensed under:
|
||||||
|
|
||||||
|
The GNU General Public License, Version 1, February 1989
|
||||||
|
|
||||||
|
GNU GENERAL PUBLIC LICENSE
|
||||||
|
Version 1, February 1989
|
||||||
|
|
||||||
|
Copyright (C) 1989 Free Software Foundation, Inc.
|
||||||
|
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
|
Everyone is permitted to copy and distribute verbatim copies
|
||||||
|
of this license document, but changing it is not allowed.
|
||||||
|
|
||||||
|
Preamble
|
||||||
|
|
||||||
|
The license agreements of most software companies try to keep users
|
||||||
|
at the mercy of those companies. By contrast, our General Public
|
||||||
|
License is intended to guarantee your freedom to share and change free
|
||||||
|
software--to make sure the software is free for all its users. The
|
||||||
|
General Public License applies to the Free Software Foundation's
|
||||||
|
software and to any other program whose authors commit to using it.
|
||||||
|
You can use it for your programs, too.
|
||||||
|
|
||||||
|
When we speak of free software, we are referring to freedom, not
|
||||||
|
price. Specifically, the General Public License is designed to make
|
||||||
|
sure that you have the freedom to give away or sell copies of free
|
||||||
|
software, that you receive source code or can get it if you want it,
|
||||||
|
that you can change the software or use pieces of it in new free
|
||||||
|
programs; and that you know you can do these things.
|
||||||
|
|
||||||
|
To protect your rights, we need to make restrictions that forbid
|
||||||
|
anyone to deny you these rights or to ask you to surrender the rights.
|
||||||
|
These restrictions translate to certain responsibilities for you if you
|
||||||
|
distribute copies of the software, or if you modify it.
|
||||||
|
|
||||||
|
For example, if you distribute copies of a such a program, whether
|
||||||
|
gratis or for a fee, you must give the recipients all the rights that
|
||||||
|
you have. You must make sure that they, too, receive or can get the
|
||||||
|
source code. And you must tell them their rights.
|
||||||
|
|
||||||
|
We protect your rights with two steps: (1) copyright the software, and
|
||||||
|
(2) offer you this license which gives you legal permission to copy,
|
||||||
|
distribute and/or modify the software.
|
||||||
|
|
||||||
|
Also, for each author's protection and ours, we want to make certain
|
||||||
|
that everyone understands that there is no warranty for this free
|
||||||
|
software. If the software is modified by someone else and passed on, we
|
||||||
|
want its recipients to know that what they have is not the original, so
|
||||||
|
that any problems introduced by others will not reflect on the original
|
||||||
|
authors' reputations.
|
||||||
|
|
||||||
|
The precise terms and conditions for copying, distribution and
|
||||||
|
modification follow.
|
||||||
|
|
||||||
|
GNU GENERAL PUBLIC LICENSE
|
||||||
|
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||||
|
|
||||||
|
0. This License Agreement applies to any program or other work which
|
||||||
|
contains a notice placed by the copyright holder saying it may be
|
||||||
|
distributed under the terms of this General Public License. The
|
||||||
|
"Program", below, refers to any such program or work, and a "work based
|
||||||
|
on the Program" means either the Program or any work containing the
|
||||||
|
Program or a portion of it, either verbatim or with modifications. Each
|
||||||
|
licensee is addressed as "you".
|
||||||
|
|
||||||
|
1. You may copy and distribute verbatim copies of the Program's source
|
||||||
|
code as you receive it, in any medium, provided that you conspicuously and
|
||||||
|
appropriately publish on each copy an appropriate copyright notice and
|
||||||
|
disclaimer of warranty; keep intact all the notices that refer to this
|
||||||
|
General Public License and to the absence of any warranty; and give any
|
||||||
|
other recipients of the Program a copy of this General Public License
|
||||||
|
along with the Program. You may charge a fee for the physical act of
|
||||||
|
transferring a copy.
|
||||||
|
|
||||||
|
2. You may modify your copy or copies of the Program or any portion of
|
||||||
|
it, and copy and distribute such modifications under the terms of Paragraph
|
||||||
|
1 above, provided that you also do the following:
|
||||||
|
|
||||||
|
a) cause the modified files to carry prominent notices stating that
|
||||||
|
you changed the files and the date of any change; and
|
||||||
|
|
||||||
|
b) cause the whole of any work that you distribute or publish, that
|
||||||
|
in whole or in part contains the Program or any part thereof, either
|
||||||
|
with or without modifications, to be licensed at no charge to all
|
||||||
|
third parties under the terms of this General Public License (except
|
||||||
|
that you may choose to grant warranty protection to some or all
|
||||||
|
third parties, at your option).
|
||||||
|
|
||||||
|
c) If the modified program normally reads commands interactively when
|
||||||
|
run, you must cause it, when started running for such interactive use
|
||||||
|
in the simplest and most usual way, to print or display an
|
||||||
|
announcement including an appropriate copyright notice and a notice
|
||||||
|
that there is no warranty (or else, saying that you provide a
|
||||||
|
warranty) and that users may redistribute the program under these
|
||||||
|
conditions, and telling the user how to view a copy of this General
|
||||||
|
Public License.
|
||||||
|
|
||||||
|
d) You may charge a fee for the physical act of transferring a
|
||||||
|
copy, and you may at your option offer warranty protection in
|
||||||
|
exchange for a fee.
|
||||||
|
|
||||||
|
Mere aggregation of another independent work with the Program (or its
|
||||||
|
derivative) on a volume of a storage or distribution medium does not bring
|
||||||
|
the other work under the scope of these terms.
|
||||||
|
|
||||||
|
3. You may copy and distribute the Program (or a portion or derivative of
|
||||||
|
it, under Paragraph 2) in object code or executable form under the terms of
|
||||||
|
Paragraphs 1 and 2 above provided that you also do one of the following:
|
||||||
|
|
||||||
|
a) accompany it with the complete corresponding machine-readable
|
||||||
|
source code, which must be distributed under the terms of
|
||||||
|
Paragraphs 1 and 2 above; or,
|
||||||
|
|
||||||
|
b) accompany it with a written offer, valid for at least three
|
||||||
|
years, to give any third party free (except for a nominal charge
|
||||||
|
for the cost of distribution) a complete machine-readable copy of the
|
||||||
|
corresponding source code, to be distributed under the terms of
|
||||||
|
Paragraphs 1 and 2 above; or,
|
||||||
|
|
||||||
|
c) accompany it with the information you received as to where the
|
||||||
|
corresponding source code may be obtained. (This alternative is
|
||||||
|
allowed only for noncommercial distribution and only if you
|
||||||
|
received the program in object code or executable form alone.)
|
||||||
|
|
||||||
|
Source code for a work means the preferred form of the work for making
|
||||||
|
modifications to it. For an executable file, complete source code means
|
||||||
|
all the source code for all modules it contains; but, as a special
|
||||||
|
exception, it need not include source code for modules which are standard
|
||||||
|
libraries that accompany the operating system on which the executable
|
||||||
|
file runs, or for standard header files or definitions files that
|
||||||
|
accompany that operating system.
|
||||||
|
|
||||||
|
4. You may not copy, modify, sublicense, distribute or transfer the
|
||||||
|
Program except as expressly provided under this General Public License.
|
||||||
|
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
|
||||||
|
the Program is void, and will automatically terminate your rights to use
|
||||||
|
the Program under this License. However, parties who have received
|
||||||
|
copies, or rights to use copies, from you under this General Public
|
||||||
|
License will not have their licenses terminated so long as such parties
|
||||||
|
remain in full compliance.
|
||||||
|
|
||||||
|
5. By copying, distributing or modifying the Program (or any work based
|
||||||
|
on the Program) you indicate your acceptance of this license to do so,
|
||||||
|
and all its terms and conditions.
|
||||||
|
|
||||||
|
6. Each time you redistribute the Program (or any work based on the
|
||||||
|
Program), the recipient automatically receives a license from the original
|
||||||
|
licensor to copy, distribute or modify the Program subject to these
|
||||||
|
terms and conditions. You may not impose any further restrictions on the
|
||||||
|
recipients' exercise of the rights granted herein.
|
||||||
|
|
||||||
|
7. The Free Software Foundation may publish revised and/or new versions
|
||||||
|
of the General Public License from time to time. Such new versions will
|
||||||
|
be similar in spirit to the present version, but may differ in detail to
|
||||||
|
address new problems or concerns.
|
||||||
|
|
||||||
|
Each version is given a distinguishing version number. If the Program
|
||||||
|
specifies a version number of the license which applies to it and "any
|
||||||
|
later version", you have the option of following the terms and conditions
|
||||||
|
either of that version or of any later version published by the Free
|
||||||
|
Software Foundation. If the Program does not specify a version number of
|
||||||
|
the license, you may choose any version ever published by the Free Software
|
||||||
|
Foundation.
|
||||||
|
|
||||||
|
8. If you wish to incorporate parts of the Program into other free
|
||||||
|
programs whose distribution conditions are different, write to the author
|
||||||
|
to ask for permission. For software which is copyrighted by the Free
|
||||||
|
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||||
|
make exceptions for this. Our decision will be guided by the two goals
|
||||||
|
of preserving the free status of all derivatives of our free software and
|
||||||
|
of promoting the sharing and reuse of software generally.
|
||||||
|
|
||||||
|
NO WARRANTY
|
||||||
|
|
||||||
|
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||||
|
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||||
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||||
|
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||||
|
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||||
|
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||||
|
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||||
|
REPAIR OR CORRECTION.
|
||||||
|
|
||||||
|
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||||
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||||
|
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||||
|
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||||
|
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||||
|
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||||
|
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||||
|
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||||
|
POSSIBILITY OF SUCH DAMAGES.
|
||||||
|
|
||||||
|
END OF TERMS AND CONDITIONS
|
||||||
|
|
||||||
|
Appendix: How to Apply These Terms to Your New Programs
|
||||||
|
|
||||||
|
If you develop a new program, and you want it to be of the greatest
|
||||||
|
possible use to humanity, the best way to achieve this is to make it
|
||||||
|
free software which everyone can redistribute and change under these
|
||||||
|
terms.
|
||||||
|
|
||||||
|
To do so, attach the following notices to the program. It is safest to
|
||||||
|
attach them to the start of each source file to most effectively convey
|
||||||
|
the exclusion of warranty; and each file should have at least the
|
||||||
|
"copyright" line and a pointer to where the full notice is found.
|
||||||
|
|
||||||
|
<one line to give the program's name and a brief idea of what it does.>
|
||||||
|
Copyright (C) 19yy <name of author>
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation; either version 1, or (at your option)
|
||||||
|
any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
|
||||||
|
|
||||||
|
|
||||||
|
Also add information on how to contact you by electronic and paper mail.
|
||||||
|
|
||||||
|
If the program is interactive, make it output a short notice like this
|
||||||
|
when it starts in an interactive mode:
|
||||||
|
|
||||||
|
Gnomovision version 69, Copyright (C) 19xx name of author
|
||||||
|
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||||
|
This is free software, and you are welcome to redistribute it
|
||||||
|
under certain conditions; type `show c' for details.
|
||||||
|
|
||||||
|
The hypothetical commands `show w' and `show c' should show the
|
||||||
|
appropriate parts of the General Public License. Of course, the
|
||||||
|
commands you use may be called something other than `show w' and `show
|
||||||
|
c'; they could even be mouse-clicks or menu items--whatever suits your
|
||||||
|
program.
|
||||||
|
|
||||||
|
You should also get your employer (if you work as a programmer) or your
|
||||||
|
school, if any, to sign a "copyright disclaimer" for the program, if
|
||||||
|
necessary. Here a sample; alter the names:
|
||||||
|
|
||||||
|
Yoyodyne, Inc., hereby disclaims all copyright interest in the
|
||||||
|
program `Gnomovision' (a program to direct compilers to make passes
|
||||||
|
at assemblers) written by James Hacker.
|
||||||
|
|
||||||
|
<signature of Ty Coon>, 1 April 1989
|
||||||
|
Ty Coon, President of Vice
|
||||||
|
|
||||||
|
That's all there is to it!
|
||||||
|
|
||||||
|
|
||||||
|
--- The Artistic License 1.0 ---
|
||||||
|
|
||||||
|
This software is Copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software, licensed under:
|
||||||
|
|
||||||
|
The Artistic License 1.0
|
||||||
|
|
||||||
|
The Artistic License
|
||||||
|
|
||||||
|
Preamble
|
||||||
|
|
||||||
|
The intent of this document is to state the conditions under which a Package
|
||||||
|
may be copied, such that the Copyright Holder maintains some semblance of
|
||||||
|
artistic control over the development of the package, while giving the users of
|
||||||
|
the package the right to use and distribute the Package in a more-or-less
|
||||||
|
customary fashion, plus the right to make reasonable modifications.
|
||||||
|
|
||||||
|
Definitions:
|
||||||
|
|
||||||
|
- "Package" refers to the collection of files distributed by the Copyright
|
||||||
|
Holder, and derivatives of that collection of files created through
|
||||||
|
textual modification.
|
||||||
|
- "Standard Version" refers to such a Package if it has not been modified,
|
||||||
|
or has been modified in accordance with the wishes of the Copyright
|
||||||
|
Holder.
|
||||||
|
- "Copyright Holder" is whoever is named in the copyright or copyrights for
|
||||||
|
the package.
|
||||||
|
- "You" is you, if you're thinking about copying or distributing this Package.
|
||||||
|
- "Reasonable copying fee" is whatever you can justify on the basis of media
|
||||||
|
cost, duplication charges, time of people involved, and so on. (You will
|
||||||
|
not be required to justify it to the Copyright Holder, but only to the
|
||||||
|
computing community at large as a market that must bear the fee.)
|
||||||
|
- "Freely Available" means that no fee is charged for the item itself, though
|
||||||
|
there may be fees involved in handling the item. It also means that
|
||||||
|
recipients of the item may redistribute it under the same conditions they
|
||||||
|
received it.
|
||||||
|
|
||||||
|
1. You may make and give away verbatim copies of the source form of the
|
||||||
|
Standard Version of this Package without restriction, provided that you
|
||||||
|
duplicate all of the original copyright notices and associated disclaimers.
|
||||||
|
|
||||||
|
2. You may apply bug fixes, portability fixes and other modifications derived
|
||||||
|
from the Public Domain or from the Copyright Holder. A Package modified in such
|
||||||
|
a way shall still be considered the Standard Version.
|
||||||
|
|
||||||
|
3. You may otherwise modify your copy of this Package in any way, provided that
|
||||||
|
you insert a prominent notice in each changed file stating how and when you
|
||||||
|
changed that file, and provided that you do at least ONE of the following:
|
||||||
|
|
||||||
|
a) place your modifications in the Public Domain or otherwise make them
|
||||||
|
Freely Available, such as by posting said modifications to Usenet or an
|
||||||
|
equivalent medium, or placing the modifications on a major archive site
|
||||||
|
such as ftp.uu.net, or by allowing the Copyright Holder to include your
|
||||||
|
modifications in the Standard Version of the Package.
|
||||||
|
|
||||||
|
b) use the modified Package only within your corporation or organization.
|
||||||
|
|
||||||
|
c) rename any non-standard executables so the names do not conflict with
|
||||||
|
standard executables, which must also be provided, and provide a separate
|
||||||
|
manual page for each non-standard executable that clearly documents how it
|
||||||
|
differs from the Standard Version.
|
||||||
|
|
||||||
|
d) make other distribution arrangements with the Copyright Holder.
|
||||||
|
|
||||||
|
4. You may distribute the programs of this Package in object code or executable
|
||||||
|
form, provided that you do at least ONE of the following:
|
||||||
|
|
||||||
|
a) distribute a Standard Version of the executables and library files,
|
||||||
|
together with instructions (in the manual page or equivalent) on where to
|
||||||
|
get the Standard Version.
|
||||||
|
|
||||||
|
b) accompany the distribution with the machine-readable source of the Package
|
||||||
|
with your modifications.
|
||||||
|
|
||||||
|
c) accompany any non-standard executables with their corresponding Standard
|
||||||
|
Version executables, giving the non-standard executables non-standard
|
||||||
|
names, and clearly documenting the differences in manual pages (or
|
||||||
|
equivalent), together with instructions on where to get the Standard
|
||||||
|
Version.
|
||||||
|
|
||||||
|
d) make other distribution arrangements with the Copyright Holder.
|
||||||
|
|
||||||
|
5. You may charge a reasonable copying fee for any distribution of this
|
||||||
|
Package. You may charge any fee you choose for support of this Package. You
|
||||||
|
may not charge a fee for this Package itself. However, you may distribute this
|
||||||
|
Package in aggregate with other (possibly commercial) programs as part of a
|
||||||
|
larger (possibly commercial) software distribution provided that you do not
|
||||||
|
advertise this Package as a product of your own.
|
||||||
|
|
||||||
|
6. The scripts and library files supplied as input to or produced as output
|
||||||
|
from the programs of this Package do not automatically fall under the copyright
|
||||||
|
of this Package, but belong to whomever generated them, and may be sold
|
||||||
|
commercially, and may be aggregated with this Package.
|
||||||
|
|
||||||
|
7. C or perl subroutines supplied by you and linked into this Package shall not
|
||||||
|
be considered part of this Package.
|
||||||
|
|
||||||
|
8. The name of the Copyright Holder may not be used to endorse or promote
|
||||||
|
products derived from this software without specific prior written permission.
|
||||||
|
|
||||||
|
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||||
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
The End
|
||||||
|
|
18
MANIFEST
Normal file
18
MANIFEST
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.009.
|
||||||
|
Changes
|
||||||
|
LICENSE
|
||||||
|
MANIFEST
|
||||||
|
META.json
|
||||||
|
META.yml
|
||||||
|
Makefile.PL
|
||||||
|
README
|
||||||
|
README.md
|
||||||
|
lib/Data/DTO/GELF.pm
|
||||||
|
lib/Data/DTO/GELF/Types.pm
|
||||||
|
lib/Log/Log4perl/Appender/Graylog.pm
|
||||||
|
scripts/log.pl
|
||||||
|
t/00_compile.t
|
||||||
|
t/01-log-plain.t
|
||||||
|
t/02-log-gzip.t
|
||||||
|
t/DTO/00-compile.t
|
||||||
|
t/DTO/01-instance.t
|
75
META.json
Normal file
75
META.json
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
{
|
||||||
|
"abstract" : "Log dispatcher writing to udp Graylog server",
|
||||||
|
"author" : [
|
||||||
|
"Brandon \"Dimentox Travanti\" Husbands <xotmid@gmail.com>"
|
||||||
|
],
|
||||||
|
"dynamic_config" : 0,
|
||||||
|
"generated_by" : "Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150010",
|
||||||
|
"license" : [
|
||||||
|
"perl_5"
|
||||||
|
],
|
||||||
|
"meta-spec" : {
|
||||||
|
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
|
||||||
|
"version" : 2
|
||||||
|
},
|
||||||
|
"name" : "Log-Log4perl-Appender-Graylog",
|
||||||
|
"prereqs" : {
|
||||||
|
"configure" : {
|
||||||
|
"requires" : {
|
||||||
|
"ExtUtils::MakeMaker" : "0"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"runtime" : {
|
||||||
|
"requires" : {
|
||||||
|
"Carp" : "0",
|
||||||
|
"Data::UUID" : "0",
|
||||||
|
"Devel::StackTrace" : "0",
|
||||||
|
"IO::Compress::Gzip" : "0",
|
||||||
|
"IO::Socket" : "0",
|
||||||
|
"IO::Socket::INET" : "0",
|
||||||
|
"JSON::Tiny" : "0",
|
||||||
|
"Log::GELF::Util" : "0",
|
||||||
|
"Log::Log4perl" : "0",
|
||||||
|
"Moose" : "0",
|
||||||
|
"MooseX::Types" : "0",
|
||||||
|
"MooseX::Types::Moose" : "0",
|
||||||
|
"POSIX" : "0",
|
||||||
|
"Readonly" : "0",
|
||||||
|
"Sys::Hostname" : "0",
|
||||||
|
"namespace::autoclean" : "0",
|
||||||
|
"perl" : "v5.16.3",
|
||||||
|
"strict" : "0",
|
||||||
|
"warnings" : "0"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"test" : {
|
||||||
|
"requires" : {
|
||||||
|
"Data::Faker" : "0",
|
||||||
|
"Data::Printer" : "0",
|
||||||
|
"Data::Random::String" : "0",
|
||||||
|
"IO::Uncompress::Gunzip" : "0",
|
||||||
|
"JSON" : "0",
|
||||||
|
"Log::Log4perl::Layout::NoopLayout" : "0",
|
||||||
|
"Test::MockModule" : "0",
|
||||||
|
"Test::Moose::More" : "0",
|
||||||
|
"Test::More" : "0.98",
|
||||||
|
"Test::Most" : "0"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"release_status" : "stable",
|
||||||
|
"resources" : {
|
||||||
|
"bugtracker" : {
|
||||||
|
"web" : "https://github.com/dimentox/log-log4perl-appender-graylog/issues"
|
||||||
|
},
|
||||||
|
"homepage" : "https://metacpan.org/release/Log-Log4perl-Appender-Graylog",
|
||||||
|
"repository" : {
|
||||||
|
"type" : "git",
|
||||||
|
"url" : "git://github.com/dimentox/log-log4perl-appender-graylog.git",
|
||||||
|
"web" : "https://github.com/dimentox/log-log4perl-appender-graylog"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"version" : "1.7",
|
||||||
|
"x_serialization_backend" : "Cpanel::JSON::XS version 3.0233"
|
||||||
|
}
|
||||||
|
|
50
META.yml
Normal file
50
META.yml
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
---
|
||||||
|
abstract: 'Log dispatcher writing to udp Graylog server'
|
||||||
|
author:
|
||||||
|
- 'Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>'
|
||||||
|
build_requires:
|
||||||
|
Data::Faker: '0'
|
||||||
|
Data::Printer: '0'
|
||||||
|
Data::Random::String: '0'
|
||||||
|
IO::Uncompress::Gunzip: '0'
|
||||||
|
JSON: '0'
|
||||||
|
Log::Log4perl::Layout::NoopLayout: '0'
|
||||||
|
Test::MockModule: '0'
|
||||||
|
Test::Moose::More: '0'
|
||||||
|
Test::More: '0.98'
|
||||||
|
Test::Most: '0'
|
||||||
|
configure_requires:
|
||||||
|
ExtUtils::MakeMaker: '0'
|
||||||
|
dynamic_config: 0
|
||||||
|
generated_by: 'Dist::Zilla version 6.009, CPAN::Meta::Converter version 2.150010'
|
||||||
|
license: perl
|
||||||
|
meta-spec:
|
||||||
|
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||||
|
version: '1.4'
|
||||||
|
name: Log-Log4perl-Appender-Graylog
|
||||||
|
requires:
|
||||||
|
Carp: '0'
|
||||||
|
Data::UUID: '0'
|
||||||
|
Devel::StackTrace: '0'
|
||||||
|
IO::Compress::Gzip: '0'
|
||||||
|
IO::Socket: '0'
|
||||||
|
IO::Socket::INET: '0'
|
||||||
|
JSON::Tiny: '0'
|
||||||
|
Log::GELF::Util: '0'
|
||||||
|
Log::Log4perl: '0'
|
||||||
|
Moose: '0'
|
||||||
|
MooseX::Types: '0'
|
||||||
|
MooseX::Types::Moose: '0'
|
||||||
|
POSIX: '0'
|
||||||
|
Readonly: '0'
|
||||||
|
Sys::Hostname: '0'
|
||||||
|
namespace::autoclean: '0'
|
||||||
|
perl: v5.16.3
|
||||||
|
strict: '0'
|
||||||
|
warnings: '0'
|
||||||
|
resources:
|
||||||
|
bugtracker: https://github.com/dimentox/log-log4perl-appender-graylog/issues
|
||||||
|
homepage: https://metacpan.org/release/Log-Log4perl-Appender-Graylog
|
||||||
|
repository: git://github.com/dimentox/log-log4perl-appender-graylog.git
|
||||||
|
version: '1.7'
|
||||||
|
x_serialization_backend: 'YAML::Tiny version 1.70'
|
99
Makefile.PL
Normal file
99
Makefile.PL
Normal file
@ -0,0 +1,99 @@
|
|||||||
|
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.009.
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use 5.016003;
|
||||||
|
|
||||||
|
use ExtUtils::MakeMaker;
|
||||||
|
|
||||||
|
my %WriteMakefileArgs = (
|
||||||
|
"ABSTRACT" => "Log dispatcher writing to udp Graylog server",
|
||||||
|
"AUTHOR" => "Brandon \"Dimentox Travanti\" Husbands <xotmid\@gmail.com>",
|
||||||
|
"CONFIGURE_REQUIRES" => {
|
||||||
|
"ExtUtils::MakeMaker" => 0
|
||||||
|
},
|
||||||
|
"DISTNAME" => "Log-Log4perl-Appender-Graylog",
|
||||||
|
"LICENSE" => "perl",
|
||||||
|
"MIN_PERL_VERSION" => "5.016003",
|
||||||
|
"NAME" => "Log::Log4perl::Appender::Graylog",
|
||||||
|
"PREREQ_PM" => {
|
||||||
|
"Carp" => 0,
|
||||||
|
"Data::UUID" => 0,
|
||||||
|
"Devel::StackTrace" => 0,
|
||||||
|
"IO::Compress::Gzip" => 0,
|
||||||
|
"IO::Socket" => 0,
|
||||||
|
"IO::Socket::INET" => 0,
|
||||||
|
"JSON::Tiny" => 0,
|
||||||
|
"Log::GELF::Util" => 0,
|
||||||
|
"Log::Log4perl" => 0,
|
||||||
|
"Moose" => 0,
|
||||||
|
"MooseX::Types" => 0,
|
||||||
|
"MooseX::Types::Moose" => 0,
|
||||||
|
"POSIX" => 0,
|
||||||
|
"Readonly" => 0,
|
||||||
|
"Sys::Hostname" => 0,
|
||||||
|
"namespace::autoclean" => 0,
|
||||||
|
"strict" => 0,
|
||||||
|
"warnings" => 0
|
||||||
|
},
|
||||||
|
"TEST_REQUIRES" => {
|
||||||
|
"Data::Faker" => 0,
|
||||||
|
"Data::Printer" => 0,
|
||||||
|
"Data::Random::String" => 0,
|
||||||
|
"IO::Uncompress::Gunzip" => 0,
|
||||||
|
"JSON" => 0,
|
||||||
|
"Log::Log4perl::Layout::NoopLayout" => 0,
|
||||||
|
"Test::MockModule" => 0,
|
||||||
|
"Test::Moose::More" => 0,
|
||||||
|
"Test::More" => "0.98",
|
||||||
|
"Test::Most" => 0
|
||||||
|
},
|
||||||
|
"VERSION" => "1.7",
|
||||||
|
"test" => {
|
||||||
|
"TESTS" => "t/*.t t/DTO/*.t"
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
|
my %FallbackPrereqs = (
|
||||||
|
"Carp" => 0,
|
||||||
|
"Data::Faker" => 0,
|
||||||
|
"Data::Printer" => 0,
|
||||||
|
"Data::Random::String" => 0,
|
||||||
|
"Data::UUID" => 0,
|
||||||
|
"Devel::StackTrace" => 0,
|
||||||
|
"IO::Compress::Gzip" => 0,
|
||||||
|
"IO::Socket" => 0,
|
||||||
|
"IO::Socket::INET" => 0,
|
||||||
|
"IO::Uncompress::Gunzip" => 0,
|
||||||
|
"JSON" => 0,
|
||||||
|
"JSON::Tiny" => 0,
|
||||||
|
"Log::GELF::Util" => 0,
|
||||||
|
"Log::Log4perl" => 0,
|
||||||
|
"Log::Log4perl::Layout::NoopLayout" => 0,
|
||||||
|
"Moose" => 0,
|
||||||
|
"MooseX::Types" => 0,
|
||||||
|
"MooseX::Types::Moose" => 0,
|
||||||
|
"POSIX" => 0,
|
||||||
|
"Readonly" => 0,
|
||||||
|
"Sys::Hostname" => 0,
|
||||||
|
"Test::MockModule" => 0,
|
||||||
|
"Test::Moose::More" => 0,
|
||||||
|
"Test::More" => "0.98",
|
||||||
|
"Test::Most" => 0,
|
||||||
|
"namespace::autoclean" => 0,
|
||||||
|
"strict" => 0,
|
||||||
|
"warnings" => 0
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
|
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
|
||||||
|
delete $WriteMakefileArgs{TEST_REQUIRES};
|
||||||
|
delete $WriteMakefileArgs{BUILD_REQUIRES};
|
||||||
|
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
|
||||||
|
}
|
||||||
|
|
||||||
|
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
|
||||||
|
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
|
||||||
|
|
||||||
|
WriteMakefile(%WriteMakefileArgs);
|
15
README
Normal file
15
README
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
|
||||||
|
|
||||||
|
This archive contains the distribution Log-Log4perl-Appender-Graylog,
|
||||||
|
version 1.7:
|
||||||
|
|
||||||
|
Log dispatcher writing to udp Graylog server
|
||||||
|
|
||||||
|
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as the Perl 5 programming language system itself.
|
||||||
|
|
||||||
|
|
||||||
|
This README file was generated by Dist::Zilla::Plugin::Readme v6.009.
|
||||||
|
|
97
README.md
Normal file
97
README.md
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
# NAME
|
||||||
|
|
||||||
|
Log::Log4perl::Appender::Graylog; - Log to a Graylog server
|
||||||
|
|
||||||
|
# SYNOPSIS
|
||||||
|
|
||||||
|
use Log::Log4perl::Appender::Graylog;
|
||||||
|
|
||||||
|
my $appender = Log::Log4perl::Appender::Graylog->new(
|
||||||
|
PeerAddr => "glog.foo.com",
|
||||||
|
PeerPort => 12209,
|
||||||
|
Gzip => 1, # Glog2 usually requires gzip but can send plain text
|
||||||
|
);
|
||||||
|
|
||||||
|
$appender->log(message => "Log me\n");
|
||||||
|
|
||||||
|
or
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12201
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
|
||||||
|
|
||||||
|
# DESCRIPTION
|
||||||
|
|
||||||
|
This is a simple appender for writing to a graylog server.
|
||||||
|
|
||||||
|
It relies on L<IO::Socket::INET>. L<Log::GELF::Util>. This sends in the 1.1
|
||||||
|
format.
|
||||||
|
|
||||||
|
# CONFIG
|
||||||
|
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12201
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
log4perl.appender.SERVER.Chunked = <0|lan|wan>
|
||||||
|
|
||||||
|
layout This needs to be NoopLayout as we do not want any special formatting.
|
||||||
|
Gzip Accepts an integer specifying if to compress the message.
|
||||||
|
Chunked Accepts an integer specifying the chunk size or the special string values lan or wan corresponding to 8154 or 1420 respectively.
|
||||||
|
|
||||||
|
|
||||||
|
# EXAMPLE
|
||||||
|
|
||||||
|
Write a server quickly using the IO::Socket:
|
||||||
|
(based on orelly-perl-cookbook-ch17)
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use IO::Socket;
|
||||||
|
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
|
||||||
|
$MAXLEN = 8192;
|
||||||
|
$PORTNO = 12201;
|
||||||
|
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp')
|
||||||
|
or die "socket: $@";
|
||||||
|
print "Awaiting UDP messages on port $PORTNO\n";
|
||||||
|
$oldmsg = "This is the starting message.";
|
||||||
|
while ($sock->recv($newmsg, $MAXLEN)) {
|
||||||
|
my($port, $ipaddr) = sockaddr_in($sock->peername);
|
||||||
|
$hishost = gethostbyaddr($ipaddr, AF_INET);
|
||||||
|
print "Client $hishost said ``$newmsg''\n";
|
||||||
|
$sock->send($oldmsg);
|
||||||
|
$oldmsg = "[$hishost] $newmsg";
|
||||||
|
}
|
||||||
|
die "recv: $!";
|
||||||
|
|
||||||
|
|
||||||
|
Start it and then run the following script as a client:
|
||||||
|
|
||||||
|
use Log::Log4perl qw(:easy);
|
||||||
|
my $conf = q{
|
||||||
|
log4perl.category = WARN, Graylog
|
||||||
|
log4perl.appender.Graylog = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.Graylog.PeerAddr = localhost
|
||||||
|
log4perl.appender.Graylog.PeerPort = 12201
|
||||||
|
log4perl.appender.Graylog.layout = SimpleLayout
|
||||||
|
|
||||||
|
};
|
||||||
|
|
||||||
|
Log::Log4perl->init( \$conf );
|
||||||
|
|
||||||
|
sleep(2);
|
||||||
|
|
||||||
|
for ( 1 .. 10 ) {
|
||||||
|
ERROR("Quack!");
|
||||||
|
sleep(5);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
Copyright 2017 by Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or modify
|
||||||
|
it under the same terms as Perl itself.
|
172
lib/Data/DTO/GELF.pm
Normal file
172
lib/Data/DTO/GELF.pm
Normal file
@ -0,0 +1,172 @@
|
|||||||
|
package Data::DTO::GELF;
|
||||||
|
|
||||||
|
# ABSTRACT: The DTO object for GELF version 1.1
|
||||||
|
our $VERSION = '1.7'; # VERSION 1.7
|
||||||
|
our $VERSION = 1.7;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Moose;
|
||||||
|
use namespace::autoclean;
|
||||||
|
|
||||||
|
use JSON::Tiny qw(encode_json);
|
||||||
|
use Sys::Hostname;
|
||||||
|
use Data::UUID;
|
||||||
|
use POSIX qw(strftime);
|
||||||
|
|
||||||
|
use Log::Log4perl;
|
||||||
|
|
||||||
|
use Data::DTO::GELF::Types qw( LogLevel );
|
||||||
|
use Devel::StackTrace;
|
||||||
|
|
||||||
|
our $GELF_VERSION = 1.1;
|
||||||
|
|
||||||
|
has 'version' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Str',
|
||||||
|
builder => '_build_version',
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'host' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Str',
|
||||||
|
builder => '_build_host',
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'short_message' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Str',
|
||||||
|
lazy => 1,
|
||||||
|
builder => '_long_to_short'
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'full_message' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Str',
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'timestamp' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Int',
|
||||||
|
builder => '_build_timestamp',
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'level' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => LogLevel,
|
||||||
|
coerce => 1,
|
||||||
|
);
|
||||||
|
has '_facility' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Str',
|
||||||
|
);
|
||||||
|
|
||||||
|
has '_line' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Int',
|
||||||
|
);
|
||||||
|
|
||||||
|
has '_file' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Str',
|
||||||
|
);
|
||||||
|
|
||||||
|
sub BUILD {
|
||||||
|
my $self = shift;
|
||||||
|
my $args = shift;
|
||||||
|
foreach my $key1 ( keys %{$args} ) {
|
||||||
|
if ( ( substr $key1, 0, 1 ) eq "_" ) {
|
||||||
|
$self->meta->add_attribute( "$key1" => ( accessor => $key1 ) );
|
||||||
|
$self->meta->get_attribute($key1)
|
||||||
|
->set_value( $self, $args->{$key1} );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $trace = Devel::StackTrace->new;
|
||||||
|
foreach my $frame ( $trace->frames ) {
|
||||||
|
if ( $frame->{subroutine} eq "Log::Log4perl::Logger::__ANON__" ) {
|
||||||
|
$self->_line( $frame->{line} );
|
||||||
|
$self->_file( $frame->{filename} );
|
||||||
|
$self->_facility( $frame->{package} );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _build_version {
|
||||||
|
my $self = shift;
|
||||||
|
return "$GELF_VERSION";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _build_host {
|
||||||
|
my $self = shift;
|
||||||
|
return hostname();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _build_timestamp {
|
||||||
|
my $self = shift;
|
||||||
|
return time();
|
||||||
|
}
|
||||||
|
|
||||||
|
sub message {
|
||||||
|
my $self = shift;
|
||||||
|
my $m = shift;
|
||||||
|
if ( defined $m ) {
|
||||||
|
$self->full_message($m);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return $self->full_message();
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _long_to_short {
|
||||||
|
my $self = shift;
|
||||||
|
my $msg = $self->full_message();
|
||||||
|
$msg =~ s/\n//sg;
|
||||||
|
$msg =~ s/\s\s//sg;
|
||||||
|
$msg = substr $msg, 0, 100;
|
||||||
|
return $msg;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub TO_HASH {
|
||||||
|
my $self = shift;
|
||||||
|
{ $self->short_message() } #fire off lazy message builder
|
||||||
|
return {%$self};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub TO_JSON {
|
||||||
|
my $self = shift;
|
||||||
|
{ $self->short_message() } #fire off lazy message builder
|
||||||
|
return {%$self};
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=pod
|
||||||
|
|
||||||
|
=encoding UTF-8
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Data::DTO::GELF - The DTO object for GELF version 1.1
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
version 1.7
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as the Perl 5 programming language system itself.
|
||||||
|
|
||||||
|
=cut
|
58
lib/Data/DTO/GELF/Types.pm
Normal file
58
lib/Data/DTO/GELF/Types.pm
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
package Data::DTO::GELF::Types;
|
||||||
|
|
||||||
|
# ABSTRACT: Special types for log level conversion
|
||||||
|
our $VERSION = '1.7'; # VERSION 1.7
|
||||||
|
our $VERSION=1.7;
|
||||||
|
use MooseX::Types -declare => [
|
||||||
|
qw(
|
||||||
|
LogLevel
|
||||||
|
|
||||||
|
)
|
||||||
|
];
|
||||||
|
|
||||||
|
use MooseX::Types::Moose qw/Int Str/;
|
||||||
|
|
||||||
|
use Readonly;
|
||||||
|
Readonly my %LOGLEVEL_MAP => (
|
||||||
|
DEBUG => 0,
|
||||||
|
INFO => 1,
|
||||||
|
NOTICE => 2,
|
||||||
|
WARNING => 3,
|
||||||
|
ERROR => 4,
|
||||||
|
CRITICAL => 5,
|
||||||
|
ALERT => 6,
|
||||||
|
EMERGENCY => 8
|
||||||
|
);
|
||||||
|
|
||||||
|
subtype LogLevel, as Int;
|
||||||
|
|
||||||
|
coerce LogLevel, from Str, via { $LOGLEVEL_MAP{ uc $_ } // $_; };
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=pod
|
||||||
|
|
||||||
|
=encoding UTF-8
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Data::DTO::GELF::Types - Special types for log level conversion
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
version 1.7
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as the Perl 5 programming language system itself.
|
||||||
|
|
||||||
|
=cut
|
212
lib/Log/Log4perl/Appender/Graylog.pm
Normal file
212
lib/Log/Log4perl/Appender/Graylog.pm
Normal file
@ -0,0 +1,212 @@
|
|||||||
|
package Log::Log4perl::Appender::Graylog;
|
||||||
|
|
||||||
|
# ABSTRACT: Log dispatcher writing to udp Graylog server
|
||||||
|
our $VERSION = '1.7'; # VERSION 1.7
|
||||||
|
my $VERSION = 1.7;
|
||||||
|
our @ISA = qw(Log::Log4perl::Appender);
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Sys::Hostname;
|
||||||
|
use Data::UUID;
|
||||||
|
use POSIX qw(strftime);
|
||||||
|
use IO::Compress::Gzip qw( gzip $GzipError );
|
||||||
|
use IO::Socket;
|
||||||
|
use Data::DTO::GELF;
|
||||||
|
use Carp;
|
||||||
|
use Log::GELF::Util qw(
|
||||||
|
:all
|
||||||
|
);
|
||||||
|
|
||||||
|
##################################################
|
||||||
|
# Log dispatcher writing to udp Graylog server
|
||||||
|
##################################################
|
||||||
|
# cmd line example echo -n '{ "version": "1.1", "host": "example.org", "short_message": "A short message", "level": 5, "_some_info": "foo" }' | nc -w0 -u graylog.xo.gy 12201
|
||||||
|
##################################################
|
||||||
|
sub new {
|
||||||
|
##################################################
|
||||||
|
my $proto = shift;
|
||||||
|
my $class = ref $proto || $proto;
|
||||||
|
my %params = @_;
|
||||||
|
|
||||||
|
my $self = {
|
||||||
|
name => "unknown name",
|
||||||
|
PeerAddr => "",
|
||||||
|
PeerPort => "",
|
||||||
|
Proto => "udp",
|
||||||
|
Gzip => 1,
|
||||||
|
Chunked => 0,
|
||||||
|
%params,
|
||||||
|
|
||||||
|
};
|
||||||
|
bless $self, $class;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _create_socket {
|
||||||
|
my ( $self, $socket_opts ) = @_;
|
||||||
|
|
||||||
|
require IO::Socket::INET;
|
||||||
|
my $socket = IO::Socket::INET->new(
|
||||||
|
PeerAddr => $socket_opts->{host},
|
||||||
|
PeerPort => $socket_opts->{port},
|
||||||
|
Proto => $socket_opts->{protocol},
|
||||||
|
) or die "Cannot create socket: $!";
|
||||||
|
|
||||||
|
return $socket;
|
||||||
|
}
|
||||||
|
##################################################
|
||||||
|
sub log {
|
||||||
|
##################################################
|
||||||
|
my $self = shift;
|
||||||
|
my %params = @_;
|
||||||
|
|
||||||
|
my $packet = Data::DTO::GELF->new(
|
||||||
|
'full_message' => $params{'message'},
|
||||||
|
'level' => $params{level},
|
||||||
|
'host' => $params{server} || $params{host} || hostname(),
|
||||||
|
'_uuid' => Data::UUID->new()->create_str(),
|
||||||
|
'_name' => $params{name},
|
||||||
|
'_category' => $params{log4p_category},
|
||||||
|
"_pid" => $$,
|
||||||
|
|
||||||
|
);
|
||||||
|
|
||||||
|
my $msg = validate_message( $packet->TO_HASH() );
|
||||||
|
my $chunked = parse_size( $self->{Chunked} );
|
||||||
|
$msg = encode($msg);
|
||||||
|
$msg = compress($msg) if $self->{'Gzip'};
|
||||||
|
my $socket = $self->_create_socket(
|
||||||
|
{ 'host' => $self->{'PeerAddr'},
|
||||||
|
'port' => $self->{'PeerPort'},
|
||||||
|
'protocol' => $self->{'Proto'}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
$socket->send($_) foreach enchunk( $msg, $chunked );
|
||||||
|
$socket->close();
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=pod
|
||||||
|
|
||||||
|
=encoding UTF-8
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Log::Log4perl::Appender::Graylog - Log dispatcher writing to udp Graylog server
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
version 1.7
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use Log::Log4perl::Appender::Graylog;
|
||||||
|
|
||||||
|
my $appender = Log::Log4perl::Appender::Graylog->new(
|
||||||
|
PeerAddr => "glog.foo.com",
|
||||||
|
PeerPort => 12209,
|
||||||
|
Gzip => 1, # Glog2 usually requires gzip but can send plain text
|
||||||
|
);
|
||||||
|
|
||||||
|
$appender->log(message => "Log me\n");
|
||||||
|
|
||||||
|
or
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12201
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This is a simple appender for writing to a graylog server.
|
||||||
|
|
||||||
|
It relies on L<IO::Socket::INET>. L<Log::GELF::Util>. This sends in the 1.1
|
||||||
|
format.
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Log::Log4perl::Appender::Graylog; - Log to a Graylog server
|
||||||
|
|
||||||
|
=head1 CONFIG
|
||||||
|
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12201
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
log4perl.appender.SERVER.Chunked = <0|lan|wan>
|
||||||
|
|
||||||
|
layout This needs to be NoopLayout as we do not want any special formatting.
|
||||||
|
Gzip Accepts an integer specifying if to compress the message.
|
||||||
|
Chunked Accepts an integer specifying the chunk size or the special string values lan or wan corresponding to 8154 or 1420 respectively.
|
||||||
|
|
||||||
|
=head1 EXAMPLE
|
||||||
|
|
||||||
|
Write a server quickly using the IO::Socket:
|
||||||
|
(based on orelly-perl-cookbook-ch17)
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use IO::Socket;
|
||||||
|
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
|
||||||
|
$MAXLEN = 8192;
|
||||||
|
$PORTNO = 12201;
|
||||||
|
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp')
|
||||||
|
or die "socket: $@";
|
||||||
|
print "Awaiting UDP messages on port $PORTNO\n";
|
||||||
|
$oldmsg = "This is the starting message.";
|
||||||
|
while ($sock->recv($newmsg, $MAXLEN)) {
|
||||||
|
my($port, $ipaddr) = sockaddr_in($sock->peername);
|
||||||
|
$hishost = gethostbyaddr($ipaddr, AF_INET);
|
||||||
|
print "Client $hishost said ``$newmsg''\n";
|
||||||
|
$sock->send($oldmsg);
|
||||||
|
$oldmsg = "[$hishost] $newmsg";
|
||||||
|
}
|
||||||
|
die "recv: $!";
|
||||||
|
|
||||||
|
Start it and then run the following script as a client:
|
||||||
|
|
||||||
|
use Log::Log4perl qw(:easy);
|
||||||
|
my $conf = q{
|
||||||
|
log4perl.category = WARN, Graylog
|
||||||
|
log4perl.appender.Graylog = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.Graylog.PeerAddr = localhost
|
||||||
|
log4perl.appender.Graylog.PeerPort = 12201
|
||||||
|
log4perl.appender.Graylog.layout = SimpleLayout
|
||||||
|
|
||||||
|
};
|
||||||
|
|
||||||
|
Log::Log4perl->init( \$conf );
|
||||||
|
|
||||||
|
sleep(2);
|
||||||
|
|
||||||
|
for ( 1 .. 10 ) {
|
||||||
|
ERROR("Quack!");
|
||||||
|
sleep(5);
|
||||||
|
}
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
Copyright 2017 by Brandon "Dimentox Travanti" Husbands E<lt>xotmid@gmail.comE<gt>
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or modify
|
||||||
|
it under the same terms as Perl itself.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||||
|
|
||||||
|
This is free software; you can redistribute it and/or modify it under
|
||||||
|
the same terms as the Perl 5 programming language system itself.
|
||||||
|
|
||||||
|
=cut
|
71
scripts/log.pl
Normal file
71
scripts/log.pl
Normal file
@ -0,0 +1,71 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
# run with $ GLOG="yourglogserver" perl scripts/log.pl
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Curses::UI;
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
use JSON::Tiny qw(encode_json);
|
||||||
|
use Data::Faker;
|
||||||
|
|
||||||
|
use Log::Log4perl;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
use Log::Log4perl::DataDumper;
|
||||||
|
use Log::Log4perl::Appender::ScreenColoredLevels;
|
||||||
|
use Log::Log4perl::Appender::Graylog;
|
||||||
|
|
||||||
|
use Log::Log4perl::Layout::PatternLayout;
|
||||||
|
use Log::Log4perl::Layout::SimpleLayout;
|
||||||
|
use Log::Log4perl::Layout::NoopLayout;
|
||||||
|
my $config = <<"END";
|
||||||
|
log4perl.logger = DEBUG, SERVER, Screen
|
||||||
|
log4perl.appender.Screen = Log::Log4perl::Appender::ScreenColoredLevels
|
||||||
|
log4perl.appender.Screen.color.DEBUG=bold blue
|
||||||
|
log4perl.appender.Screen.stderr = 1
|
||||||
|
log4perl.appender.Screen.stdout = 0
|
||||||
|
log4perl.appender.Screen.layout = Log::Log4perl::Layout::PatternLayout
|
||||||
|
log4perl.appender.Screen.layout.ConversionPattern = [%d] [%-5p] [%c %X{IP}] %m%n
|
||||||
|
log4perl.appender.Screen.utf8 = 1
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = $ENV{'GLOG'}
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12201
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
log4perl.appender.SERVER.Chunked = wan
|
||||||
|
END
|
||||||
|
|
||||||
|
Log::Log4perl->reset();
|
||||||
|
Log::Log4perl->init_once(\$config);
|
||||||
|
|
||||||
|
my $log = Log::Log4perl->get_logger("meh");
|
||||||
|
Log::Log4perl::DataDumper::override( $log, 0);
|
||||||
|
my $faker = Data::Faker->new();
|
||||||
|
use List::Util 'shuffle';
|
||||||
|
my @methods = $faker->methods;
|
||||||
|
while(1)
|
||||||
|
{
|
||||||
|
|
||||||
|
|
||||||
|
my %data;
|
||||||
|
|
||||||
|
@methods = shuffle @methods;
|
||||||
|
|
||||||
|
|
||||||
|
for (@methods)
|
||||||
|
{
|
||||||
|
$data{$_} = $faker->$_();
|
||||||
|
}
|
||||||
|
|
||||||
|
my $l = {};
|
||||||
|
$l->{'json'} = encode_json(\%data);
|
||||||
|
$l->{'dumper'} = Dumper(%data);
|
||||||
|
$l->{raw} = \%data;
|
||||||
|
$log->debug($l);
|
||||||
|
sleep(2);
|
||||||
|
$log->info($faker->name);
|
||||||
|
sleep(2);
|
||||||
|
}
|
||||||
|
|
9
t/00_compile.t
Normal file
9
t/00_compile.t
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
use strict;
|
||||||
|
use Test::More 0.98;
|
||||||
|
|
||||||
|
use_ok $_ for qw(
|
||||||
|
Log::Log4perl::Appender::Graylog
|
||||||
|
);
|
||||||
|
|
||||||
|
done_testing;
|
||||||
|
|
95
t/01-log-plain.t
Normal file
95
t/01-log-plain.t
Normal file
@ -0,0 +1,95 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use JSON -convert_blessed_universally;
|
||||||
|
use Test::Most;
|
||||||
|
use Test::MockModule;
|
||||||
|
use Data::Faker;
|
||||||
|
use Data::Printer
|
||||||
|
output => 'stderr',
|
||||||
|
colored => 1,
|
||||||
|
deparse => 1,
|
||||||
|
caller_info => 1,
|
||||||
|
show_readonly => 1,
|
||||||
|
show_lvalue => 1,
|
||||||
|
max_depth => 5,
|
||||||
|
caller_info => 1,
|
||||||
|
class => { inherited => 'all', expand => 5 };
|
||||||
|
|
||||||
|
my $log;
|
||||||
|
|
||||||
|
subtest "Init Logger plain" => sub {
|
||||||
|
lives_ok {
|
||||||
|
use Log::Log4perl;
|
||||||
|
Log::Log4perl->reset();
|
||||||
|
use Log::Log4perl::Appender::Graylog;
|
||||||
|
use Log::Log4perl::Layout::NoopLayout;
|
||||||
|
my $config = <<'END';
|
||||||
|
log4perl.logger = DEBUG, SERVER
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = 127.0.0.1
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12209
|
||||||
|
log4perl.appender.SERVER.Proto = udp
|
||||||
|
log4perl.appender.SERVER.Gzip = 0
|
||||||
|
log4perl.appender.SERVER.Chunked = 0
|
||||||
|
END
|
||||||
|
|
||||||
|
|
||||||
|
Log::Log4perl->init_once( \$config );
|
||||||
|
$log = Log::Log4perl->get_logger("log1");
|
||||||
|
}
|
||||||
|
"lives through setting up logger";
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "sends though udp plain" => sub {
|
||||||
|
my $log_data = Data::Faker->new()->domain_name();
|
||||||
|
my $mock = Test::MockModule->new('IO::Socket::INET');
|
||||||
|
$mock->mock(
|
||||||
|
'new',
|
||||||
|
sub {
|
||||||
|
my $proto = shift;
|
||||||
|
my $class = ref $proto || $proto;
|
||||||
|
my %params = @_;
|
||||||
|
|
||||||
|
cmp_ok( $params{PeerAddr}, 'eq', "127.0.0.1",
|
||||||
|
"PeerAddr is set to localhost" );
|
||||||
|
cmp_ok( $params{PeerPort}, '==', 12209,
|
||||||
|
"PeerPort is set to 12209 and is a number" );
|
||||||
|
cmp_ok( $params{Proto}, 'eq', "udp", "Proto is set to udp" );
|
||||||
|
|
||||||
|
|
||||||
|
return bless \%params, $class;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$mock->mock(
|
||||||
|
'send',
|
||||||
|
sub {
|
||||||
|
my $self = shift;
|
||||||
|
my ($data) = @_;
|
||||||
|
my $json =
|
||||||
|
JSON->new->utf8->space_after->allow_nonref->convert_blessed;
|
||||||
|
my $result;
|
||||||
|
lives_ok {
|
||||||
|
$result = $json->decode($data);
|
||||||
|
}
|
||||||
|
"GELF message is json and can be reparsed";
|
||||||
|
|
||||||
|
cmp_ok( $result->{full_message},
|
||||||
|
"eq", $log_data, "full_message is $log_data" );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
my $closed = 0;
|
||||||
|
$mock->mock(
|
||||||
|
'close',
|
||||||
|
sub {
|
||||||
|
$closed = 1;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$log->debug($log_data);
|
||||||
|
ok( $closed, "Connection verified closed" );
|
||||||
|
};
|
||||||
|
done_testing;
|
97
t/02-log-gzip.t
Normal file
97
t/02-log-gzip.t
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use JSON -convert_blessed_universally;
|
||||||
|
use Test::Most;
|
||||||
|
use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
|
||||||
|
use Test::MockModule;
|
||||||
|
use Data::Faker;
|
||||||
|
use Data::Printer
|
||||||
|
output => 'stderr',
|
||||||
|
colored => 1,
|
||||||
|
deparse => 1,
|
||||||
|
caller_info => 1,
|
||||||
|
show_readonly => 1,
|
||||||
|
show_lvalue => 1,
|
||||||
|
max_depth => 5,
|
||||||
|
caller_info => 1,
|
||||||
|
class => { inherited => 'all', expand => 5 };
|
||||||
|
|
||||||
|
my $log;
|
||||||
|
|
||||||
|
subtest "Init Logger plain" => sub {
|
||||||
|
lives_ok {
|
||||||
|
use Log::Log4perl;
|
||||||
|
Log::Log4perl->reset();
|
||||||
|
use Log::Log4perl::Appender::Graylog;
|
||||||
|
use Log::Log4perl::Layout::NoopLayout;
|
||||||
|
my $config = <<'END';
|
||||||
|
log4perl.logger = DEBUG, SERVER
|
||||||
|
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||||
|
log4perl.appender.SERVER.layout = NoopLayout
|
||||||
|
log4perl.appender.SERVER.PeerAddr = 127.0.0.1
|
||||||
|
log4perl.appender.SERVER.PeerPort = 12209
|
||||||
|
log4perl.appender.SERVER.Proto = udp
|
||||||
|
log4perl.appender.SERVER.Gzip = 1
|
||||||
|
log4perl.appender.SERVER.Chunked = 0
|
||||||
|
END
|
||||||
|
|
||||||
|
Log::Log4perl->init_once( \$config );
|
||||||
|
|
||||||
|
$log = Log::Log4perl->get_logger("log1");
|
||||||
|
}
|
||||||
|
"lives through setting up logger";
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "sends though udp plain" => sub {
|
||||||
|
my $log_data = Data::Faker->new()->domain_name();
|
||||||
|
my $mock = Test::MockModule->new('IO::Socket::INET');
|
||||||
|
$mock->mock(
|
||||||
|
'new',
|
||||||
|
sub {
|
||||||
|
my $proto = shift;
|
||||||
|
my $class = ref $proto || $proto;
|
||||||
|
my %params = @_;
|
||||||
|
cmp_ok( $params{PeerAddr}, 'eq', "127.0.0.1",
|
||||||
|
"PeerAddr is set to localhost" );
|
||||||
|
cmp_ok( $params{PeerPort}, '==', 12209,
|
||||||
|
"PeerPort is set to 12209 and is a number" );
|
||||||
|
cmp_ok( $params{Proto}, 'eq', "udp", "Proto is set to udp" );
|
||||||
|
|
||||||
|
|
||||||
|
return bless \%params, $class;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$mock->mock(
|
||||||
|
'send',
|
||||||
|
sub {
|
||||||
|
my $self = shift;
|
||||||
|
my ($gzdata) = @_;
|
||||||
|
my $data;
|
||||||
|
gunzip \$gzdata => \$data or die "gunzip failed: $GunzipError\n";
|
||||||
|
my $json =
|
||||||
|
JSON->new->utf8->space_after->allow_nonref->convert_blessed;
|
||||||
|
my $result;
|
||||||
|
lives_ok {
|
||||||
|
$result = $json->decode($data);
|
||||||
|
}
|
||||||
|
"GELF message is json and can be reparsed";
|
||||||
|
|
||||||
|
cmp_ok( $result->{full_message},
|
||||||
|
"eq", $log_data, "full_message is $log_data" );
|
||||||
|
}
|
||||||
|
);
|
||||||
|
my $closed = 0;
|
||||||
|
$mock->mock(
|
||||||
|
'close',
|
||||||
|
sub {
|
||||||
|
$closed = 1;
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$log->debug($log_data);
|
||||||
|
ok( $closed, "Connection verified closed" );
|
||||||
|
};
|
||||||
|
done_testing;
|
33
t/DTO/00-compile.t
Normal file
33
t/DTO/00-compile.t
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Test::More;
|
||||||
|
use Test::Moose::More;
|
||||||
|
use Data::DTO::GELF;
|
||||||
|
|
||||||
|
use Readonly;
|
||||||
|
Readonly my $CLASS => 'Data::DTO::GELF';
|
||||||
|
|
||||||
|
subtest "$CLASS Is valid object." => sub {
|
||||||
|
meta_ok($CLASS);
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "$CLASS has correct attributes" => sub {
|
||||||
|
has_attribute_ok( $CLASS, 'version' );
|
||||||
|
has_attribute_ok( $CLASS, 'host' );
|
||||||
|
has_attribute_ok( $CLASS, 'short_message' );
|
||||||
|
has_attribute_ok( $CLASS, 'full_message' );
|
||||||
|
has_attribute_ok( $CLASS, 'timestamp' );
|
||||||
|
has_attribute_ok( $CLASS, 'level' );
|
||||||
|
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "$CLASS has correct predicates, clearers, writers, and builders" =>
|
||||||
|
sub {
|
||||||
|
has_method_ok( $CLASS, '_build_version' );
|
||||||
|
has_method_ok( $CLASS, '_build_timestamp' );
|
||||||
|
};
|
||||||
|
|
||||||
|
done_testing();
|
62
t/DTO/01-instance.t
Normal file
62
t/DTO/01-instance.t
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Test::Most;
|
||||||
|
use Test::Moose::More;
|
||||||
|
use Data::DTO::GELF;
|
||||||
|
use Data::UUID;
|
||||||
|
use POSIX qw(strftime);
|
||||||
|
use Data::Random::String;
|
||||||
|
|
||||||
|
use JSON -convert_blessed_universally;
|
||||||
|
|
||||||
|
use Readonly;
|
||||||
|
Readonly my $CLASS => 'Data::DTO::GELF';
|
||||||
|
|
||||||
|
my $obj;
|
||||||
|
my $data = {
|
||||||
|
'full_message' => Data::Random::String->create_random_string(
|
||||||
|
length => '100',
|
||||||
|
contains => 'alpha'
|
||||||
|
),
|
||||||
|
'level' => "DEBUG",
|
||||||
|
'_timestr' => strftime( "%Y-%m-%d %H:%M:%S", gmtime( time() ) ),
|
||||||
|
'_uuid' => Data::UUID->new()->create_str(),
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "$CLASS Is valid object." => sub {
|
||||||
|
lives_ok {
|
||||||
|
$obj = $CLASS->new($data)
|
||||||
|
}
|
||||||
|
"Lives though creating instance if $CLASS";
|
||||||
|
|
||||||
|
ok( $obj, "$CLASS is Instanced" );
|
||||||
|
};
|
||||||
|
|
||||||
|
subtest "$CLASS has proper values" => sub {
|
||||||
|
cmp_ok( $obj->version(), "eq", "1.1", "Version tag is 1.1" );
|
||||||
|
cmp_ok( $obj->full_message(), "eq", $data->{full_message},
|
||||||
|
"Full message is ok" );
|
||||||
|
cmp_ok(
|
||||||
|
$obj->short_message(), "eq",
|
||||||
|
( substr $data->{full_message}, 0, 100 ),
|
||||||
|
"Short message is full message truncated to 100 chars."
|
||||||
|
);
|
||||||
|
cmp_ok( $obj->level(), "==", "0", "DEBUG level is coerced to 0" );
|
||||||
|
ok( defined $obj->timestamp(), "Timestamp is defined" );
|
||||||
|
cmp_ok( $obj->_uuid(), "eq", $data->{_uuid},
|
||||||
|
"Dynamic _var's were created" );
|
||||||
|
|
||||||
|
};
|
||||||
|
subtest "$CLASS hashifys for TO_JSON" => sub {
|
||||||
|
lives_ok {
|
||||||
|
my $json = JSON->new->allow_nonref->convert_blessed;
|
||||||
|
my $j = $json->encode($obj);
|
||||||
|
ok( defined $j, "Has JSON value" );
|
||||||
|
}
|
||||||
|
"Lives through converting to json";
|
||||||
|
};
|
||||||
|
|
||||||
|
done_testing();
|
Loading…
Reference in New Issue
Block a user