Logger.pm 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170
  1. # ex:ts=8 sw=4:
  2. # $OpenBSD: Logger.pm,v 1.24 2015/05/25 17:37:26 espie Exp $
  3. #
  4. # Copyright (c) 2010-2013 Marc Espie <espie@openbsd.org>
  5. #
  6. # Permission to use, copy, modify, and distribute this software for any
  7. # purpose with or without fee is hereby granted, provided that the above
  8. # copyright notice and this permission notice appear in all copies.
  9. #
  10. # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  11. # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  12. # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  13. # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  14. # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  15. # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  16. # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  17. use strict;
  18. use warnings;
  19. use DPB::User;
  20. package DPB::Logger;
  21. our @ISA = (qw(DPB::UserProxy));
  22. use File::Path;
  23. use File::Basename;
  24. use IO::File;
  25. sub new
  26. {
  27. my ($class, $state) = @_;
  28. if (!defined $state->{log_user}) {
  29. die "Too early";
  30. }
  31. bless {logdir => $state->logdir, user => $state->{log_user},
  32. clean => $state->opt('c')}, $class;
  33. }
  34. sub logfile
  35. {
  36. my ($self, $name) = @_;
  37. my $log = "$self->{logdir}/$name.log";
  38. $self->make_path(File::Basename::dirname($log));
  39. return $log;
  40. }
  41. sub _open
  42. {
  43. my ($self, $mode, $name) = @_;
  44. my $log = $self->logfile($name);
  45. my $fh = $self->open($mode, $log);
  46. if (defined $fh) {
  47. return $fh;
  48. } else {
  49. DPB::Util->die_bang("Can't write to $log");
  50. }
  51. }
  52. sub append
  53. {
  54. die if @_ > 2;
  55. my ($self, $name) = @_;
  56. return $self->_open('>>', $name);
  57. }
  58. sub create
  59. {
  60. my ($self, $name) = @_;
  61. return $self->_open('>', $name);
  62. }
  63. sub log_pkgpath
  64. {
  65. my ($self, $v) = @_;
  66. return $self->logfile("/paths/".$v->fullpkgpath);
  67. }
  68. sub testlog_pkgpath
  69. {
  70. my ($self, $v) = @_;
  71. return $self->logfile("/tests/".$v->fullpkgpath);
  72. }
  73. sub log_pkgname
  74. {
  75. my ($self, $v) = @_;
  76. if ($v->has_fullpkgname) {
  77. return $self->logfile("/packages/".$v->fullpkgname);
  78. } else {
  79. return $self->logfile("/nopkgname/".$v->fullpkgpath);
  80. }
  81. }
  82. sub link
  83. {
  84. my ($self, $a, $b) = @_;
  85. $self->run_as(
  86. sub {
  87. if ($self->{clean}) {
  88. unlink($b);
  89. }
  90. my $src = File::Spec->catfile(
  91. File::Spec->abs2rel($self->{logdir},
  92. File::Basename::dirname($b)),
  93. File::Spec->abs2rel($a, $self->{logdir}));
  94. symlink($src, $b);
  95. });
  96. }
  97. sub make_logs
  98. {
  99. my ($self, $v) = @_;
  100. my $log = $self->log_pkgpath($v);
  101. if ($self->{clean}) {
  102. $self->unlink($log);
  103. }
  104. my $fh = $self->open(">>", $log);
  105. DPB::Util->die_bang("Can't write to $log") unless defined $fh;
  106. for my $w ($v->build_path_list) {
  107. $self->link($log, $self->log_pkgname($w));
  108. }
  109. return ($log, $fh);
  110. }
  111. sub make_test_logs
  112. {
  113. my ($self, $v) = @_;
  114. my $log = $self->testlog_pkgpath($v);
  115. if ($self->{clean}) {
  116. $self->unlink($log);
  117. }
  118. }
  119. sub log_error
  120. {
  121. my ($self, $v, @messages) = @_;
  122. my ($log, $fh) = $self->make_logs($v);
  123. for my $msg (@messages) {
  124. print $fh $msg, "\n";
  125. }
  126. $v->print_parent($fh);
  127. }
  128. sub make_distlogs
  129. {
  130. my ($self, $f) = @_;
  131. return $self->logfile("/dist/".$f->{name});
  132. }
  133. sub make_log_link
  134. {
  135. my ($self, $v) = @_;
  136. $self->run_as(
  137. sub {
  138. my $file = $self->log_pkgname($v);
  139. # we were built, but we don't link, so try the main pkgpath.
  140. if (!-e $file) {
  141. my $mainlog = $self->log_pkgpath(DPB::PkgPath->new($v->pkgpath_and_flavors));
  142. if (-e $mainlog) {
  143. $self->link($mainlog, $file);
  144. }
  145. # okay, so it was built through another flavor,
  146. # don't bother for now,
  147. # it will all solve itself eventually
  148. }
  149. $self->link($file, $self->log_pkgpath($v));
  150. });
  151. }
  152. 1;