home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / Net / Config.pm < prev    next >
Encoding:
Perl POD Document  |  1997-10-10  |  2.6 KB  |  115 lines  |  [TEXT/McPL]
  1. package Net::Config;
  2.  
  3. require Exporter;
  4. use vars qw(@ISA @EXPORT %NetConfig);
  5. use strict;
  6.  
  7. @EXPORT = qw(%NetConfig);
  8. @ISA = qw(Exporter);
  9.  
  10. sub set
  11. {
  12.  my $pkg = shift if @_ % 2;
  13.  my %cfg = @_;
  14.  
  15.  return unless @_;
  16.  
  17.  # Only require these modules if we need to
  18.  require Data::Dumper;
  19.  require IO::File;
  20.  require Carp;
  21.  require File::Copy;
  22.     
  23.  my $mod = $INC{'Net/Config.pm'} or        # yep, it's / even under MacPerl
  24.     Carp::croak "Can't find myself";
  25.  
  26.  my $bak = $mod . "~";
  27.  
  28.  print "Updating $mod...\n";
  29.  
  30.  File::Copy::copy($mod,$bak) or
  31.     Carp::croak "Cannot create backup file $bak: $!";
  32.  
  33.  print "...backup at $bak\n";
  34.  
  35.  my $old = new IO::File $bak,"r" or
  36.     Carp::croak "Can't open $bak: $!";
  37.  
  38.  my $new = new IO::File $mod,"w" or
  39.     Carp::croak "Can't open $mod: $!";
  40.  
  41.  # If we fail below, then we must restore from backup
  42.  local $SIG{'__DIE__'} = sub {
  43.         print "Restoring $mod from backup!!\n";
  44.         unlink $mod;
  45.         rename $bak, $mod;
  46.         print "Done.\n";
  47.         exit 1;
  48.        };
  49.  
  50.  %NetConfig = (%NetConfig, %cfg);
  51.  
  52.  while (<$old>)
  53.   {
  54.    last if /^%NetConfig/;
  55.    $new->print($_);
  56.   }
  57.  
  58.  $new->print ( Data::Dumper->Dump([\%NetConfig],['*NetConfig']) );
  59.  
  60.  $new->print("\n1;\n");
  61.  
  62.  close $old;
  63.  close $new;
  64. }
  65.  
  66. #
  67. # Try to get as much configuration info as possible from InternetConfig
  68. #
  69. eval <<'TRY_INTERNET_CONFIG';
  70. use Mac::InternetConfig;
  71.  
  72. %NetConfig = (
  73.     nntp_hosts => [ $InternetConfig{kICNNTPHost()} ],
  74.     pop3_hosts => [ $InternetConfig{kICMailAccount()} =~ /@(.*)/ ],
  75.     smtp_hosts => [ $InternetConfig{kICSMTPHost()} ],
  76.     ftp_testhost => [ $InternetConfig{kICFTPHost()} ],
  77.     ph_hosts => [ $InternetConfig{kICPhHost()} ],
  78.     ftp_ext_passive => $InternetConfig{"646F676F•UsePassiveMode"} || 0,
  79.     ftp_int_passive => $InternetConfig{"646F676F•UsePassiveMode"} || 0,
  80.     socks_hosts => 
  81.         $InternetConfig{kICUseSocks()} ? [ $InternetConfig{kICSocksHost()} ] : [],
  82.     ftp_firewall => 
  83.         $InternetConfig{kICUseFTPProxy()} ? [ $InternetConfig{kICFTPProxyHost()} ] : [],
  84. );
  85. TRY_INTERNET_CONFIG
  86.  
  87. # Edit for your own domain
  88.  
  89. my(@NetConfig) = (
  90.     test_hosts => 1,
  91.     nntp_hosts => ['news.example.com' ],
  92.     snpp_hosts => [],
  93.     pop3_hosts => [ 'pop.example.com' ],
  94.     ftp_ext_passive => '0',
  95.     smtp_hosts => [ 'smtp.example.com' ],
  96.     ftp_testhost => undef,
  97.     inet_domain => 'example.com',
  98.     ph_hosts => [],
  99.     test_exist => 1,
  100.     daytime_hosts => [],
  101.     ftp_int_passive => '0',
  102.     ftp_firewall => undef,
  103.     time_hosts => []
  104. );
  105.  
  106. my($key, $value);
  107.  
  108. while (($key,$value) = splice(@NetConfig, 0, 2)) {
  109.     if (!defined($NetConfig{$key})) {
  110.         $NetConfig{$key} = $value;
  111.     }
  112. }
  113.  
  114. 1;
  115.