release/src-rt-6.x.4708/toolchains/hndtools-arm-linux-2.6.36-uclibc-4.5.3/share/automake-1.11/Automake/Channels.pm

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