perl+xml+ini
liunx終端配置perl指令碼
文中主要內容perl解析xml和ini檔案。
# termial configure script
# execute on the linux operation system reduced to 256M version
# read the configure file to hash list
#system("./ukey2file >conf.txt");
%file_cache ;
$config_file = "conf.txt";
%config = &read_config_file($config_file);
$conf = &get_config('pppoe_conf');
# update adsl user and password
my $user = $config{'adsl_user'};
my $pass = $config{'adsl_pwd'};
&update_adsl_user($user,$pass);
# update the configure file appconf.xml for every item
my $value = $config{'ccp1'};
&update_appconf("server","name","ccp1","ipAddress",$value);
my $value = $config{'ccp2'};
&update_appconf("server","name","ccp2","ipAddress",$value);
my $value = $config{'ccp3'};
&update_appconf("server","name","ccp3","ipAddress",$value);
my $value = $config{'updaterftp'};
&update_appconf("server","name","updateftp","ipAddress",$value);
my $value = $config{'updateuser'};
&update_appconf("server","name","updateftp","userName",$value);
my $value = $config{'updatepwd'};
&update_appconf("server","name","updateftp","password",$value);
my $value = $config{'uploadftp'};
&update_appconf("upload","name","uploadftp","ipAddress",$value);
my $value = $config{'uploaduser'};
&update_appconf("upload","name","uploadftp","userName",$value);
my $value = $config{'uploadpwd'};
&update_appconf("upload","name","uploadftp","password",$value);
my $value = $config{'lib'};
&update_appconf("module","name","printer","filePath","lib/".$value);
my $value = $config{'inputtype'};
&update_appconf("gladeXml","name","main","filePath","resource/".$value."/");
# replace all configure files to new ones
my $value = $config{'rc_local'};
system ("cp /etc/rc.d/$value /etc/rc.d/rc.local");
my $value = $config{'xorgconf'};
system ("cp /etc/X11/$value /etc/X11/xorg.conf");
system ("cp /etc/rc.d/rc.pos /etc/rc.d/rc");
system ("cp /etc/rc.d/rc.sysinit.pos /etc/rc.d/rc.sysinit");
system ("cp /home/oneu/.xinitrc.pos /home/oneu/.xinitrc");
system ("cp /home/oneu/.bash_profile.pos /home/oneu/.bash_profile");
system ("cp /etc/inittab.pos /etc/inittab");
# Update the boot file for pstn and adsl
# Read the switch from the configure file
$dialtype = $config{'dialtype'};
if ($dialtype eq 'adsl')
{
$upfile = '/etc/sysconfig/network-scripts/ifcfg-ppp0';
}
elsif ($dialtype eq 'pstn')
{
$upfile = '/etc/sysconfig/network-scripts/ifcfg-pstn';
# update pstn user and password
$conf = &get_config_pstn();
$dialer = $conf->[1];
&parse_opt("Phone");
&parse_opt("Username");
&parse_opt("Password");
$user = $config{'pstn_user'};
$pass = $config{'pstn_pwd'};
$phone = $config{'pstn_tel'};
$dialer->{'values'}->{'Phone'} = $phone;
$dialer->{'values'}->{'Username'} = $pass;
$dialer->{'values'}->{'Password'} = $user;
&update_dialer($dialer);
$dialer = $conf->[0];
&parse_opt("Modem");
$modemport = $config{'modemport'};
$dialer->{'values'}->{'Modem'} = $modemport;
&update_dialer($dialer);
}
$conf = &get_config($upfile);
&save_directive_boot($conf, "ONBOOT", 'yes', $upfile);
&flush_file_lines();
# Update the configure file "/home/oneu/posseller/conf/appconf.xml"
sub update_appconf
{
use XML::DOM;
my ($tag,$item1,$value1,$item2,$value2) = @_;
if ($value2 eq "")
{
goto label;
}
my $parser = new XML::DOM::Parser;
my $doc = $parser->parsefile ("/home/oneu/posseller/conf/appconf.xml");
my $nodes = $doc->getElementsByTagName( $tag );
for( my $i = 0; $i < $nodes->getLength; $i++ )
{
my $itemValue = $nodes->item($i)->getElementsByTagName($item1)->item(0)->getFirstChild->getNodeValue;
if($itemValue eq $value1)
{
my $data_len = length($nodes->item($i)->getElementsByTagName($item2)->item(0)->getFirstChild->getNodeValue);
$nodes->item($i)->getElementsByTagName($item2)->item(0)->getFirstChild->replaceData(0,$data_len,$value2);
}
}
$doc->printToFile ("/home/oneu/posseller/conf/appconf.xml");
#open(FILE,">/home/oneu/posseller/conf/appconf1.xml");
#print FILE $doc->toString;
#close FILE;
$doc->dispose;
label:
}
# Update adsl user and password
sub update_adsl_user
{
my ($user, $pass) = @_;
$olduser = &find("USER", $conf);
&save_directive($conf, "USER", $user);
&flush_file_lines();
@secs = &list_secrets();
($sec) = grep { $_->{'client'} eq $olduser } @secs;
if (!$sec)
{
($sec) = grep { $_->{'client'} eq $user } @secs;
}
if ($sec)
{
$sec->{'secret'} = $pass;
$sec->{'client'} = $user;
&change_secret($sec);
}
else
{
$sec = { 'secret' => $pass,
'client' => $user,
'server' => '*' };
&create_secret($sec);
}
}
# read_config_file(file)
# Reads the given config file, and returns a hash of values
sub read_config_file
{
local %rv;
open(CONF, $_[0]) || die "Failed to open config file $_[0] : $!";
while() {
s/ | //g;
if (/^#/ || !/S/) { next; }
/^([^=]+)=(.*)$/;
$name = $1; $val = $2;
$name =~ s/^s+//g; $name =~ s/s+$//g;
$val =~ s/^s+//g; $val =~ s/s+$//g;
$rv{$name} = $val;
}
close(CONF);
return %rv;
}
# list_secrets()
# secrets-lib.pl
# Common functions for editing a PPP users file
sub list_secrets
{
local(@rv, $line, $_);
open(SEC, $config{'pap_file'});
$line = 0;
while() {
chop;
s/^#.*$//g;
@w = &split_words($_);
if (@w >= 3) {
local(%sec, @ips);
$sec{'client'} = $w[0];
$sec{'server'} = $w[1];
$sec{'secret'} = $w[2];
@ips = @w[3..$#w];
$sec{'ips'} = @ips;
$sec{'line'} = $line;
$sec{'index'} = scalar(@rv);
push(@rv, %sec);
}
$line++;
}
close(SEC);
return @rv;
}
# create_secret(&secret)
sub create_secret
{
open(SEC, ">>$config{'pap_file'}");
print SEC &join_words($_[0]->{'client'}, $_[0]->{'server'},$_[0]->{'secret'}, @{$_[0]->{'ips'}})," ";
close( SEC);
}
# change_secret(&secret)
sub change_secret
{
&replace_file_line($config{'pap_file'}, $_[0]->{'line'},
&join_words($_[0]->{'client'}, $_[0]->{'server'},
$_[0]->{'secret'}, @{$_[0]->{'ips'}})." ");
}
# delete_secret(&secret)
sub delete_secret
{
&replace_file_line($config{'pap_file'}, $_[0]->{'line'});
}
# split_words(string)
sub split_words
{
local($s, @w);
$s = $_[0];
while($s =~ /^s*([^"s]+|"([^"]*)")(.*)$/) {
push(@w, defined($2) ? $2 : $1);
$s = $3;
}
return @w;
}
# join_words
sub join_words
{
local(@w, $w);
foreach $w (@_) {
if ($w =~ /^[a-zA-Z0-9.-]+$/) { push(@w, $w); }
else { push(@w, ""$w""); }
}
return join(" ", @w);
}
# opt_crypt(password)
# Returns the given password, crypted if the user has configured it
sub opt_crypt
{
if ($config{'encrypt_pass'}) {
local($salt);
srand(time());
$salt = chr(int(rand(26))+65).chr(int(rand(26))+65);
return &unix_crypt($_[0], $salt);
}
return $_[0];
}
# get_config()
# Parse the PPPOE configuration file
sub get_config
{
local @rv;
local $lnum = 0;
if ($_[0] eq 'pppoe_conf')
{
open(FILE, $config{$_[0]}) || return undef;
}
else
{
open(FILE, $_[0]) || return undef;
}
while() {
s/ | //g;
s/^s*#.*$//;
if (/^s*(S+)s*=s*"([^"]*)"/ ||
/^s*(S+)s*=s*'([^']*)'/ ||
/^s*(S+)s*=s*(S+)/) {
push(@rv, { 'name' => $1,
'value' => $2,
'line' => $lnum });
}
$lnum++;
}
close(FILE);
return @rv;
}
# find(name, &config)
# Looks up an entry in the config file
sub find
{
local $c;
foreach $c (@{$_[1]}) {
if (lc($c->{'name'}) eq lc($_[0])) {
return $c->{'value'};
}
}
return undef;
}
# save_directive(&config, name, value)
sub save_directive
{
local ($old) = grep { lc($_->{'name'}) eq lc($_[1]) } @{$_[0]};
local $lref = &read_file_lines($config{'pppoe_conf'});
local $nl = "$_[1]=".($_[2] =~ /^S+$/ ? $_[2] : ""$_[2]"");
if ($old) {
$lref->[$old->{'line'}] = $nl;
}
else {
push(@$lref, $nl);
}
}
# save_directive_boot(&config, name, value, file)
sub save_directive_boot
{
local ($old) = grep { lc($_->{'name'}) eq lc($_[1]) } @{$_[0]};
local $lref = &read_file_lines($_[3]);
local $nl = "$_[1]=".($_[2] =~ /^S+$/ ? $_[2] : ""$_[2]"");
if ($old) {
$lref->[$old->{'line'}] = $nl;
}
else {
push(@$lref, $nl);
}
}
# get_adsl_ip()
# Returns the device name and IP address of the ADSL connection (if up),
# or nothing if down
sub get_adsl_ip
{
local $out = `$config{'status_cmd'} 2>&1`;
if ($out =~ /link is up/i &&
$out =~ /ons+interfaces+ppp(d+)[00-377]+inet addr:s*(S+)/i) {
return ($1, $2);
}
elsif ($out =~ /attacheds+tos+(pppd+)/i) {
return ($1, undef);
}
else {
return ( );
}
}
# get_pppoe_version(&out)
sub get_pppoe_version
{
local $out = `$config{'pppoe_cmd'} -V 2>&1`;
${$_[0]} = $out;
return $out =~ /versions+(S+)/i ? $1 : undef;
}
# common libs
# replace_file_line(file, line, [newline]*)
# Replaces one line in some file with 0 or more new lines
sub replace_file_line
{
local(@lines);
local $realfile = &translate_filename($_[0]);
open(FILE, $realfile);
@lines =;
close(FILE);
if (@_ > 2) { splice(@lines, $_[1], 1, @_[2..$#_]); }
else { splice(@lines, $_[1], 1); }
open(FILE, ">$realfile");
print FILE @lines;
close(FILE);
}
# read_file_lines(file)
# Returns a reference to an array containing the lines from some file. This
# array can be modified, and will be written out when flush_file_lines()
# is called.
sub read_file_lines
{
if (!$_[0]) {
local ($package, $filename, $line) = caller;
print STDERR "Missing file to read at ${package}::${filename} line $line ";
}
local $realfile = &translate_filename($_[0]);
if (!$file_cache{$realfile}) {
local(@lines, $_);
open(READFILE, $realfile);
while() {
tr/ //d;
push(@lines, $_);
}
close(READFILE);
$file_cache{$realfile} = @lines;
}
return $file_cache{$realfile};
}
# flush_file_lines([file], [eol])
sub flush_file_lines
{
local $f;
local @files;
if ($_[0]) {
local $trans = &translate_filename($_[0]);
$file_cache{$trans} ||
&error("flush_file_lines called on non-loaded file");
push(@files, $trans);
}
else {
@files = ( keys %file_cache );
}
local $eol = $_[1] || " ";
foreach $f (@files) {
open(FLUSHFILE, ">$f");
local $line;
foreach $line (@{$main::file_cache{$f}}) {
(print FLUSHFILE $line,$eol );
}
close (FLUSHFILE);
delete($file_cache{$f});
}
}
# translate_filename(filename)
# Applies all relevant registered translation functions to a filename
sub translate_filename
{
local $realfile = $_[0];
return $realfile;
}
# from here is the script for pstn dial.
# get_config_pstn()
# Returns a list of all configuration settings
sub get_config_pstn
{
local (@rv, $sect);
local $lnum = 0;
open(FILE, "while() {
s/^s*;.*//;
s/ | //g;
if (/^s*[(.*)]/) {
# Start of a section
$sect = { 'name' => $1,
'index' => scalar(@rv),
'line' => $lnum,
'eline' => $lnum,
'values' => { },
'onames' => { } };
push(@rv, $sect);
}
elsif (/^s*([^=]+S)s*=s*(.*)/ && $sect) {
# A directive within a section
$sect->{'values'}->{lc($1)} = $2;
$sect->{'onames'}->{lc($1)} = $1;
$sect->{'eline'} = $lnum;
}
$lnum++;
}
close(FILE);
return @rv;
}
# update_dialer(&dialer)
sub update_dialer
{
local $lref = &read_file_lines("/etc/wvdial.conf");
splice(@$lref, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1,
&dialer_lines($_[0]));
&flush_file_lines();
}
# dialer_lines(&dialer)
sub dialer_lines
{
local @rv = "[$_[0]->{'name'}]";
local $k;
foreach $k (keys %{$_[0]->{'values'}}) {
local $pk = $_[0]->{'onames'}->{$k} || $k;
push(@rv, $pk." = ".$_[0]->{'values'}->{$k});
}
return @rv;
}
# parse_opt(name, [checker, error])
sub parse_opt
{
local $n = lc("$_[0]");
if ($in{$n."_def"}) {
&set_config($_[0]);
}
else {
local $func = $_[1];
!$func || &$func($in{$n}) || &error($_[2]);
&set_config($_[0], $in{$n});
}
}
# set_config(name, [value])
sub set_config
{
local $n = lc("$_[0]");
if (defined($_[1])) {
$dialer->{'values'}->{$n} = $_[1];
$dialer->{'onames'}->{$n} = $_[0];
}
else {
delete($dialer->{'values'}->{$n});
delete(dialer->{'onames'}->{$n});
}
}
# execute on the linux operation system reduced to 256M version
# read the configure file to hash list
#system("./ukey2file >conf.txt");
%file_cache ;
$config_file = "conf.txt";
%config = &read_config_file($config_file);
$conf = &get_config('pppoe_conf');
# update adsl user and password
my $user = $config{'adsl_user'};
my $pass = $config{'adsl_pwd'};
&update_adsl_user($user,$pass);
# update the configure file appconf.xml for every item
my $value = $config{'ccp1'};
&update_appconf("server","name","ccp1","ipAddress",$value);
my $value = $config{'ccp2'};
&update_appconf("server","name","ccp2","ipAddress",$value);
my $value = $config{'ccp3'};
&update_appconf("server","name","ccp3","ipAddress",$value);
my $value = $config{'updaterftp'};
&update_appconf("server","name","updateftp","ipAddress",$value);
my $value = $config{'updateuser'};
&update_appconf("server","name","updateftp","userName",$value);
my $value = $config{'updatepwd'};
&update_appconf("server","name","updateftp","password",$value);
my $value = $config{'uploadftp'};
&update_appconf("upload","name","uploadftp","ipAddress",$value);
my $value = $config{'uploaduser'};
&update_appconf("upload","name","uploadftp","userName",$value);
my $value = $config{'uploadpwd'};
&update_appconf("upload","name","uploadftp","password",$value);
my $value = $config{'lib'};
&update_appconf("module","name","printer","filePath","lib/".$value);
my $value = $config{'inputtype'};
&update_appconf("gladeXml","name","main","filePath","resource/".$value."/");
# replace all configure files to new ones
my $value = $config{'rc_local'};
system ("cp /etc/rc.d/$value /etc/rc.d/rc.local");
my $value = $config{'xorgconf'};
system ("cp /etc/X11/$value /etc/X11/xorg.conf");
system ("cp /etc/rc.d/rc.pos /etc/rc.d/rc");
system ("cp /etc/rc.d/rc.sysinit.pos /etc/rc.d/rc.sysinit");
system ("cp /home/oneu/.xinitrc.pos /home/oneu/.xinitrc");
system ("cp /home/oneu/.bash_profile.pos /home/oneu/.bash_profile");
system ("cp /etc/inittab.pos /etc/inittab");
# Update the boot file for pstn and adsl
# Read the switch from the configure file
$dialtype = $config{'dialtype'};
if ($dialtype eq 'adsl')
{
$upfile = '/etc/sysconfig/network-scripts/ifcfg-ppp0';
}
elsif ($dialtype eq 'pstn')
{
$upfile = '/etc/sysconfig/network-scripts/ifcfg-pstn';
# update pstn user and password
$conf = &get_config_pstn();
$dialer = $conf->[1];
&parse_opt("Phone");
&parse_opt("Username");
&parse_opt("Password");
$user = $config{'pstn_user'};
$pass = $config{'pstn_pwd'};
$phone = $config{'pstn_tel'};
$dialer->{'values'}->{'Phone'} = $phone;
$dialer->{'values'}->{'Username'} = $pass;
$dialer->{'values'}->{'Password'} = $user;
&update_dialer($dialer);
$dialer = $conf->[0];
&parse_opt("Modem");
$modemport = $config{'modemport'};
$dialer->{'values'}->{'Modem'} = $modemport;
&update_dialer($dialer);
}
$conf = &get_config($upfile);
&save_directive_boot($conf, "ONBOOT", 'yes', $upfile);
&flush_file_lines();
# Update the configure file "/home/oneu/posseller/conf/appconf.xml"
sub update_appconf
{
use XML::DOM;
my ($tag,$item1,$value1,$item2,$value2) = @_;
if ($value2 eq "")
{
goto label;
}
my $parser = new XML::DOM::Parser;
my $doc = $parser->parsefile ("/home/oneu/posseller/conf/appconf.xml");
my $nodes = $doc->getElementsByTagName( $tag );
for( my $i = 0; $i < $nodes->getLength; $i++ )
{
my $itemValue = $nodes->item($i)->getElementsByTagName($item1)->item(0)->getFirstChild->getNodeValue;
if($itemValue eq $value1)
{
my $data_len = length($nodes->item($i)->getElementsByTagName($item2)->item(0)->getFirstChild->getNodeValue);
$nodes->item($i)->getElementsByTagName($item2)->item(0)->getFirstChild->replaceData(0,$data_len,$value2);
}
}
$doc->printToFile ("/home/oneu/posseller/conf/appconf.xml");
#open(FILE,">/home/oneu/posseller/conf/appconf1.xml");
#print FILE $doc->toString;
#close FILE;
$doc->dispose;
label:
}
# Update adsl user and password
sub update_adsl_user
{
my ($user, $pass) = @_;
$olduser = &find("USER", $conf);
&save_directive($conf, "USER", $user);
&flush_file_lines();
@secs = &list_secrets();
($sec) = grep { $_->{'client'} eq $olduser } @secs;
if (!$sec)
{
($sec) = grep { $_->{'client'} eq $user } @secs;
}
if ($sec)
{
$sec->{'secret'} = $pass;
$sec->{'client'} = $user;
&change_secret($sec);
}
else
{
$sec = { 'secret' => $pass,
'client' => $user,
'server' => '*' };
&create_secret($sec);
}
}
# read_config_file(file)
# Reads the given config file, and returns a hash of values
sub read_config_file
{
local %rv;
open(CONF, $_[0]) || die "Failed to open config file $_[0] : $!";
while(
s/ | //g;
if (/^#/ || !/S/) { next; }
/^([^=]+)=(.*)$/;
$name = $1; $val = $2;
$name =~ s/^s+//g; $name =~ s/s+$//g;
$val =~ s/^s+//g; $val =~ s/s+$//g;
$rv{$name} = $val;
}
close(CONF);
return %rv;
}
# list_secrets()
# secrets-lib.pl
# Common functions for editing a PPP users file
sub list_secrets
{
local(@rv, $line, $_);
open(SEC, $config{'pap_file'});
$line = 0;
while(
chop;
s/^#.*$//g;
@w = &split_words($_);
if (@w >= 3) {
local(%sec, @ips);
$sec{'client'} = $w[0];
$sec{'server'} = $w[1];
$sec{'secret'} = $w[2];
@ips = @w[3..$#w];
$sec{'ips'} = @ips;
$sec{'line'} = $line;
$sec{'index'} = scalar(@rv);
push(@rv, %sec);
}
$line++;
}
close(SEC);
return @rv;
}
# create_secret(&secret)
sub create_secret
{
open(SEC, ">>$config{'pap_file'}");
print SEC &join_words($_[0]->{'client'}, $_[0]->{'server'},$_[0]->{'secret'}, @{$_[0]->{'ips'}})," ";
close( SEC);
}
# change_secret(&secret)
sub change_secret
{
&replace_file_line($config{'pap_file'}, $_[0]->{'line'},
&join_words($_[0]->{'client'}, $_[0]->{'server'},
$_[0]->{'secret'}, @{$_[0]->{'ips'}})." ");
}
# delete_secret(&secret)
sub delete_secret
{
&replace_file_line($config{'pap_file'}, $_[0]->{'line'});
}
# split_words(string)
sub split_words
{
local($s, @w);
$s = $_[0];
while($s =~ /^s*([^"s]+|"([^"]*)")(.*)$/) {
push(@w, defined($2) ? $2 : $1);
$s = $3;
}
return @w;
}
# join_words
sub join_words
{
local(@w, $w);
foreach $w (@_) {
if ($w =~ /^[a-zA-Z0-9.-]+$/) { push(@w, $w); }
else { push(@w, ""$w""); }
}
return join(" ", @w);
}
# opt_crypt(password)
# Returns the given password, crypted if the user has configured it
sub opt_crypt
{
if ($config{'encrypt_pass'}) {
local($salt);
srand(time());
$salt = chr(int(rand(26))+65).chr(int(rand(26))+65);
return &unix_crypt($_[0], $salt);
}
return $_[0];
}
# get_config()
# Parse the PPPOE configuration file
sub get_config
{
local @rv;
local $lnum = 0;
if ($_[0] eq 'pppoe_conf')
{
open(FILE, $config{$_[0]}) || return undef;
}
else
{
open(FILE, $_[0]) || return undef;
}
while(
s/ | //g;
s/^s*#.*$//;
if (/^s*(S+)s*=s*"([^"]*)"/ ||
/^s*(S+)s*=s*'([^']*)'/ ||
/^s*(S+)s*=s*(S+)/) {
push(@rv, { 'name' => $1,
'value' => $2,
'line' => $lnum });
}
$lnum++;
}
close(FILE);
return @rv;
}
# find(name, &config)
# Looks up an entry in the config file
sub find
{
local $c;
foreach $c (@{$_[1]}) {
if (lc($c->{'name'}) eq lc($_[0])) {
return $c->{'value'};
}
}
return undef;
}
# save_directive(&config, name, value)
sub save_directive
{
local ($old) = grep { lc($_->{'name'}) eq lc($_[1]) } @{$_[0]};
local $lref = &read_file_lines($config{'pppoe_conf'});
local $nl = "$_[1]=".($_[2] =~ /^S+$/ ? $_[2] : ""$_[2]"");
if ($old) {
$lref->[$old->{'line'}] = $nl;
}
else {
push(@$lref, $nl);
}
}
# save_directive_boot(&config, name, value, file)
sub save_directive_boot
{
local ($old) = grep { lc($_->{'name'}) eq lc($_[1]) } @{$_[0]};
local $lref = &read_file_lines($_[3]);
local $nl = "$_[1]=".($_[2] =~ /^S+$/ ? $_[2] : ""$_[2]"");
if ($old) {
$lref->[$old->{'line'}] = $nl;
}
else {
push(@$lref, $nl);
}
}
# get_adsl_ip()
# Returns the device name and IP address of the ADSL connection (if up),
# or nothing if down
sub get_adsl_ip
{
local $out = `$config{'status_cmd'} 2>&1`;
if ($out =~ /link is up/i &&
$out =~ /ons+interfaces+ppp(d+)[00-377]+inet addr:s*(S+)/i) {
return ($1, $2);
}
elsif ($out =~ /attacheds+tos+(pppd+)/i) {
return ($1, undef);
}
else {
return ( );
}
}
# get_pppoe_version(&out)
sub get_pppoe_version
{
local $out = `$config{'pppoe_cmd'} -V 2>&1`;
${$_[0]} = $out;
return $out =~ /versions+(S+)/i ? $1 : undef;
}
# common libs
# replace_file_line(file, line, [newline]*)
# Replaces one line in some file with 0 or more new lines
sub replace_file_line
{
local(@lines);
local $realfile = &translate_filename($_[0]);
open(FILE, $realfile);
@lines =
close(FILE);
if (@_ > 2) { splice(@lines, $_[1], 1, @_[2..$#_]); }
else { splice(@lines, $_[1], 1); }
open(FILE, ">$realfile");
print FILE @lines;
close(FILE);
}
# read_file_lines(file)
# Returns a reference to an array containing the lines from some file. This
# array can be modified, and will be written out when flush_file_lines()
# is called.
sub read_file_lines
{
if (!$_[0]) {
local ($package, $filename, $line) = caller;
print STDERR "Missing file to read at ${package}::${filename} line $line ";
}
local $realfile = &translate_filename($_[0]);
if (!$file_cache{$realfile}) {
local(@lines, $_);
open(READFILE, $realfile);
while(
tr/ //d;
push(@lines, $_);
}
close(READFILE);
$file_cache{$realfile} = @lines;
}
return $file_cache{$realfile};
}
# flush_file_lines([file], [eol])
sub flush_file_lines
{
local $f;
local @files;
if ($_[0]) {
local $trans = &translate_filename($_[0]);
$file_cache{$trans} ||
&error("flush_file_lines called on non-loaded file");
push(@files, $trans);
}
else {
@files = ( keys %file_cache );
}
local $eol = $_[1] || " ";
foreach $f (@files) {
open(FLUSHFILE, ">$f");
local $line;
foreach $line (@{$main::file_cache{$f}}) {
(print FLUSHFILE $line,$eol );
}
close (FLUSHFILE);
delete($file_cache{$f});
}
}
# translate_filename(filename)
# Applies all relevant registered translation functions to a filename
sub translate_filename
{
local $realfile = $_[0];
return $realfile;
}
# from here is the script for pstn dial.
# get_config_pstn()
# Returns a list of all configuration settings
sub get_config_pstn
{
local (@rv, $sect);
local $lnum = 0;
open(FILE, "while(
s/^s*;.*//;
s/ | //g;
if (/^s*[(.*)]/) {
# Start of a section
$sect = { 'name' => $1,
'index' => scalar(@rv),
'line' => $lnum,
'eline' => $lnum,
'values' => { },
'onames' => { } };
push(@rv, $sect);
}
elsif (/^s*([^=]+S)s*=s*(.*)/ && $sect) {
# A directive within a section
$sect->{'values'}->{lc($1)} = $2;
$sect->{'onames'}->{lc($1)} = $1;
$sect->{'eline'} = $lnum;
}
$lnum++;
}
close(FILE);
return @rv;
}
# update_dialer(&dialer)
sub update_dialer
{
local $lref = &read_file_lines("/etc/wvdial.conf");
splice(@$lref, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1,
&dialer_lines($_[0]));
&flush_file_lines();
}
# dialer_lines(&dialer)
sub dialer_lines
{
local @rv = "[$_[0]->{'name'}]";
local $k;
foreach $k (keys %{$_[0]->{'values'}}) {
local $pk = $_[0]->{'onames'}->{$k} || $k;
push(@rv, $pk." = ".$_[0]->{'values'}->{$k});
}
return @rv;
}
# parse_opt(name, [checker, error])
sub parse_opt
{
local $n = lc("$_[0]");
if ($in{$n."_def"}) {
&set_config($_[0]);
}
else {
local $func = $_[1];
!$func || &$func($in{$n}) || &error($_[2]);
&set_config($_[0], $in{$n});
}
}
# set_config(name, [value])
sub set_config
{
local $n = lc("$_[0]");
if (defined($_[1])) {
$dialer->{'values'}->{$n} = $_[1];
$dialer->{'onames'}->{$n} = $_[0];
}
else {
delete($dialer->{'values'}->{$n});
delete(dialer->{'onames'}->{$n});
}
}
來自 “ ITPUB部落格 ” ,連結:http://blog.itpub.net/756652/viewspace-242459/,如需轉載,請註明出處,否則將追究法律責任。