Changes000075500000000000000000000014331061041734100123500ustar00rootroot000000000000000.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.... MANIFEST000075500000000000000000000001031061041734100121770ustar00rootroot00000000000000Changes MANIFEST This list of files Makefile.PL README config.pm Makefile.PL000075500000000000000000000003551061041734100130310ustar00rootroot00000000000000use 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' ); README000075500000000000000000000012261061041734100117350ustar00rootroot00000000000000This 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.pm000075500000000000000000000456751061041734100127000ustar00rootroot00000000000000package 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. # # # 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 = ; 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 = ; 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); #检查当前是不是进入了新的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); #检查当前是不是进入了新的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, 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 / C / C 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 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 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;