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 can be treated as errors of
 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
 208 =item C<footer =E<gt> ''>
 209
 210 A string to append to each message emitted through this channel.
 211
 212 =item C<backtrace =E<gt> 0>
 213
 214 Die with a stack backtrace after displaying the message.
 215
 216 =item C<partial =E<gt> 0>
 217
 218 When set, indicates a partial message that should
 219 be output along with the next message with C<partial> unset.
 220 Several partial messages can be stacked this way.
 221
 222 Duplicate filtering will apply to the I<global> message resulting from
 223 all I<partial> messages, using the options from the last (non-partial)
 224 message.  Linking associated messages is the main reason to use this
 225 option.
 226
 227 For instance the following messages
 228
 229   msg 'channel', 'foo:2', 'redefinition of A ...';
 230   msg 'channel', 'foo:1', '... A previously defined here';
 231   msg 'channel', 'foo:3', 'redefinition of A ...';
 232   msg 'channel', 'foo:1', '... A previously defined here';
 233
 234 will result in
 235
 236  foo:2: redefinition of A ...
 237  foo:1: ... A previously defined here
 238  foo:3: redefinition of A ...
 239
 240 where the duplicate "I<... A previously defined here>" has been
 241 filtered out.
 242
 243 Linking these messages using C<partial> as follows will prevent the
 244 fourth message to disappear.
 245
 246   msg 'channel', 'foo:2', 'redefinition of A ...', partial => 1;
 247   msg 'channel', 'foo:1', '... A previously defined here';
 248   msg 'channel', 'foo:3', 'redefinition of A ...', partial => 1;
 249   msg 'channel', 'foo:1', '... A previously defined here';
 250
 251 Note that because the stack of C<partial> messages is printed with the
 252 first non-C<partial> message, most options of C<partial> messages will
 253 be ignored.
 254
 255 =back
 256
 257 =cut
 258
 259 use vars qw (%_default_options %_global_duplicate_messages
 260              %_local_duplicate_messages);
 261
 262 # Default options for a channel.
 263 %_default_options =
 264   (
 265    type => 'warning',
 266    exit_code => 1,
 267    file => \*STDERR,
 268    silent => 0,
 269    ordered => 1,
 270    queue => 0,
 271    queue_key => undef,
 272    uniq_scope => US_LOCAL,
 273    uniq_part => UP_LOC_TEXT,
 274    header => '',
 275    footer => '',
 276    backtrace => 0,
 277    partial => 0,
 278    );
 279
 280 # Filled with output messages as keys, to detect duplicates.
 281 # The value associated with each key is the number of occurrences
 282 # filtered out.
 283 %_local_duplicate_messages = ();
 284 %_global_duplicate_messages = ();
 285
 286 sub _reset_duplicates (\%)
 287 {
 288   my ($ref) = @_;
 289   my $dup = 0;
 290   foreach my $k (keys %$ref)
 291     {
 292       $dup += $ref->{$k};
 293     }
 294   %$ref = ();
 295   return $dup;
 296 }
 297
 298
 299 =head2 Functions
 300
 301 =over 4
 302
 303 =item C<reset_local_duplicates ()>
 304
 305 Reset local duplicate messages (see C<US_LOCAL>), and
 306 return the number of messages that have been filtered out.
 307
 308 =cut
 309
 310 sub reset_local_duplicates ()
 311 {
 312   return _reset_duplicates %_local_duplicate_messages;
 313 }
 314
 315 =item C<reset_global_duplicates ()>
 316
 317 Reset local duplicate messages (see C<US_GLOBAL>), and
 318 return the number of messages that have been filtered out.
 319
 320 =cut
 321
 322 sub reset_global_duplicates ()
 323 {
 324   return _reset_duplicates %_global_duplicate_messages;
 325 }
 326
 327 sub _merge_options (\%%)
 328 {
 329   my ($hash, %options) = @_;
 330   local $_;
 331
 332   foreach (keys %options)
 333     {
 334       if (exists $hash->{$_})
 335         {
 336           $hash->{$_} = $options{$_}
 337         }
 338       else
 339         {
 340           confess "unknown option `$_'";
 341         }
 342     }
 343   if ($hash->{'ordered'})
 344     {
 345       confess "fatal messages cannot be ordered"
 346         if $hash->{'type'} eq 'fatal';
 347       confess "backtrace cannot be output on ordered messages"
 348         if $hash->{'backtrace'};
 349     }
 350 }
 351
 352 =item C<register_channel ($name, [%options])>
 353
 354 Declare channel C<$name>, and override the default options
 355 with those listed in C<%options>.
 356
 357 =cut
 358
 359 sub register_channel ($;%)
 360 {
 361   my ($name, %options) = @_;
 362   my %channel_opts = %_default_options;
 363   _merge_options %channel_opts, %options;
 364   $channels{$name} = \%channel_opts;
 365 }
 366
 367 =item C<exists_channel ($name)>
 368
 369 Returns true iff channel C<$name> has been registered.
 370
 371 =cut
 372
 373 sub exists_channel ($)
 374 {
 375   my ($name) = @_;
 376   return exists $channels{$name};
 377 }
 378
 379 =item C<channel_type ($name)>
 380
 381 Returns the type of channel C<$name> if it has been registered.
 382 Returns the empty string otherwise.
 383
 384 =cut
 385
 386 sub channel_type ($)
 387 {
 388   my ($name) = @_;
 389   return $channels{$name}{'type'} if exists_channel $name;
 390   return '';
 391 }
 392
 393 # _format_sub_message ($LEADER, $MESSAGE)
 394 # ---------------------------------------
 395 # Split $MESSAGE at new lines and add $LEADER to each line.
 396 sub _format_sub_message ($$)
 397 {
 398   my ($leader, $message) = @_;
 399   return $leader . join ("\n" . $leader, split ("\n", $message)) . "\n";
 400 }
 401
 402 # _format_message ($LOCATION, $MESSAGE, %OPTIONS)
 403 # -----------------------------------------------
 404 # Format the message.  Return a string ready to print.
 405 sub _format_message ($$%)
 406 {
 407   my ($location, $message, %opts) = @_;
 408   my $msg = '';
 409   if (ref $location)
 410     {
 411       # If $LOCATION is a reference, assume it's an instance of the
 412       # Automake::Location class and display contexts.
 413       my $loc = $location->get || $me;
 414       $msg = _format_sub_message ("$loc: ", $opts{'header'}
 415                                   . $message . $opts{'footer'});
 416       for my $pair ($location->get_contexts)
 417         {
 418           $msg .= _format_sub_message ($pair->[0] . ":   ", $pair->[1]);
 419         }
 420     }
 421   else
 422     {
 423       $location ||= $me;
 424       $msg = _format_sub_message ("$location: ", $opts{'header'}
 425                                   . $message . $opts{'footer'});
 426     }
 427   return $msg;
 428 }
 429
 430 # _enqueue ($QUEUE, $KEY, $UNIQ_SCOPE, $TO_FILTER, $MSG, $FILE)
 431 # -------------------------------------------------------------
 432 # Push message on a queue, to be processed by another thread.
 433 sub _enqueue ($$$$$$)
 434 {
 435   my ($queue, $key, $uniq_scope, $to_filter, $msg, $file) = @_;
 436   $queue->enqueue ($key, $msg, $to_filter, $uniq_scope);
 437   confess "message queuing works only for STDERR"
 438     if $file ne \*STDERR;
 439 }
 440
 441 # _dequeue ($QUEUE)
 442 # -----------------
 443 # Pop a message from a queue, and print, similarly to how
 444 # _print_message would do it.  Return 0 if the queue is
 445 # empty.  Note that the key has already been dequeued.
 446 sub _dequeue ($)
 447 {
 448   my ($queue) = @_;
 449   my $msg = $queue->dequeue || return 0;
 450   my $to_filter = $queue->dequeue;
 451   my $uniq_scope = $queue->dequeue;
 452   my $file = \*STDERR;
 453
 454   if ($to_filter ne '')
 455     {
 456       # Do we want local or global uniqueness?
 457       my $dups;
 458       if ($uniq_scope == US_LOCAL)
 459         {
 460           $dups = \%_local_duplicate_messages;
 461         }
 462       elsif ($uniq_scope == US_GLOBAL)
 463         {
 464           $dups = \%_global_duplicate_messages;
 465         }
 466       else
 467         {
 468           confess "unknown value for uniq_scope: " . $uniq_scope;
 469         }
 470
 471       # Update the hash of messages.
 472       if (exists $dups->{$to_filter})
 473         {
 474           ++$dups->{$to_filter};
 475           return 1;
 476         }
 477       else
 478         {
 479           $dups->{$to_filter} = 0;
 480         }
 481     }
 482   print $file $msg;
 483   return 1;
 484 }
 485
 486
 487 # Store partial messages here. (See the 'partial' option.)
 488 use vars qw ($partial);
 489 $partial = '';
 490
 491 # _print_message ($LOCATION, $MESSAGE, %OPTIONS)
 492 # ----------------------------------------------
 493 # Format the message, check duplicates, and print it.
 494 sub _print_message ($$%)
 495 {
 496   my ($location, $message, %opts) = @_;
 497
 498   return 0 if ($opts{'silent'});
 499
 500   my $msg = _format_message ($location, $message, %opts);
 501   if ($opts{'partial'})
 502     {
 503       # Incomplete message.   Store, don't print.
 504       $partial .= $msg;
 505       return;
 506     }
 507   else
 508     {
 509       # Prefix with any partial message send so far.
 510       $msg = $partial . $msg;
 511       $partial = '';
 512     }
 513
 514   # Check for duplicate message if requested.
 515   my $to_filter;
 516   if ($opts{'uniq_part'} ne UP_NONE)
 517     {
 518       # Which part of the error should we match?
 519       if ($opts{'uniq_part'} eq UP_TEXT)
 520         {
 521           $to_filter = $message;
 522         }
 523       elsif ($opts{'uniq_part'} eq UP_LOC_TEXT)
 524         {
 525           $to_filter = $msg;
 526         }
 527       else
 528         {
 529           $to_filter = $opts{'uniq_part'};
 530         }
 531
 532       # Do we want local or global uniqueness?
 533       my $dups;
 534       if ($opts{'uniq_scope'} == US_LOCAL)
 535         {
 536           $dups = \%_local_duplicate_messages;
 537         }
 538       elsif ($opts{'uniq_scope'} == US_GLOBAL)
 539         {
 540           $dups = \%_global_duplicate_messages;
 541         }
 542       else
 543         {
 544           confess "unknown value for uniq_scope: " . $opts{'uniq_scope'};
 545         }
 546
 547       # Update the hash of messages.
 548       if (exists $dups->{$to_filter})
 549         {
 550           ++$dups->{$to_filter};
 551           return 0;
 552         }
 553       else
 554         {
 555           $dups->{$to_filter} = 0;
 556         }
 557     }
 558   my $file = $opts{'file'};
 559   if ($opts{'ordered'} && $opts{'queue'})
 560     {
 561       _enqueue ($opts{'queue'}, $opts{'queue_key'}, $opts{'uniq_scope'},
 562                 $to_filter, $msg, $file);
 563     }
 564   else
 565     {
 566       print $file $msg;
 567     }
 568   return 1;
 569 }
 570
 571 =item C<msg ($channel, $location, $message, [%options])>
 572
 573 Emit a message on C<$channel>, overriding some options of the channel with
 574 those specified in C<%options>.  Obviously C<$channel> must have been
 575 registered with C<register_channel>.
 576
 577 C<$message> is the text of the message, and C<$location> is a location
 578 associated to the message.
 579
 580 For instance to complain about some unused variable C<mumble>
 581 declared at line 10 in F<foo.c>, one could do:
 582
 583   msg 'unused', 'foo.c:10', "unused variable `mumble'";
 584
 585 If channel C<unused> is not silent (and if this message is not a duplicate),
 586 the following would be output:
 587
 588   foo.c:10: unused variable `mumble'
 589
 590 C<$location> can also be an instance of C<Automake::Location>.  In this
 591 case, the stack of contexts will be displayed in addition.
 592
 593 If C<$message> contains newline characters, C<$location> is prepended
 594 to each line.  For instance,
 595
 596   msg 'error', 'somewhere', "1st line\n2nd line";
 597
 598 becomes
 599
 600   somewhere: 1st line
 601   somewhere: 2nd line
 602
 603 If C<$location> is an empty string, it is replaced by the name of the
 604 program.  Actually, if you don't use C<%options>, you can even
 605 elide the empty C<$location>.  Thus
 606
 607   msg 'fatal', '', 'fatal error';
 608   msg 'fatal', 'fatal error';
 609
 610 both print
 611
 612   progname: fatal error
 613
 614 =cut
 615
 616
 617 use vars qw (@backlog %buffering);
 618
 619 # See buffer_messages() and flush_messages() below.
 620 %buffering = ();        # The map of channel types to buffer.
 621 @backlog = ();          # The buffer of messages.
 622
 623 sub msg ($$;$%)
 624 {
 625   my ($channel, $location, $message, %options) = @_;
 626
 627   if (! defined $message)
 628     {
 629       $message = $location;
 630       $location = '';
 631     }
 632
 633   confess "unknown channel $channel" unless exists $channels{$channel};
 634
 635   my %opts = %{$channels{$channel}};
 636   _merge_options (%opts, %options);
 637
 638   if (exists $buffering{$opts{'type'}})
 639     {
 640       push @backlog, [$channel, $location->clone, $message, %options];
 641       return;
 642     }
 643
 644   # Print the message if needed.
 645   if (_print_message ($location, $message, %opts))
 646     {
 647       # Adjust exit status.
 648       if ($opts{'type'} eq 'error'
 649           || $opts{'type'} eq 'fatal'
 650           || ($opts{'type'} eq 'warning' && $warnings_are_errors))
 651         {
 652           my $es = $opts{'exit_code'};
 653           $exit_code = $es if $es > $exit_code;
 654         }
 655
 656       # Die on fatal messages.
 657       confess if $opts{'backtrace'};
 658       if ($opts{'type'} eq 'fatal')
 659         {
 660           # flush messages explicitly here, needed in worker threads.
 661           STDERR->flush;
 662           exit $exit_code;
 663         }
 664     }
 665 }
 666
 667
 668 =item C<setup_channel ($channel, %options)>
 669
 670 Override the options of C<$channel> with those specified by C<%options>.
 671
 672 =cut
 673
 674 sub setup_channel ($%)
 675 {
 676   my ($name, %opts) = @_;
 677   confess "channel $name doesn't exist" unless exists $channels{$name};
 678   _merge_options %{$channels{$name}}, %opts;
 679 }
 680
 681 =item C<setup_channel_type ($type, %options)>
 682
 683 Override the options of any channel of type C<$type>
 684 with those specified by C<%options>.
 685
 686 =cut
 687
 688 sub setup_channel_type ($%)
 689 {
 690   my ($type, %opts) = @_;
 691   foreach my $channel (keys %channels)
 692     {
 693       setup_channel $channel, %opts
 694         if $channels{$channel}{'type'} eq $type;
 695     }
 696 }
 697
 698 =item C<dup_channel_setup ()>, C<drop_channel_setup ()>
 699
 700 Sometimes it is necessary to make temporary modifications to channels.
 701 For instance one may want to disable a warning while processing a
 702 particular file, and then restore the initial setup.  These two
 703 functions make it easy: C<dup_channel_setup ()> saves a copy of the
 704 current configuration for later restoration by
 705 C<drop_channel_setup ()>.
 706
 707 You can think of this as a stack of configurations whose first entry
 708 is the active one.  C<dup_channel_setup ()> duplicates the first
 709 entry, while C<drop_channel_setup ()> just deletes it.
 710
 711 =cut
 712
 713 use vars qw (@_saved_channels @_saved_werrors);
 714 @_saved_channels = ();
 715 @_saved_werrors = ();
 716
 717 sub dup_channel_setup ()
 718 {
 719   my %channels_copy;
 720   foreach my $k1 (keys %channels)
 721     {
 722       $channels_copy{$k1} = {%{$channels{$k1}}};
 723     }
 724   push @_saved_channels, \%channels_copy;
 725   push @_saved_werrors, $warnings_are_errors;
 726 }
 727
 728 sub drop_channel_setup ()
 729 {
 730   my $saved = pop @_saved_channels;
 731   %channels = %$saved;
 732   $warnings_are_errors = pop @_saved_werrors;
 733 }
 734
 735 =item C<buffer_messages (@types)>, C<flush_messages ()>
 736
 737 By default, when C<msg> is called, messages are processed immediately.
 738
 739 Sometimes it is necessary to delay the output of messages.
 740 For instance you might want to make diagnostics before
 741 channels have been completely configured.
 742
 743 After C<buffer_messages(@types)> has been called, messages sent with
 744 C<msg> to a channel whose type is listed in C<@types> will be stored in a
 745 list for later processing.
 746
 747 This backlog of messages is processed when C<flush_messages> is
 748 called, with the current channel options (not the options in effect,
 749 at the time of C<msg>).  So for instance, if some channel was silenced
 750 in the meantime, messages to this channel will not be printed.
 751
 752 C<flush_messages> cancels the effect of C<buffer_messages>.  Following
 753 calls to C<msg> are processed immediately as usual.
 754
 755 =cut
 756
 757 sub buffer_messages (@)
 758 {
 759   foreach my $type (@_)
 760     {
 761       $buffering{$type} = 1;
 762     }
 763 }
 764
 765 sub flush_messages ()
 766 {
 767   %buffering = ();
 768   foreach my $args (@backlog)
 769     {
 770       &msg (@$args);
 771     }
 772   @backlog = ();
 773 }
 774
 775 =item C<setup_channel_queue ($queue, $key)>
 776
 777 Set the queue to fill for each channel that is ordered,
 778 and the key to use for serialization.
 779
 780 =cut
 781 sub setup_channel_queue ($$)
 782 {
 783   my ($queue, $key) = @_;
 784   foreach my $channel (keys %channels)
 785     {
 786       setup_channel $channel, queue => $queue, queue_key => $key
 787         if $channels{$channel}{'ordered'};
 788     }
 789 }
 790
 791 =item C<pop_channel_queue ($queue)>
 792
 793 pop a message off the $queue; the key has already been popped.
 794
 795 =cut
 796 sub pop_channel_queue ($)
 797 {
 798   my ($queue) = @_;
 799   return _dequeue ($queue);
 800 }
 801
 802 =back
 803
 804 =head1 SEE ALSO
 805
 806 L<Automake::Location>
 807
 808 =head1 HISTORY
 809
 810 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 811
 812 =cut
 813
 814 1;
 815
 816 ### Setup "GNU" style for perl-mode and cperl-mode.
 817 ## Local Variables:
 818 ## perl-indent-level: 2
 819 ## perl-continued-statement-offset: 2
 820 ## perl-continued-brace-offset: 0
 821 ## perl-brace-offset: 0
 822 ## perl-brace-imaginary-offset: 0
 823 ## perl-label-offset: -2
 824 ## cperl-indent-level: 2
 825 ## cperl-brace-offset: 0
 826 ## cperl-continued-brace-offset: 0
 827 ## cperl-label-offset: -2
 828 ## cperl-extra-newline-before-brace: t
 829 ## cperl-merge-trailing-else: nil
 830 ## cperl-continued-statement-offset: 2
 831 ## End: