lib/Autom4te/Channels.pm

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