+sub _get_encname {
+ return ($1, Encode::resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/;
+ return;
+}
+
+sub croak {
+ require Carp; goto &Carp::croak;
+}
+
+sub _drop_oldenc {
+ # If by the time we arrive here there already is at the top of the
+ # perlio layer stack an encoding identical to what we would like
+ # to push via this open pragma, we will pop away the old encoding
+ # (+utf8) so that we can push ourselves in place (this is easier
+ # than ignoring pushing ourselves because of the way how ${^OPEN}
+ # works). So we are looking for something like
+ #
+ # stdio encoding(xxx) utf8
+ #
+ # in the existing layer stack, and in the new stack chunk for
+ #
+ # :encoding(xxx)
+ #
+ # If we find a match, we pop the old stack (once, since
+ # the utf8 is just a flag on the encoding layer)
+ my ($h, @new) = @_;
+ return unless @new >= 1 && $new[-1] =~ /^:encoding\(.+\)$/;
+ my @old = PerlIO::get_layers($h);
+ return unless @old >= 3 &&
+ $old[-1] eq 'utf8' &&
+ $old[-2] =~ /^encoding\(.+\)$/;
+ require Encode;
+ my ($loname, $lcname) = _get_encname($old[-2]);
+ unless (defined $lcname) { # Should we trust get_layers()?
+ croak("open: Unknown encoding '$loname'");
+ }
+ my ($voname, $vcname) = _get_encname($new[-1]);
+ unless (defined $vcname) {
+ croak("open: Unknown encoding '$voname'");
+ }
+ if ($lcname eq $vcname) {
+ binmode($h, ":pop"); # utf8 is part of the encoding layer
+ }
+}