#!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;

=head1 NAME

libnetcfg - configure libnet

=head1 DESCRIPTION

The libnetcfg utility can be used to configure the libnet.
Starting from perl 5.8 libnet is part of the standard Perl
distribution, but the libnetcfg can be used for any libnet
installation.

=head1 USAGE

Without arguments libnetcfg displays the current configuration.

    $ libnetcfg
    # old config ./libnet.cfg
    daytime_hosts        ntp1.none.such
    ftp_int_passive      0
    ftp_testhost         ftp.funet.fi
    inet_domain          none.such
    nntp_hosts           nntp.none.such
    ph_hosts             
    pop3_hosts           pop.none.such
    smtp_hosts           smtp.none.such
    snpp_hosts           
    test_exist           1
    test_hosts           1
    time_hosts           ntp.none.such
    # libnetcfg -h for help
    $ 

It tells where the old configuration file was found (if found).

The C<-h> option will show a usage message.

To change the configuration you will need to use either the C<-c> or
the C<-d> options.

The default name of the old configuration file is by default
"libnet.cfg", unless otherwise specified using the -i option,
C<-i oldfile>, and it is searched first from the current directory,
and then from your module path.

The default name of the new configuration file is "libnet.cfg", and by
default it is written to the current directory, unless otherwise
specified using the -o option, C<-o newfile>.

=head1 SEE ALSO

L<Net::Config>, L<Net::libnetFAQ>

=head1 AUTHORS

Graham Barr, the original Configure script of libnet.

Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.

=cut

# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $

use strict;
use IO::File;
use Getopt::Std;
use ExtUtils::MakeMaker qw(prompt);
use File::Spec;

use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);

##
##
##

my %cfg = ();
my @cfg = ();

my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);

##
##
##

sub valid_host
{
 my $h = shift;

 defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
}

##
##
##

sub test_hostnames (\@)
{
 my $hlist = shift;
 my @h = ();
 my $host;
 my $err = 0;

 foreach $host (@$hlist)
  {
   if(valid_host($host))
    {
     push(@h, $host);
     next;
    }
   warn "Bad hostname: '$host'\n";
   $err++;
  }
 @$hlist = @h;
 $err ? join(" ",@h) : undef;
}

##
##
##

sub Prompt
{
 my($prompt,$def) = @_;

 $def = "" unless defined $def;

 chomp($prompt);

 if($opt_d)
  {
   print $prompt,," [",$def,"]\n";
   return $def;
  }
 prompt($prompt,$def);
}

##
##
##

sub get_host_list
{
 my($prompt,$def) = @_;

 $def = join(" ",@$def) if ref($def);

 my @hosts;

 do
  {
   my $ans = Prompt($prompt,$def);

   $ans =~ s/(\A\s+|\s+\Z)//g;

   @hosts = split(/\s+/, $ans);
  }
 while(@hosts && defined($def = test_hostnames(@hosts)));

 \@hosts;
}

##
##
##

sub get_hostname
{
 my($prompt,$def) = @_;

 my $host;

 while(1)
  {
   my $ans = Prompt($prompt,$def);
   $host = ($ans =~ /(\S*)/)[0];
   last
	if(!length($host) || valid_host($host));

   $def =""
	if $def eq $host;

   print <<"EDQ";

*** ERROR:
    Hostname `$host' does not seem to exist, please enter again
    or a single space to clear any default

EDQ
  }

 length $host
	? $host
	: undef;
}

##
##
##

sub get_bool ($$)
{
 my($prompt,$def) = @_;

 chomp($prompt);

 my $val = Prompt($prompt,$def ? "yes" : "no");

 $val =~ /^y/i ? 1 : 0;
}

##
##
##

sub get_netmask ($$)
{
 my($prompt,$def) = @_;

 chomp($prompt);

 my %list;
 @list{@$def} = ();

MASK:
 while(1) {
   my $bad = 0;
   my $ans = Prompt($prompt) or last;

   if($ans eq '*') {
     %list = ();
     next;
   }

   if($ans eq '=') {
     print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
     next;
   }

   unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
     warn "Bad netmask '$ans'\n";
     next;
   }

   my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
   if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
     warn "Bad netmask '$ans'\n";
     next MASK;
   }
   foreach my $byte (@ip) {
     if ( $byte > 255 ) {
       warn "Bad netmask '$ans'\n";
     
er Map

Encode uses the Unicode Character Map (UCM) format for source character
mappings.  This format is used by IBM's ICU package and was adopted
by Nick Ing-Simmons for use with the Encode module.  Since UCM is
more flexible than Tcl's Encoding Map and far more user-friendly,
this is the recommended format for Encode now.

A UCM file looks like this.

  #
  # Comments
  #
  <code_set_name> "US-ascii" # Required
  <code_set_alias> "ascii"   # Optional
  <mb_cur_min> 1             # Required; usually 1
  <mb_cur_max> 1             # Max. # of bytes/char
  <subchar> \x3F             # Substitution char
  #
  CHARMAP
  <U0000> \x00 |0 # <control>
  <U0001> \x01 |0 # <control>
  <U0002> \x02 |0 # <control>
  ....
  <U007C> \x7C |0 # VERTICAL LINE
  <U007D> \x7D |0 # RIGHT CURLY BRACKET
  <U007E> \x7E |0 # TILDE
  <U007F> \x7F |0 # <control>
  END CHARMAP

=over 4

=item *

Anything that follows C<#> is treated as a comment.

=item *

The header section continues until a line containing the word
CHARMAP. This section has a form of I<E<lt>keywordE<gt> value>, one
pair per line.  Strings used as values must be quoted. Barewords are
treated as numbers.  I<\xXX> represents a byte.

Most of the keywords are self-explanatory. I<subchar> means
substitution character, not subcharacter.  When you decode a Unicode
sequence to this encoding but no matching character is found, the byte
sequence defined here will be used.  For most cases, the value here is
\x3F; in ASCII, this is a question mark.

=item *

CHARMAP starts the character map section.  Each line has a form as
follows:

  <UXXXX> \xXX.. |0 # comment
    ^     ^      ^
    |     |      +- Fallback flag
    |     +-------- Encoded byte sequence
    +-------------- Unicode Character ID in hex

The format is roughly the same as a header section except for the
fallback flag: | followed by 0..3.   The meaning of the possible
values is as follows:

=over 4

=item |0 

Round trip safe.  A character decoded to Unicode encodes back to the
same byte sequence.  Most characters have this flag.

=item |1

Fallback for unicode -> encoding.  When seen, enc2xs adds this
character for the encode map only.

=item |2 

Skip sub-char mapping should there be no code point.

=item |3 

Fallback for encoding -> unicode.  When seen, enc2xs adds this
character for the decode map only.

=back

=item *

And finally, END OF CHARMAP ends the section.

=back

When you are manually creating a UCM file, you should copy ascii.ucm
or an existing encoding which is close to yours, rather than write
your own from scratch.

When you do so, make sure you leave at least B<U0000> to B<U0020> as
is, unless your environment is EBCDIC.

B<CAVEAT>: not all features in UCM are implemented.  For example,
icu:state is not used.  Because of that, you need to write a perl
module if you want to support algorithmical encodings, notably
the ISO-2022 series.  Such modules include L<Encode::JP::2022_JP>,
L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>.

=head2 Coping with duplicate mappings

When you create a map, you SHOULD make your mappings round-trip safe.
That is, C<encode('your-encoding', decode('your-encoding', $data)) eq
$data> stands for all characters that are marked as C<|0>.  Here is
how to make sure:

=over 4

=item * 

Sort your map in Unicode order.

=item *

When you have a duplicate entry, mark either one with '|1' or '|3'.
  
=item * 

And make sure the '|1' or '|3' entry FOLLOWS the '|0' entry.

=back

Here is an example from big5-eten.

  <U2550> \xF9\xF9 |0
  <U2550> \xA2\xA4 |3

Internally Encoding -> Unicode and Unicode -> Encoding Map looks like
this;

  E to U               U to E
  --------------------------------------
  \xF9\xF9 => U2550    U2550 => \xF9\xF9
  \xA2\xA4 => U2550
 
So it is round-trip safe for \xF9\xF9.  But if the line above is upside
down, here is what happens.

  E to U               U to E
  --------------------------------------
  \xA2\xA4 => U2550    U2550 => \xF9\xF9
  (\xF9\xF9 => U2550 is now overwritten!)

The Encode package comes with F<ucmlint>, a crude but sufficient
utility to check the integrity of a UCM file.  Check under the
Encode/bin directory for this.

When in doubt, you can use F<ucmsort>, yet another utility under
Encode/bin directory.

=head1 Bookmarks

=over 4

=item *

ICU Home Page 
L<http://www.icu-project.org/>

=item *

ICU Character Mapping Tables
L<http://www.icu-project.org/charset/>

=item *

ICU:Conversion Data
L<http://www.icu-project.org/userguide/conversion-data.html>

=back

=head1 SEE ALSO

L<Encode>,
L<perlmod>,
L<perlpod>

=cut

# -Q to disable the duplicate codepoint test
# -S make mapping errors fatal
# -q to remove comments written to output files
# -O to enable the (brute force) substring optimiser
# -o <output> to specify the output file name (else it's the first arg)
# -f <inlist> to give a file with a list of input files (else use the args)
# -n <name> to name the encoding (else use the basename of the input file.

With %seen holding array refs:

      865.66 real        28.80 user         8.79 sys
      7904  maximum resident set size
      1356  average shared memory size
     18566  average unshared data size
       229  average unshared stack size
     46080  page reclaims
     33373  page faults

With %seen holding simple scalars:

      342.16 real        27.11 user         3.54 sys
      8388  maximum resident set size
      1394  average shared memory size
     14969  average unshared data size
       236  average unshared stack size
     28159  page reclaims
      9839  page faults

Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is
how %seen is storing things its seen. So it is pathalogically bad on a 16M
RAM machine, but it's going to help even on modern machines.
Swapping is bad, m'kay :-)
                                                                                                                                                                                                                            ./usr/bin/cpanp-run-perl                                                                            0000755 0000000 0000000 00000001030 12115717231 014055  0                                                                                                    ustar   root                            root                                                                                                                                                                                                                   #!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;
use strict;
my $old = select STDERR; $|++;  # turn on autoflush
select $old;             $|++;  # turn on autoflush
$0 = shift(@ARGV);              # rename the script
my $rv = do($0);                # execute the file
die $@ if $@;                   # die on parse/execute error

### XXX 'do' returns last statement evaluated, which may be
### undef as well. So don't die in that case.
#die $! if not defined $rv;      # die on execute error
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ./usr/bin/perlbug                                                                                   0000755 0000000 0000000 00000000000 12115717231 016461  1./usr/bin/perlthanks                                                                                ustar   root                            root                                                                                                                                                                                                                   ./usr/bin/prename                                                                                   0000755 0000000 0000000 00000005653 12115717706 012667  0                                                                                                    ustar   root                            root                                                                                                                                                                                                                   #!/usr/bin/perl -w
#
#  This script was developed by Robin Barker (Robin.Barker@npl.co.uk),
#  from Larry Wall's original script eg/rename from the perl source.
#
#  This script is free software; you can redistribute it and/or modify it
#  under the same terms as Perl itself.
#
# Larry(?)'s RCS header:
#  RCSfile: rename,v   Revision: 4.1   Date: 92/08/07 17:20:30 
#
# $RCSfile: rename,v $$Revision: 1.5 $$Date: 1998/12/18 16:16:31 $
#
# $Log: rename,v $
# Revision 1.5  1998/12/18 16:16:31  rmb1
# moved to perl/source
# changed man documentation to POD
#
# Revision 1.4  1997/02/27  17:19:26  rmb1
# corrected usage string
#
# Revision 1.3  1997/02/27  16:39:07  rmb1
# added -v
#
# Revision 1.2  1997/02/27  16:15:40  rmb1
# *** empty log message ***
#
# Revision 1.1  1997/02/27  15:48:51  rmb1
# Initial revision
#

use strict;

use Getopt::Long;
Getopt::Long::Configure('bundling');

my ($verbose, $no_act, $force, $op);

die "Usage: rename [-v] [-n] [-f] perlexpr [filenames]\n"
    unless GetOptions(
	'v|verbose' => \$verbose,
	'n|no-act'  => \$no_act,
	'f|force'   => \$force,
    ) and $op = shift;

$verbose++ if $no_act;

if (!@ARGV) {
    print "reading filenames from STDIN\n" if $verbose;
    @ARGV = <STDIN>;
    chop(@ARGV);
}

for (@ARGV) {
    my $was = $_;
    eval $op;
    die $@ if $@;
    next if $was eq $_; # ignore quietly
    if (-e $_ and !$force)
    {
	warn  "$was not renamed: $_ already exists\n";
    }
    elsif ($no_act or rename $was, $_)
    {
	print "$was renamed as $_\n" if $verbose;
    }
    else
    {
	warn  "Can't rename $was $_: $!\n";
    }
}

__END__

=head1 NAME

rename - renames multiple files

=head1 SYNOPSIS

B<rename> S<[ B<-v> ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>

=head1 DESCRIPTION

C<rename>
renames the filenames supplied according to the rule specified as the
first argument.
The I<perlexpr> 
argument is a Perl expression which is expected to modify the C<$_>
string in Perl for at least some of the filenames specified.
If a given filename is not modified by the expression, it will not be
renamed.
If no filenames are given on the command line, filenames will be read
via standard input.

For example, to rename all files matching C<*.bak> to strip the extension,
you might say

	rename 's/\.bak$//' *.bak

To translate uppercase names to lower, you'd use

	rename 'y/A-Z/a-z/' *

=head1 OPTIONS

=over 8

=item B<-v>, B<--verbose>

Verbose: print names of files successfully renamed.

=item B<-n>, B<--no-act>

No Action: show what files would have been renamed.

=item B<-f>, B<--force>

Force: overwrite existing files.

=back

=head1 ENVIRONMENT

No environment variables are used.

=head1 AUTHOR

Larry Wall

=head1 SEE ALSO

mv(1), perl(1)

=head1 DIAGNOSTICS

If you give an invalid Perl expression you'll get a syntax error.

=head1 BUGS

The original C<rename> did not check for the existence of target filenames,
so had to b