çÒÕÐÐÁ :: òÁÚÒÁÂÏÔËÁ/Perl
ðÁËÅÔ: perl-Asterisk-config
ÎÁ×ÉÇÁÃÉÑ ÐÏ ÐÁËÅÔÁÍ
çÌÁ×ÎÁÑ éÚÍÅÎÅÎÉÑ óÐÅË ðÁÔÞÉ éÓÈÏÄÎÉËÉ úÁÇÒÕÚÉÔØ Gear Bugs and FR Repocop
Changes 0000755 0000000 0000000 00000001433 10610417341 0012350 0 ustar 00root root 0000000 0000000 0.8 2006-6-2
- new parameter point=>'foot' in assign_append().
- fix dejected \n in do_append() and/or do_delsection().
0.7 2006-4-18
- add addsection.
- fix regexp in sub clean_string.
- fixed the bug of @commit_list dirty-write resulted by more than one instance of Asterisk::config
0.6 2006-2-19
- change load_config parameters to hash struct.
- fix split (.+) to (.*) in sub clean_keyvalue.
- fix split (.+) to (.*) in sub load_config.
- add use Fcntl ':flock' for disable flock warnings.
- more POD docs.
- fix VERSION variable.
- fix $stream_data warnings in load_config using strict.
- fix # warnings in load_config using strict.
0.5 2006-1-6
- support stream in load_config.
- my $VERSION
0.4 2005-12-23
- add assign_matchreplace.
0.1 2005-11-29
- start....
MANIFEST 0000755 0000000 0000000 00000000103 10610417341 0012177 0 ustar 00root root 0000000 0000000 Changes
MANIFEST This list of files
Makefile.PL
README
config.pm
Makefile.PL 0000755 0000000 0000000 00000000355 10610417341 0013031 0 ustar 00root root 0000000 0000000 use ExtUtils::MakeMaker;
WriteMakefile(
AUTHOR => 'Hoowa Sun (hoowa.sun@gmail.com)',
NAME => 'Asterisk::config',
ABSTRACT => 'The Asterisk config read and write module.',
VERSION_FROM => 'config.pm'
);
README 0000755 0000000 0000000 00000001226 10610417341 0011735 0 ustar 00root root 0000000 0000000 This is the README file for Asterisk::config, a module to
read/write Asterisk config.
Asterisk is most popular Opensource PBX in PBX World!
* Installation
Asterisk::config uses the standard perl module install process:
perl Makefile.PL
make
make test(will be come soon)
make install
* Copyright
See COPYRIGHT section in pod text below for usage and
distribution rights.
by hoowa sun P.R.China.
* Introduction
Asterisk::config know how Asterisk config difference with
standard ini config. this moudle make interface for read and
write Asterisk config files and Asterisk extension configs.
Please refer to the POD text for synopsis and usage details.
config.pm 0000755 0000000 0000000 00000045675 10610417341 0012700 0 ustar 00root root 0000000 0000000 package Asterisk::config;
###########################################################
# read and write asterisk config files
###########################################################
# Copyright (c) 2005-2006 hoowa sun P.R.China
#
# See COPYRIGHT section in pod text below for usage and distribution rights.
#
# <hoowa.sun@gmail.com>
# www.perlchina.org / www.openpbx.cn
# last modify 2006-6-2
###########################################################
$Asterisk::config::VERSION='0.8';
use strict;
#0.6-use vars qw/@commit_list/;
use Fcntl ':flock';
sub new {
#0.6- my $self = {};
my $self = {
commit_list => [],
};
bless $self;
return $self;
}
##############################
# METHOD
# load config from file or from stream data
sub load_config {
my $self = shift;
my %args = @_;
# my $filename = shift;
# my $stream_data = shift;
my @DATA;
if (!$args{'stream_data'}) {
open(DATA,"<$args{'filename'}") or die "$!";
@DATA = <DATA>;
close(DATA);
} else {
@DATA = split(/\n/,$args{'stream_data'});
}
chomp(@DATA);
my (%DATA,$last_section_name);
$DATA{'[unsection]'}={};
foreach my $one_line (@DATA) {
my $line_sp=&clean_string($one_line);
next if ($line_sp eq '');#next if just comment
#right [section]???
if ($line_sp =~ /^\[(.+)\]/) {
$DATA{$1}={}; $last_section_name = $1; next;
}
#right sharp "#" ???
if ($line_sp =~ /^\#/) {
my $section_name = $last_section_name;
$section_name = '[unsection]' if (!$section_name);
$DATA{$section_name}{$line_sp}=[] if (!$DATA{$section_name}{$line_sp});
push(@{$DATA{$section_name}{$line_sp}},$line_sp);
next;
}
#right key/value???
if ($line_sp =~ /\=/) {
#split data and key
my ($key,$value)=split(/\=(.*)/,$line_sp);
$key =~ s/^(\s+)//; $key =~ s/(\s+)$//;
$value=~ s/^\>//g; $value =~ s/^(\s+)//; $value =~ s/(\s+)$//;
my $section_name = $last_section_name;
$section_name = '[unsection]' if (!$section_name);
$DATA{$section_name}{$key}=[] if (!$DATA{$section_name}{$key});
push(@{$DATA{$section_name}{$key}},$value);
next;
}
}
return(\%DATA,\@DATA);
}
#####################
# cookie for our
#####################
sub check_nvd {
if (shift=~/[^a-zA-Z0-9\.]/) {
return(0);
} else {
return(1);
}
}
sub check_value {
if (shift=~/[^a-zA-Z0-9]/) {
return(0);
} else {
return(1);
}
}
sub check_digits {
if (shift=~/[^0-9\*\#]/) {
return(0);
} else {
return(1);
}
}
sub check_number {
if (shift=~/[^0-9]/) {
return(0);
} else {
return(1);
}
}
sub check_import_number {
if (shift=~/[^0-9,\s]/) {
return(0);
} else {
return(1);
}
}
##############################
# clean ; data from string end
sub clean_string {
my $string = shift;
return '' unless $string;
($string,undef)=split(/\;/,$string);
#0.6- $string =~ s/^(\s+)//;
#0.6- $string =~ s/(\s+)$//;
#0.6-return($string);
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return($string);
}
# split key value of data
sub clean_keyvalue {
my $string = shift;
my ($key,$value)=split(/\=(.*)/,$string);
$key =~ s/^(\s+)//; $key =~ s/(\s+)$//;
if ($value) {
$value=~ s/^\>//g; $value =~ s/^(\s+)//; $value =~ s/(\s+)$//;
}
return($key,$value);
}
# income scalar,array ref,hash ref output array data
sub format_convert {
my $string = shift;
if (ref($string) eq 'ARRAY') {
return(@$string);
} elsif (ref($string) eq 'HASH') {
my @tmp;
foreach (keys(%$string)) {
push(@tmp,"$_=".$string->{$_});
}
return(@tmp);
} else {
return($string);
}
}
##############################
# METHOD
# clean all assign before
sub clean_assign {
my $self = shift;
undef($self->{commit_list});
#0.6- undef(@commit_list);
}
##############################
# METHOD
# assign_cleanfile ; all data from file
sub assign_cleanfile {
my $self = shift;
my %hash = @_;
$hash{'action'}='cleanfile';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# replace data when matched
# assign_matchreplace(match=>,replace=>);
sub assign_matchreplace {
my $self = shift;
my %hash = @_;
$hash{'action'}='matchreplace';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# assign append in anywhere
# any section: up/down
# assign_append(point=>'up'|'down',section=>,data=>[key=value,key=value]|{key=>value,key=>value}|'key=value');
# any section&key-value: up/down/over
# assign_append(point=>'up'|'down'|'over',section=>,comkey=>[key,value],data=>[key=value,key=value]|{key=>value,key=>value}|'key=value');
# no section:
# assign_append(point=>'up'|'down',data=>[key=value,key=value]|{key=>value,key=>value}|'key=value');
sub assign_append {
my $self = shift;
my %hash = @_;
$hash{'action'}='append';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# replace the section except sharp "#"
# any section/[unsection]:
# assign_replacesection(section=>,data=>[key=value,key=value]|{key=>value,key=>value}|'key=value');
sub assign_replacesection {
my $self = shift;
my %hash = @_;
$hash{'action'}='replacesection';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# delete section
# any section/[unsection]:
# assign_delsection(section=>);
sub assign_delsection {
my $self = shift;
my %hash = @_;
$hash{'action'}='delsection';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# add section
# assign_addsection(section=>sectionname)
sub assign_addsection {
my $self = shift;
my %hash = @_;
$hash{action} = 'addsection';
push(@{$self->{commit_list}}, \%hash);
}
##############################
# METHOD
# edit key
# any section/[unsection]: change all matched key when key value are null.
# assign_editkey(section=>,key=>,value=>,new_value=>);
sub assign_editkey {
my $self = shift;
my %hash = @_;
$hash{'action'}='editkey';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# delete key
# any section/[unsection]: change all matched key when key value are null.
# assign_delkey(section=>,key=>,$value=>);
sub assign_delkey {
my $self = shift;
my %hash = @_;
$hash{'action'}='delkey';
push(@{$self->{commit_list}},\%hash);
#0.6- push(@commit_list,\%hash);
}
##############################
# METHOD
# save to file
# filename: run assign rules and save to file
# save_file(filename=>,resource=>);
sub save_file {
my $self = shift;
my %args = @_;
if (!$args{'resource'}) {
open(DATA,"<$args{'filename'}") or die "$!";
my @DATA = <DATA>;
close(DATA);
chomp(@DATA);
$args{'resource'}=\@DATA;
}
#0.6- foreach my $one_case (@commit_list) {
foreach my $one_case (@{$self->{commit_list}}) {
$args{'resource'} = &do_editkey($one_case,$args{'resource'}) if ($one_case->{'action'} eq 'editkey' || $one_case->{'action'} eq 'delkey');
$args{'resource'} = &do_delsection($one_case,$args{'resource'}) if ($one_case->{'action'} eq 'delsection' || $one_case->{'action'} eq 'replacesection');
$args{'resource'} = &do_addsection($one_case,$args{'resource'}) if ($one_case->{'action'} eq 'addsection');
$args{'resource'} = &do_append($one_case,$args{'resource'}) if ($one_case->{'action'} eq 'append');
$args{'resource'} = &do_matchreplace($one_case,$args{'resource'}) if ($one_case->{'action'} eq 'matchreplace');
if ($one_case->{'action'} eq 'cleanfile') {
undef($args{'resource'});
last;
}
}
#save file
open(SAVE,">$args{'filename'}") or die ("$!");
flock(SAVE,LOCK_EX);
print SAVE grep{$_.="\n"} @{$args{'resource'}};
flock(SAVE,LOCK_UN);
close(SAVE);
return();
}
##########################
# kernel do
sub do_matchreplace {
my $one_case = shift;
my $data = shift;
my @NEW;
foreach my $one_line (@$data) {
if ($one_line =~ /$one_case->{'match'}/) {
$one_line = $one_case->{'replace'};
}
push(@NEW,$one_line);
}
return(\@NEW);
}
sub do_append {
my $one_case = shift;
my $data = shift;
my @NEW;
if ($one_case->{'section'} eq '') {
#Append data head of source data/foot of source data
if ($one_case->{'point'} eq 'up') {
push(@NEW,&format_convert($one_case->{'data'}),@$data);
} else {
push(@NEW,@$data,&format_convert($one_case->{'data'}));
}
} elsif ($one_case->{'comkey'} eq '') {
#0.7- my $auto_save=0;
#0.7- foreach my $one_line (@$data) {
#tune on auto save
#0.7- if ($auto_save) { push(@NEW,$one_line); next; }
#check section
#0.7- my $line_sp=&clean_string($one_line);
#0.7- my ($section_name) = $line_sp =~ /^\[(.+)\]/;
#0.7- if ($one_case->{'section'} eq $section_name & $one_case->{'point'} eq 'up') {
#0.7- push(@NEW,&format_convert($one_case->{'data'})); $auto_save=1;
#0.7- } elsif ($one_case->{'section'} eq $section_name & $one_case->{'point'} eq 'down') {
#0.7- push(@NEW,$one_line); push(@NEW,&format_convert($one_case->{'data'}));
#0.7- $one_line=undef; $auto_save=1;
#0.7- }
#0.7- push(@NEW,$one_line);
#0.7- }
#Append data head/foot of section_name
my $auto_save=0; my $save_tmpmem=0; my $offset=0;
foreach my $one_line (@$data) {
#tune on auto save
if ($auto_save) { push(@NEW,$one_line); $offset++; next; }
#check section
my $line_sp=&clean_string($one_line); my ($section_name) = $line_sp =~ /^\[(.+)\]/;
# for up / down
if ($one_case->{'section'} eq $section_name & $one_case->{'point'} eq 'up') {
push(@NEW,&format_convert($one_case->{'data'})); $auto_save=1;
} elsif ($one_case->{'section'} eq $section_name & $one_case->{'point'} eq 'down') {
push(@NEW,$one_line); $one_line=&format_convert($one_case->{'data'}); $auto_save=1;
# for foot ·¢ÏÖÆ¥ÅäµÄsection
} elsif ($one_case->{'section'} eq $section_name & $one_case->{'point'} eq 'foot') {
$save_tmpmem=1;
# for foot ·¢ÏÖÒª´ÓÆ¥ÅäµÄsection»»³ÉÐÂsection
} elsif ($save_tmpmem == 1 && $section_name && $one_case->{'section'} ne $section_name) {
push(@NEW,&format_convert($one_case->{'data'})); $auto_save=1; $save_tmpmem=0;
# for foot ·¢ÏÖÆ¥ÅäµÄsectionÒѾµ½´ïÕû¸ö½áβ
}
if ($save_tmpmem == 1 && $offset==$#{$data}) {
push(@NEW,$one_line); $one_line=&format_convert($one_case->{'data'});
$auto_save=1; $save_tmpmem=0;
}
push(@NEW,$one_line);
$offset++;
}
} else {
my $last_section_name='[unsection]'; #µ±Ç°ÊÇĬÈϵÄsection
my $auto_save=0;
foreach my $one_line (@$data) {
#tune on auto save
if ($auto_save) { push(@NEW,$one_line); next; }
my $line_sp=&clean_string($one_line);
#¼ì²éµ±Ç°ÊDz»ÊǽøÈëÁËеÄsection
if ($line_sp =~ /^\[(.+)\]/) {
$last_section_name = $1;
} elsif ($last_section_name eq $one_case->{'section'} & $line_sp =~ /\=/) {
#split data and key
my ($key,$value)=&clean_keyvalue($line_sp);
if ($key eq $one_case->{comkey}[0] & $value eq $one_case->{comkey}[1] & $one_case->{'point'} eq 'up') {
push(@NEW,&format_convert($one_case->{'data'})); $auto_save=1;
} elsif ($key eq $one_case->{comkey}[0] & $value eq $one_case->{comkey}[1] & $one_case->{'point'} eq 'down') {
#0.7- push(@NEW,$one_line); push(@NEW,&format_convert($one_case->{'data'}));
#0.7- $one_line=undef; $auto_save=1;
push(@NEW,$one_line); $one_line=&format_convert($one_case->{'data'});
$auto_save=1;
} elsif ($key eq $one_case->{comkey}[0] & $value eq $one_case->{comkey}[1] & $one_case->{'point'} eq 'over') {
#0.7- push(@NEW,&format_convert($one_case->{'data'}));
#0.7- $one_line=undef; $auto_save=1;
$one_line=&format_convert($one_case->{'data'}); $auto_save=1;
}
}
push(@NEW,$one_line) #0.7- if ($one_line);
}
}
return(\@NEW);
}
sub do_delsection {
my $one_case = shift;
my $data = shift;
my @NEW;
my $last_section_name='[unsection]'; #µ±Ç°ÊÇĬÈϵÄsection
my $auto_save=0;
push(@NEW,&format_convert($one_case->{'data'})) if ($one_case->{'section'} eq '[unsection]' and $one_case->{'action'} eq 'replacesection');
foreach my $one_line (@$data) {
#tune on auto save
if ($auto_save) { push(@NEW,$one_line); next; }
my $line_sp=&clean_string($one_line);
if ($last_section_name eq $one_case->{'section'} & $line_sp =~ /^\[(.+)\]/) {
#when end of compared section and come new different section
$auto_save = 1;
} elsif ($last_section_name eq $one_case->{'section'}) {
next;
} elsif ($line_sp =~ /^\[(.+)\]/) {
#is this new section?
if ($one_case->{'section'} eq $1) {
$last_section_name = $1;
next if ($one_case->{'action'} eq 'delsection');
push(@NEW,$one_line);
#0.7- push(@NEW,&format_convert($one_case->{'data'}));
#0.7- $one_line=undef;
$one_line=&format_convert($one_case->{'data'});
}
}
push(@NEW,$one_line);
}
return(\@NEW);
}
sub do_addsection {
my $one_case = shift;
my $data = shift;
my $exists = 0;
my $section = '[' . $one_case->{section} . ']';
foreach my $one_line(@$data) {
my $line_sp=&clean_string($one_line);
if($line_sp =~ /^\[.+\]/) {
if ($section eq $line_sp) {
$exists = 1;
last;
}
}
}
unless($exists) {
push(@$data, $section);
}
return $data;
}
sub do_editkey {
my $one_case = shift;
my $data = shift;
my @NEW;
my $last_section_name='[unsection]'; #µ±Ç°ÊÇĬÈϵÄsection
my $auto_save=0;
foreach my $one_line (@$data) {
#tune on auto save
if ($auto_save) { push(@NEW,$one_line); next; }
my $line_sp=&clean_string($one_line);
#¼ì²éµ±Ç°ÊDz»ÊǽøÈëÁËеÄsection
if ($line_sp =~ /^\[(.+)\]/) {
$last_section_name = $1;
} elsif ($last_section_name eq $one_case->{section} & $line_sp =~ /\=/) {
#split data and key
my ($key,$value)=&clean_keyvalue($line_sp);
if ($key eq $one_case->{'key'} && !$one_case->{'value'}) { #´¦ÀíÈ«²¿Æ¥ÅäµÄkeyµÄvalueÖµ
$one_line = "$key=".$one_case->{'new_value'};
undef($one_line) if ($one_case->{'action'} eq 'delkey');
} elsif ($key eq $one_case->{'key'} && $one_case->{'value'} eq $value) { #´¦ÀíΨһƥÅäµÄkeyµÄvalueÖµ
$one_line = "$key=".$one_case->{'new_value'};
undef($one_line) if ($one_case->{'action'} eq 'delkey');
$auto_save = 1;
}
}
push(@NEW,$one_line) if ($one_line);
}
return(\@NEW);
}
=head1 NAME
Asterisk::config - the Asterisk config read and write module.
=head1 SYNOPSIS
use Asterisk::config;
my $rc = new Asterisk::config;
my ($cfg,$res) = $rc->load_config(filename=>[configfile],stream_data=>[strings]);
print $cfg->{'[unsection]'}{'test'}[0];
print $cfg->{'[global]'}{'allow'}[1];
$rc->assign_append(point=>'down',data=>$user_data);
$rc->save_file(filename=>[filename],resource=>$res);
=head1 DESCRIPTION
Asterisk::config know how Asterisk config difference with
standard ini config. this moudle make interface for read and
write Asterisk config files and Asterisk extension configs.
=head1 NOTE
please use = instand of => in your config files.
=head1 METHOD
=head2 new
my $rc = new Asterisk::config;
Instantiates a new object.
=head2 load_config
$rc->(filename=>[configfile],stream_data=>[strings]);
load config from file or from stream data.
=over 2
=item * configfile -> config file path and name.
=item * stream_data -> instead of C<filename>, data from
strings.
=back
=head2 assign_cleanfile
$rc->assign_cleanfile();
be sure clean all data from current file.
=head2 assign_matchreplace
$rc->assign_matchreplace(match=>,replace=>);
replace new data when matched.
=over 2
=item * match -> string of matched data.
=item * replace -> new data.
=back
=head2 assign_append
$rc->assign_append(point=>['up'|'down'|'foot'],
section=>[section],
data=>[key=value,key=value]|{key=>value,key=>value}|'key=value'
);
append data around with section name.
=over 3
=item * point -> append data C<up> / C<down> / C<foot> with section.
=item * section -> matched section name, except [unsection].
=item * data -> new replace data in string/array/hash.
=back
$rc->assign_append(point=>['up'|'down'|'over'],
section=>[section],
comkey=>[key,value],
data=>[key=value,key=value]|{key=>value,key=>value}|'key=value'
);
append data around with section name and key/value in same section.
=over 2
=item * point -> C<over> will overwrite with key/value matched.
=item * comkey -> match key and value.
=back
$rc->assign_append(point=>'up'|'down',
data=>[key=value,key=value]|{key=>value,key=>value}|'key=value'
);
simple append data without any section.
=head2 assign_replacesection
$rc->assign_replacesection(section=>[section],
data=>[key=value,key=value]|{key=>value,key=>value}|'key=value'
);
replace the section body data,except "#" in body.
=over 1
=item * section -> all section and [unsection].
=back
=head2 assign_delsection
$rc->assign_delsection(section=>[section]);
erase section name and section data.
=over 1
=item * section -> all section and [unsection].
=back
=head2 assign_addsection
$rc->assign_addsection(section=>[section]);
add section with name.
=over 1
=item * section -> name of new section.
=back
=head2 assign_editkey
$rc->assign_editkey(section=>[section],key=>[keyname],value=>[value],new_value=>[new_value]);
modify value with matched section.if don't assign value=> will replace all matched key.
exp script:
$rc->assign_editkey(section=>'990001',key=>'all',new_value=>'gsm');
data:
all=g711
all=ilbc
will convert to:
all=gsm
all=gsm
=head2 assign_delkey
$rc->assign_delkey(section=>[section],key=>[keyname],value=>[value]);
erase all matched C<keyname> in section or in [unsection].
=head2 save_file
$rc->save_file(filename=>[filename],resource=>[resource]);
process assign rules and save to file.
=over 2
=item * filename -> save to file name.
=item * resource -> instand of filename must resource return load_config or
file handle.
=back
=head2 clean_assign
$rc->clean_assign();
clean all assign rules.
=head1 EXAMPLES
be come soon...
=head1 AUTHORS
Asterisk::config by hoowa sun.
Version 0.7 patch by Liu Hailong.
=head1 COPYRIGHT
The Asterisk::config module is Copyright (c) 2005-2006 hoowa sun. P.R.China.
All rights reserved.
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.
=head1 WARRANTY
The Asterisk::config is free Open Source software.
IT COMES WITHOUT WARRANTY OF ANY KIND.
=head1 SUPPORT
Email(Chinese & English) hoowa.sun@gmail.com
Chinese OpenPBX technology Forum http://www.openpbx.cn
Chinese Perl Forum http://bbs.perlchina.org
=cut
1;