1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
package Devscripts::Uscan::Output;
use strict;
use Devscripts::Output;
use Exporter 'import';
use File::Basename;
our @EXPORT = (
@Devscripts::Output::EXPORT, qw(
uscan_msg uscan_verbose dehs_verbose uscan_warn uscan_debug uscan_msg_raw
uscan_extra_debug uscan_die dehs_output $dehs $verbose $dehs_tags
$dehs_start_output $dehs_end_output $found
));
# ACCESSORS
our ($dehs, $dehs_tags, $dehs_start_output, $dehs_end_output, $found);
reset();
our $progname = basename($0);
sub reset {
($dehs, $dehs_tags, $dehs_start_output, $dehs_end_output, $found,)
= (0, {}, 0, 0,);
%Devscripts::Uscan::WatchSource::already_downloaded = ();
}
sub printwarn_raw {
my ($msg, $w) = @_;
if ($w or $dehs) {
print STDERR "$msg";
} else {
print "$msg";
}
}
sub printwarn {
my ($msg, $w) = @_;
chomp $msg;
printwarn_raw("$msg\n", $w);
}
sub uscan_msg_raw {
printwarn_raw($_[0]);
}
sub uscan_msg {
printwarn($_[0]);
}
sub uscan_verbose {
ds_verbose($_[0], $dehs);
}
sub uscan_debug {
ds_debug($_[0], $dehs);
}
sub uscan_extra_debug {
ds_extra_debug($_[0], $dehs);
}
sub dehs_verbose ($) {
my $msg = $_[0];
push @{ $dehs_tags->{'messages'} }, "$msg\n";
uscan_verbose($msg);
}
sub uscan_warn ($) {
my $msg = $_[0];
push @{ $dehs_tags->{'warnings'} }, $msg if $dehs;
printwarn("$progname warn: $msg" . &Devscripts::Output::who_called, 1);
}
sub uscan_die ($) {
my $msg = $_[0];
if ($dehs) {
$dehs_tags = { 'errors' => "$msg" };
$dehs_end_output = 1;
dehs_output();
}
$msg = "$progname die: $msg" . &Devscripts::Output::who_called;
if ($Devscripts::Output::die_on_error) {
die $msg;
}
printwarn($msg, 1);
}
sub dehs_output () {
return unless $dehs;
if (!$dehs_start_output) {
print "<dehs>\n";
$dehs_start_output = 1;
}
for my $tag (
qw(package debian-uversion debian-mangled-uversion
upstream-version upstream-url decoded-checksum
status target target-path messages warnings errors)
) {
if (exists $dehs_tags->{$tag}) {
if (ref $dehs_tags->{$tag} eq "ARRAY") {
foreach my $entry (@{ $dehs_tags->{$tag} }) {
$entry =~ s/</</g;
$entry =~ s/>/>/g;
$entry =~ s/&/&/g;
print "<$tag>$entry</$tag>\n";
}
} else {
$dehs_tags->{$tag} =~ s/</</g;
$dehs_tags->{$tag} =~ s/>/>/g;
$dehs_tags->{$tag} =~ s/&/&/g;
print "<$tag>$dehs_tags->{$tag}</$tag>\n";
}
}
}
foreach my $cmp (@{ $dehs_tags->{'component-name'} }) {
print qq'<component id="$cmp">\n';
foreach my $tag (
qw(debian-uversion debian-mangled-uversion
upstream-version upstream-url target target-path)
) {
my $v = shift @{ $dehs_tags->{"component-$tag"} };
print " <component-$tag>$v</component-$tag>\n" if $v;
}
print "</component>\n";
}
if ($dehs_end_output) {
print "</dehs>\n";
}
# Don't repeat output
$dehs_tags = {};
}
1;
|
