diff options
Diffstat (limited to 'lib/Devscripts/Uscan/Output.pm')
-rw-r--r-- | lib/Devscripts/Uscan/Output.pm | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/lib/Devscripts/Uscan/Output.pm b/lib/Devscripts/Uscan/Output.pm new file mode 100644 index 0000000..82b179e --- /dev/null +++ b/lib/Devscripts/Uscan/Output.pm @@ -0,0 +1,112 @@ +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_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) + = (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; + +*uscan_extra_debug = \&ds_extra_debug; + +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 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; |