lib/Automake/Channels.pm

   1 # Copyright (C) 2002, 2004, 2006, 2008, 2010 Free Software Foundation,
   2 # Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2, or (at your option)
   7 # any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 ###############################################################
  18 # The main copy of this file is in Automake's CVS repository. #
  19 # Updates should be sent to automake-patches@gnu.org.         #
  20 ###############################################################
  21
  22 package Automake::Channels;
  23
  24 =head1 NAME
  25
  26 Automake::Channels - support functions for error and warning management
  27
  28 =head1 SYNOPSIS
  29
  30   use Automake::Channels;
  31
  32   # Register a channel to output warnings about unused variables.
  33   register_channel 'unused', type => 'warning';
  34
  35   # Register a channel for system errors.
  36   register_channel 'system', type => 'error', exit_code => 4;
  37
  38   # Output a message on channel 'unused'.
  39   msg 'unused', "$file:$line", "unused variable `$var'";
  40
  41   # Make the 'unused' channel silent.
  42   setup_channel 'unused', silent => 1;
  43
  44   # Turn on all channels of type 'warning'.
  45   setup_channel_type 'warning', silent => 0;
  46
  47   # Redirect all channels to push messages on a Thread::Queue using
  48   # the specified serialization key.
  49   setup_channel_queue $queue, $key;
  50
  51   # Output a message pending in a Thread::Queue.
  52   pop_channel_queue $queue;
  53
  54   # Treat all warnings as errors.
  55   $warnings_are_errors = 1;
  56
  57   # Exit with the greatest exit code encountered so far.
  58   exit $exit_code;
  59
  60 =head1 DESCRIPTION
  61
  62 This perl module provides support functions for handling diagnostic
  63 channels in programs.  Channels can be registered to convey fatal,
  64 error, warning, or debug messages.  Each channel has various options
  65 (e.g. is the channel silent, should duplicate messages be removed,
  66 etc.) that can also be overridden on a per-message basis.
  67
  68 =cut
  69
  70 use 5.005;
  71 use strict;
  72 use Exporter;
  73 use Carp;
  74 use File::Basename;
  75
  76 use vars qw (@ISA @EXPORT %channels $me);
  77
  78 @ISA = qw (Exporter);
  79 @EXPORT = qw ($exit_code $warnings_are_errors
  80               &reset_local_duplicates &reset_global_duplicates
  81               &register_channel &msg &exists_channel &channel_type
  82               &setup_channel &setup_channel_type
  83               &dup_channel_setup &drop_channel_setup
  84               &buffer_messages &flush_messages
  85               &setup_channel_queue &pop_channel_queue
  86               US_GLOBAL US_LOCAL
  87               UP_NONE UP_TEXT UP_LOC_TEXT);
  88
  89 $me = basename $0;
  90
  91 =head2 Global Variables
  92
  93 =over 4
  94
  95 =item C<$exit_code>
  96
  97 The greatest exit code seen so far. C<$exit_code> is updated from
  98 the C<exit_code> options of C<fatal> and C<error> channels.
  99
 100 =cut
 101
 102 use vars qw ($exit_code);
 103 $exit_code = 0;
 104
 105 =item C<$warnings_are_errors>
 106
 107 Set this variable to 1 if warning messages should be treated as
 108 errors (i.e. if they should update C<$exit_code>).
 109
 110 =cut
 111
 112 use vars qw ($warnings_are_errors);
 113 $warnings_are_errors = 0;
 114
 115 =back
 116
 117 =head2 Constants
 118
 119 =over 4
 120
 121 =item C<UP_NONE>, C<UP_TEXT>, C<UP_LOC_TEXT>
 122
 123 Possible values for the C<uniq_part> options.  This selects the part
 124 of the message that should be considered when filtering out duplicates.
 125 If C<UP_LOC_TEXT> is used, the location and the explanation message
 126 are used for filtering.  If C<UP_TEXT> is used, only the explanation
 127 message is used (so the same message will be filtered out if it appears
 128 at different locations).  C<UP_NONE> means that duplicate messages
 129 should be output.
 130
 131 =cut
 132
 133 use constant UP_NONE => 0;
 134 use constant UP_TEXT => 1;
 135 use constant UP_LOC_TEXT => 2;
 136
 137 =item C<US_LOCAL>, C<US_GLOBAL>
 138
 139 Possible values for the C<uniq_scope> options.
 140 Use C<US_GLOBAL> for error messages that should be printed only
 141 once during the execution of the program, C<US_LOCAL> for message that
 142 should be printed only once per file.  (Actually, C<Channels> does not
 143 do this now when files are changed, it relies on you calling
 144 C<reset_local_duplicates> when this happens.)
 145
 146 =cut
 147
 148 # possible values for uniq_scope
 149 use constant US_LOCAL => 0;
 150 use constant US_GLOBAL => 1;
 151
 152 =back
 153
 154 =head2 Options
 155
 156 Channels accept the options described below.  These options can be
 157 passed as a hash to the C<register_channel>, C<setup_channel>, and C<msg>
 158 functions.  The possible keys, with their default value are:
 159
 160 =over
 161
 162 =item C<type =E<gt> 'warning'>
 163
 164 The type of the channel.  One of C<'debug'>, C<'warning'>, C<'error'>, or
 165 C<'fatal'>.  Fatal messages abort the program when they are output.
 166 Error messages update the exit status.  Debug and warning messages are
 167 harmless, except that warnings are treated as errors if
 168 C<$warnings_are_errors> is set.
 169
 170 =item C<exit_code =E<gt> 1>
 171
 172 The value to update C<$exit_code> with when a fatal or error message
 173 is emitted.  C<$exit_code> is also updated for warnings output
 174 when C<$warnings_are_errors> is set.
 175
 176 =item C<file =E<gt> \*STDERR>
 177
 178 The file where the error should be output.
 179
 180 =item C<silent =E<gt> 0>
 181
 182 Whether the channel should be silent.  Use this do disable a
 183 category of warning, for instance.
 184
 185 =item C<ordered =E<gt> 1>
 186
 187 Whether, with multi-threaded execution, the message should be queued
 188 for ordered output.
 189
 190 =item C<uniq_part =E<gt> UP_LOC_TEXT>
 191
 192 The part of the message subject to duplicate filtering.  See the
 193 documentation for the C<UP_NONE>, C<UP_TEXT>, and C<UP_LOC_TEXT>
 194 constants above.
 195
 196 C<uniq_part> can also be set to an arbitrary string that will be used
 197 instead of the message when considering duplicates.
 198
 199 =item C<uniq_scope =E<gt> US_LOCAL>
 200
 201 The scope of duplicate filtering.  See the documentation for the
 202 C<US_LOCAL>, and C<US_GLOBAL> constants above.
 203
 204 =item C<header =E<gt> ''>
 205
 206 A string to prepend to each message emitted through this channel.
 207 With partial messages, only the first part will have C<header>
 208 prepended.
 209
 210 =item C<footer =E<gt> ''>
 211
 212 A string to append to each message emitted through this channel.
 213 With partial messages, only the final part will have C<footer>
 214 appended.
 215
 216 =item C<backtrace =E<gt> 0>
 217
 218 Die with a stack backtrace after displaying the message.
 219
 220 =item C<partial =E<gt> 0>
 221
 222 When set, indicates a partial message that should
 223 be output along with the next message with C<partial> unset.
 224 Several partial messages can be stacked this way.
 225
 226 Duplicate filtering will apply to the I<global> message resulting from
 227 all I<partial> messages, using the options from the last (non-partial)
 228 message.  Linking associated messages is the main reason to use this
 229 option.
 230
 231 For instance the following messages
 232
 233   msg 'channel', 'foo:2', 'redefinition of A ...';
 234   msg 'channel', 'foo:1', '... A previously defined here';
 235   msg 'channel', 'foo:3', 'redefinition of A ...';
 236   msg 'channel', 'foo:1', '... A previously defined here';
 237
 238 will result in
 239
 240  foo:2: redefinition of A ...
 241  foo:1: ... A previously defined here
 242  foo:3: redefinition of A ...
 243
 244 where the duplicate "I<... A previously defined here>" has been
 245 filtered out.
 246
 247 Linking these messages using C<partial> as follows will prevent the
 248 fourth message to disappear.
 249
 250   msg 'channel', 'foo:2', 'redefinition of A ...', partial => 1;
 251   msg 'channel', 'foo:1', '... A previously defined here';
 252   msg 'channel', 'foo:3', 'redefinition of A ...', partial => 1;
 253   msg 'channel', 'foo:1', '... A previously defined here';
 254
 255 Note that because the stack of C<partial> messages is printed with the
 256 first non-C<partial> message, most options of C<partial> messages will
 257 be ignored.
 258
 259 =back
 260
 261 =cut
 262
 263 use vars qw (%_default_options %_global_duplicate_messages
 264              %_local_duplicate_messages);
 265
 266 # Default options for a channel.
 267 %_default_options =
 268   (
 269    type => 'warning',
 270    exit_code => 1,
 271    file => \*STDERR,
 272    silent => 0,
 273    ordered => 1,
 274    queue => 0,
 275    queue_key => undef,
 276    uniq_scope => US_LOCAL,
 277    uniq_part => UP_LOC_TEXT,
 278    header => '',
 279    footer => '',
 280    backtrace => 0,
 281    partial => 0,
 282    );
 283
 284 # Filled with output messages as keys, to detect duplicates.
 285 # The value associated with each key is the number of occurrences
 286 # filtered out.
 287 %_local_duplicate_messages = ();
 288 %_global_duplicate_messages = ();
 289
 290 sub _reset_duplicates (\%)
 291 {
 292   my ($ref) = @_;
 293   my $dup = 0;
 294   foreach my $k (keys %$ref)
 295     {
 296       $dup += $ref->{$k};
 297     }
 298   %$ref = ();
 299   return $dup;
 300 }
 301
 302
 303 =head2 Functions
 304
 305 =over 4
 306
 307 =item C<reset_local_duplicates ()>
 308
 309 Reset local duplicate messages (see C<US_LOCAL>), and
 310 return the number of messages that have been filtered out.
 311
 312 =cut
 313
 314 sub reset_local_duplicates ()
 315 {
 316   return _reset_duplicates %_local_duplicate_messages;
 317 }
 318
 319 =item C<reset_global_duplicates ()>
 320
 321 Reset local duplicate messages (see C<US_GLOBAL>), and
 322 return the number of messages that have been filtered out.
 323
 324 =cut
 325
 326 sub reset_global_duplicates ()
 327 {
 328   return _reset_duplicates %_global_duplicate_messages;
 329 }
 330
 331 sub _merge_options (\%%)
 332 {
 333   my ($hash, %options) = @_;
 334   local $_;
 335
 336   foreach (keys %options)
 337     {
 338       if (exists $hash->{$_})
 339         {
 340           $hash->{$_} = $options{$_}
 341         }
 342       else
 343         {
 344           confess "unknown option `$_'";
 345         }
 346     }
 347   if ($hash->{'ordered'})
 348     {
 349       confess "fatal messages cannot be ordered"
 350         if $hash->{'type'} eq 'fatal';
 351       confess "backtrace cannot be output on ordered messages"
 352         if $hash->{'backtrace'};
 353     }
 354 }
 355
 356 =item C<register_channel ($name, [%options])>
 357
 358 Declare channel C<$name>, and override the default options
 359 with those listed in C<%options>.
 360
 361 =cut
 362
 363 sub register_channel ($;%)
 364 {
 365   my ($name, %options) = @_;
 366   my %channel_opts = %_default_options;
 367   _merge_options %channel_opts, %options;
 368   $channels{$name} = \%channel_opts;
 369 }
 370
 371 =item C<exists_channel ($name)>
 372
 373 Returns true iff channel C<$name> has been registered.
 374
 375 =cut
 376
 377 sub exists_channel ($)
 378 {
 379   my ($name) = @_;
 380   return exists $channels{$name};
 381 }
 382
 383 =item C<channel_type ($name)>
 384
 385 Returns the type of channel C<$name> if it has been registered.
 386 Returns the empty string otherwise.
 387
 388 =cut
 389
 390 sub channel_type ($)
 391 {
 392   my ($name) = @_;
 393   return $channels{$name}{'type'} if exists_channel $name;
 394   return '';
 395 }
 396
 397 # _format_sub_message ($LEADER, $MESSAGE)
 398 # ---------------------------------------
 399 # Split $MESSAGE at new lines and add $LEADER to each line.
 400 sub _format_sub_message ($$)
 401 {
 402   my ($leader, $message) = @_;
 403   return $leader . join ("\n" . $leader, split ("\n", $message)) . "\n";
 404 }
 405
 406 # Store partial messages here. (See the 'partial' option.)
 407 use vars qw ($partial);
 408 $partial = '';
 409
 410 # _format_message ($LOCATION, $MESSAGE, %OPTIONS)
 411 # -----------------------------------------------
 412 # Format the message.  Return a string ready to print.
 413 sub _format_message ($$%)
 414 {
 415   my ($location, $message, %opts) = @_;
 416   my $msg = ($partial eq '' ? $opts{'header'} : '') . $message
 417             . ($opts{'partial'} ? '' : $opts{'footer'});
 418   if (ref $location)
 419     {
 420       # If $LOCATION is a reference, assume it's an instance of the
 421       # Automake::Location class and display contexts.
 422       my $loc = $location->get || $me;
 423       $msg = _format_sub_message ("$loc: ", $msg);
 424       for my $pair ($location->get_contexts)
 425         {
 426           $msg .= _format_sub_message ($pair->[0] . ":   ", $pair->[1]);
 427         }
 428     }
 429   else
 430     {
 431       $location ||= $me;
 432       $msg = _format_sub_message ("$location: ", $msg);
 433     }
 434   return $msg;
 435 }
 436
 437 # _enqueue ($QUEUE, $KEY, $UNIQ_SCOPE, $TO_FILTER, $MSG, $FILE)
 438 # -------------------------------------------------------------
 439 # Push message on a queue, to be processed by another thread.
 440 sub _enqueue ($$$$$$)
 441 {
 442   my ($queue, $key, $uniq_scope, $to_filter, $msg, $file) = @_;
 443   $queue->enqueue ($key, $msg, $to_filter, $uniq_scope);
 444   confess "message queuing works only for STDERR"
 445     if $file ne \*STDERR;
 446 }
 447
 448 # _dequeue ($QUEUE)
 449 # -----------------
 450 # Pop a message from a queue, and print, similarly to how
 451 # _print_message would do it.  Return 0 if the queue is
 452 # empty.  Note that the key has already been dequeued.
 453 sub _dequeue ($)
 454 {
 455   my ($queue) = @_;
 456   my $msg = $queue->dequeue || return 0;
 457   my $to_filter = $queue->dequeue;
 458   my $uniq_scope = $queue->dequeue;
 459   my $file = \*STDERR;
 460
 461   if ($to_filter ne '')
 462     {
 463       # Do we want local or global uniqueness?
 464       my $dups;
 465       if ($uniq_scope == US_LOCAL)
 466         {
 467           $dups = \%_local_duplicate_messages;
 468         }
 469       elsif ($uniq_scope == US_GLOBAL)
 470         {
 471           $dups = \%_global_duplicate_messages;
 472         }
 473       else
 474         {
 475           confess "unknown value for uniq_scope: " . $uniq_scope;
 476         }
 477
 478       # Update the hash of messages.
 479       if (exists $dups->{$to_filter})
 480         {
 481           ++$dups->{$to_filter};
 482           return 1;
 483         }
 484       else
 485         {
 486           $dups->{$to_filter} = 0;
 487         }
 488     }
 489   print $file $msg;
 490   return 1;
 491 }
 492
 493
 494 # _print_message ($LOCATION, $MESSAGE, %OPTIONS)
 495 # ----------------------------------------------
 496 # Format the message, check duplicates, and print it.
 497 sub _print_message ($$%)
 498 {
 499   my ($location, $message, %opts) = @_;
 500
 501   return 0 if ($opts{'silent'});
 502
 503   my $msg = _format_message ($location, $message, %opts);
 504   if ($opts{'partial'})
 505     {
 506       # Incomplete message.   Store, don't print.
 507       $partial .= $msg;
 508       return;
 509     }
 510   else
 511     {
 512       # Prefix with any partial message send so far.
 513       $msg = $partial . $msg;
 514       $partial = '';
 515     }
 516
 517   msg ('note', '', 'warnings are treated as errors', uniq_scope => US_GLOBAL)
 518     if ($opts{'type'} eq 'warning' && $warnings_are_errors);
 519
 520   # Check for duplicate message if requested.
 521   my $to_filter;
 522   if ($opts{'uniq_part'} ne UP_NONE)
 523     {
 524       # Which part of the error should we match?
 525       if ($opts{'uniq_part'} eq UP_TEXT)
 526         {
 527           $to_filter = $message;
 528         }
 529       elsif ($opts{'uniq_part'} eq UP_LOC_TEXT)
 530         {
 531           $to_filter = $msg;
 532         }
 533       else
 534         {
 535           $to_filter = $opts{'uniq_part'};
 536         }
 537
 538       # Do we want local or global uniqueness?
 539       my $dups;
 540       if ($opts{'uniq_scope'} == US_LOCAL)
 541         {
 542           $dups = \%_local_duplicate_messages;
 543         }
 544       elsif ($opts{'uniq_scope'} == US_GLOBAL)
 545         {
 546           $dups = \%_global_duplicate_messages;
 547         }
 548       else
 549         {
 550           confess "unknown value for uniq_scope: " . $opts{'uniq_scope'};
 551         }
 552
 553       # Update the hash of messages.
 554       if (exists $dups->{$to_filter})
 555         {
 556           ++$dups->{$to_filter};
 557           return 0;
 558         }
 559       else
 560         {
 561           $dups->{$to_filter} = 0;
 562         }
 563     }
 564   my $file = $opts{'file'};
 565   if ($opts{'ordered'} && $opts{'queue'})
 566     {
 567       _enqueue ($opts{'queue'}, $opts{'queue_key'}, $opts{'uniq_scope'},
 568                 $to_filter, $msg, $file);
 569     }
 570   else
 571     {
 572       print $file $msg;
 573     }
 574   return 1;
 575 }
 576
 577 =item C<msg ($channel, $location, $message, [%options])>
 578
 579 Emit a message on C<$channel>, overriding some options of the channel with
 580 those specified in C<%options>.  Obviously C<$channel> must have been
 581 registered with C<register_channel>.
 582
 583 C<$message> is the text of the message, and C<$location> is a location
 584 associated to the message.
 585
 586 For instance to complain about some unused variable C<mumble>
 587 declared at line 10 in F<foo.c>, one could do:
 588
 589   msg 'unused', 'foo.c:10', "unused variable `mumble'";
 590
 591 If channel C<unused> is not silent (and if this message is not a duplicate),
 592 the following would be output:
 593
 594   foo.c:10: unused variable `mumble'
 595
 596 C<$location> can also be an instance of C<Automake::Location>.  In this
 597 case, the stack of contexts will be displayed in addition.
 598
 599 If C<$message> contains newline characters, C<$location> is prepended
 600 to each line.  For instance,
 601
 602   msg 'error', 'somewhere', "1st line\n2nd line";
 603
 604 becomes
 605
 606   somewhere: 1st line
 607   somewhere: 2nd line
 608
 609 If C<$location> is an empty string, it is replaced by the name of the
 610 program.  Actually, if you don't use C<%options>, you can even
 611 elide the empty C<$location>.  Thus
 612
 613   msg 'fatal', '', 'fatal error';
 614   msg 'fatal', 'fatal error';
 615
 616 both print
 617
 618   progname: fatal error
 619
 620 =cut
 621
 622
 623 use vars qw (@backlog %buffering);
 624
 625 # See buffer_messages() and flush_messages() below.
 626 %buffering = ();        # The map of channel types to buffer.
 627 @backlog = ();          # The buffer of messages.
 628
 629 sub msg ($$;$%)
 630 {
 631   my ($channel, $location, $message, %options) = @_;
 632
 633   if (! defined $message)
 634     {
 635       $message = $location;
 636       $location = '';
 637     }
 638
 639   confess "unknown channel $channel" unless exists $channels{$channel};
 640
 641   my %opts = %{$channels{$channel}};
 642   _merge_options (%opts, %options);
 643
 644   if (exists $buffering{$opts{'type'}})
 645     {
 646       push @backlog, [$channel, $location->clone, $message, %options];
 647       return;
 648     }
 649
 650   # Print the message if needed.
 651   if (_print_message ($location, $message, %opts))
 652     {
 653       # Adjust exit status.
 654       if ($opts{'type'} eq 'error'
 655           || $opts{'type'} eq 'fatal'
 656           || ($opts{'type'} eq 'warning' && $warnings_are_errors))
 657         {
 658           my $es = $opts{'exit_code'};
 659           $exit_code = $es if $es > $exit_code;
 660         }
 661
 662       # Die on fatal messages.
 663       confess if $opts{'backtrace'};
 664       if ($opts{'type'} eq 'fatal')
 665         {
 666           # flush messages explicitly here, needed in worker threads.
 667           STDERR->flush;
 668           exit $exit_code;
 669         }
 670     }
 671 }
 672
 673
 674 =item C<setup_channel ($channel, %options)>
 675
 676 Override the options of C<$channel> with those specified by C<%options>.
 677
 678 =cut
 679
 680 sub setup_channel ($%)
 681 {
 682   my ($name, %opts) = @_;
 683   confess "unknown channel $name" unless exists $channels{$name};
 684   _merge_options %{$channels{$name}}, %opts;
 685 }
 686
 687 =item C<setup_channel_type ($type, %options)>
 688
 689 Override the options of any channel of type C<$type>
 690 with those specified by C<%options>.
 691
 692 =cut
 693
 694 sub setup_channel_type ($%)
 695 {
 696   my ($type, %opts) = @_;
 697   foreach my $channel (keys %channels)
 698     {
 699       setup_channel $channel, %opts
 700         if $channels{$channel}{'type'} eq $type;
 701     }
 702 }
 703
 704 =item C<dup_channel_setup ()>, C<drop_channel_setup ()>
 705
 706 Sometimes it is necessary to make temporary modifications to channels.
 707 For instance one may want to disable a warning while processing a
 708 particular file, and then restore the initial setup.  These two
 709 functions make it easy: C<dup_channel_setup ()> saves a copy of the
 710 current configuration for later restoration by
 711 C<drop_channel_setup ()>.
 712
 713 You can think of this as a stack of configurations whose first entry
 714 is the active one.  C<dup_channel_setup ()> duplicates the first
 715 entry, while C<drop_channel_setup ()> just deletes it.
 716
 717 =cut
 718
 719 use vars qw (@_saved_channels @_saved_werrors);
 720 @_saved_channels = ();
 721 @_saved_werrors = ();
 722
 723 sub dup_channel_setup ()
 724 {
 725   my %channels_copy;
 726   foreach my $k1 (keys %channels)
 727     {
 728       $channels_copy{$k1} = {%{$channels{$k1}}};
 729     }
 730   push @_saved_channels, \%channels_copy;
 731   push @_saved_werrors, $warnings_are_errors;
 732 }
 733
 734 sub drop_channel_setup ()
 735 {
 736   my $saved = pop @_saved_channels;
 737   %channels = %$saved;
 738   $warnings_are_errors = pop @_saved_werrors;
 739 }
 740
 741 =item C<buffer_messages (@types)>, C<flush_messages ()>
 742
 743 By default, when C<msg> is called, messages are processed immediately.
 744
 745 Sometimes it is necessary to delay the output of messages.
 746 For instance you might want to make diagnostics before
 747 channels have been completely configured.
 748
 749 After C<buffer_messages(@types)> has been called, messages sent with
 750 C<msg> to a channel whose type is listed in C<@types> will be stored in a
 751 list for later processing.
 752
 753 This backlog of messages is processed when C<flush_messages> is
 754 called, with the current channel options (not the options in effect,
 755 at the time of C<msg>).  So for instance, if some channel was silenced
 756 in the meantime, messages to this channel will not be printed.
 757
 758 C<flush_messages> cancels the effect of C<buffer_messages>.  Following
 759 calls to C<msg> are processed immediately as usual.
 760
 761 =cut
 762
 763 sub buffer_messages (@)
 764 {
 765   foreach my $type (@_)
 766     {
 767       $buffering{$type} = 1;
 768     }
 769 }
 770
 771 sub flush_messages ()
 772 {
 773   %buffering = ();
 774   foreach my $args (@backlog)
 775     {
 776       &msg (@$args);
 777     }
 778   @backlog = ();
 779 }
 780
 781 =item C<setup_channel_queue ($queue, $key)>
 782
 783 Set the queue to fill for each channel that is ordered,
 784 and the key to use for serialization.
 785
 786 =cut
 787 sub setup_channel_queue ($$)
 788 {
 789   my ($queue, $key) = @_;
 790   foreach my $channel (keys %channels)
 791     {
 792       setup_channel $channel, queue => $queue, queue_key => $key
 793         if $channels{$channel}{'ordered'};
 794     }
 795 }
 796
 797 =item C<pop_channel_queue ($queue)>
 798
 799 pop a message off the $queue; the key has already been popped.
 800
 801 =cut
 802 sub pop_channel_queue ($)
 803 {
 804   my ($queue) = @_;
 805   return _dequeue ($queue);
 806 }
 807
 808 =back
 809
 810 =head1 SEE ALSO
 811
 812 L<Automake::Location>
 813
 814 =head1 HISTORY
 815
 816 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 817
 818 =cut
 819
 820 1;
 821
 822 ### Setup "GNU" style for perl-mode and cperl-mode.
 823 ## Local Variables:
 824 ## perl-indent-level: 2
 825 ## perl-continued-statement-offset: 2
 826 ## perl-continued-brace-offset: 0
 827 ## perl-brace-offset: 0
 828 ## perl-brace-imaginary-offset: 0
 829 ## perl-label-offset: -2
 830 ## cperl-indent-level: 2
 831 ## cperl-brace-offset: 0
 832 ## cperl-continued-brace-offset: 0
 833 ## cperl-label-offset: -2
 834 ## cperl-extra-newline-before-brace: t
 835 ## cperl-merge-trailing-else: nil
 836 ## cperl-continued-statement-offset: 2
 837 ## End: