← Back to branch summary

~ubuntu-branches/ubuntu/natty/sbuild/natty-updates

« back to all changes in this revision

Viewing changes to lib/Buildd.pm

  • Committer: Bazaar Package Importer
  • Author(s): Felix Geyer
  • Date: 2010-05-14 23:13:17 UTC
  • mfrom: (0.3.3 upstream)
  • mto: This revision was merged to the branch mainline in revision 26.
  • Revision ID: james.westby@ubuntu.com-20100514231317-09132vor1bgwk4nq
Tags: upstream-0.60.0
Import upstream version 0.60.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Buildd.pm
31
31
require Exporter;
32
32
@Buildd::ISA = qw(Exporter);
33
33
 
34
 
@Buildd::EXPORT = qw(unset_env lock_file unlock_file open_log
35
 
                     reopen_log close_log send_mail
 
34
@Buildd::EXPORT = qw(unset_env lock_file unlock_file send_mail
36
35
                     ll_send_mail exitstatus isin);
37
36
 
38
37
$Buildd::lock_interval = 15;
39
38
$Buildd::max_lock_trys = 120;
40
39
($Buildd::progname = $0) =~ s,.*/,,;
41
 
$Buildd::progpid = $$;
42
40
my @pwinfo = getpwuid($>);
43
41
$Buildd::username = $pwinfo[0];
44
42
$Buildd::gecos = $pwinfo[6];
50
48
sub unset_env ();
51
49
sub lock_file ($;$);
52
50
sub unlock_file ($);
53
 
sub open_log ($);
54
 
sub close_log ($);
55
 
sub reopen_log ($);
56
51
sub send_mail ($$$;$);
57
52
sub ll_send_mail ($$);
58
53
sub exitstatus ($);
96
91
            goto repeat if !open( F, "<$lockfile" );
97
92
            my $line = <F>;
98
93
            close( F );
 
94
            # If this goes wrong it would be a spinlock and the world will
 
95
            # end.
 
96
            goto repeat if !defined( $line );
99
97
            if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) {
100
98
                warn "Bad lock file contents ($lockfile) -- still trying\n";
101
99
            }
136
134
    unlink( $lockfile );
137
135
}
138
136
 
139
 
sub open_log ($) {
140
 
    my $conf = shift;
141
 
 
142
 
    my $logfile = $conf->get('DAEMON_LOG_FILE');
143
 
 
144
 
    my $log = new FileHandle(">>$logfile")
145
 
        or die "$0: Cannot open logfile $logfile: $!\n";
146
 
    chmod( 0640, "$logfile" )
147
 
        or die "$0: Cannot set modes of $logfile: $!\n";
148
 
 
149
 
    my $logfunc = sub {
150
 
        my $F = shift;
151
 
        my $message = shift;
152
 
 
153
 
        my $t;
154
 
        my $text = "";
155
 
 
156
 
        # omit weekday and year for brevity
157
 
        ($t = localtime) =~ /^\w+\s(.*)\s\d+$/; $t = $1;
158
 
        $message =~ s/\n+$//; # remove newlines at end
159
 
        $message = "$t $Buildd::progname\[$Buildd::progpid\]: $message\n";
160
 
 
161
 
        print $F $message;
162
 
    };
163
 
 
164
 
    return Sbuild::LogBase::open_log($conf, $log, $logfunc);
165
 
}
166
 
 
167
 
sub close_log ($) {
168
 
    my $conf = shift;
169
 
 
170
 
    Sbuild::LogBase::close_log($conf);
171
 
}
172
 
 
173
 
sub reopen_log ($) {
174
 
    my $conf = shift;
175
 
 
176
 
    my $errno = $!;
177
 
 
178
 
    close_log($conf);
179
 
    open_log($conf);
180
 
    $! = $errno;
181
 
}
182
137
 
183
138
sub send_mail ($$$;$) {
184
139
    my $addr = shift;