summaryrefslogtreecommitdiffstats
path: root/lib/Devscripts/Uscan/Output.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Devscripts/Uscan/Output.pm')
-rw-r--r--lib/Devscripts/Uscan/Output.pm112
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/</&lt;/g;
+ $entry =~ s/>/&gt;/g;
+ $entry =~ s/&/&amp;/g;
+ print "<$tag>$entry</$tag>\n";
+ }
+ } else {
+ $dehs_tags->{$tag} =~ s/</&lt;/g;
+ $dehs_tags->{$tag} =~ s/>/&gt;/g;
+ $dehs_tags->{$tag} =~ s/&/&amp;/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;