diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-06 00:39:23 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-06 00:39:23 +0000 |
commit | e3b16b3856bdd5c1645f4609d61bf5a16c026930 (patch) | |
tree | d9def3b6f6f46b166fc6f516775350fedeefbef6 /lib/Devscripts/Uscan/Output.pm | |
parent | Initial commit. (diff) | |
download | devscripts-e3b16b3856bdd5c1645f4609d61bf5a16c026930.tar.xz devscripts-e3b16b3856bdd5c1645f4609d61bf5a16c026930.zip |
Adding upstream version 2.19.5+deb10u1.upstream/2.19.5+deb10u1upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'lib/Devscripts/Uscan/Output.pm')
-rw-r--r-- | lib/Devscripts/Uscan/Output.pm | 99 |
1 files changed, 99 insertions, 0 deletions
diff --git a/lib/Devscripts/Uscan/Output.pm b/lib/Devscripts/Uscan/Output.pm new file mode 100644 index 0000000..68c1739 --- /dev/null +++ b/lib/Devscripts/Uscan/Output.pm @@ -0,0 +1,99 @@ +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_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) + = (0, {}, 0, 0); + +our $progname = basename($0); + +sub printwarn { + my ($msg, $w) = @_; + chomp $msg; + if ($w or $dehs) { + print STDERR "$msg\n"; + } else { + print "$msg\n"; + } +} + +*uscan_msg = \&ds_msg; + +*uscan_verbose = \&ds_verbose; + +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); +} + +*uscan_debug = \&ds_debug; + +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 + 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"; + } + } + } + if ($dehs_end_output) { + print "</dehs>\n"; + } + + # Don't repeat output + $dehs_tags = {}; +} +1; |