our
$VERSION
=
'6.1.0'
;
sub
new {
my
%args
;
if
(
defined
(
$_
[1])){
%args
= %{
$_
[1]};
};
my
$self
= {
conf
=>{},
args
=>{
%args
},
set
=>{},
zconf
=>{},
user
=>{},
perror
=>
undef
,
error
=>
undef
,
errorString
=>
""
,
meta
=>{},
comment
=>{},
module
=>__PACKAGE__,
revision
=>{},
locked
=>{},
autoupdateGlobal
=>1,
autoupdate
=>{},
};
bless
$self
;
if
(!
defined
(
$self
->{args}{file})){
$self
->{args}{file}=xdg_config_home().
"/zconf.zml"
;
if
(!-f
$self
->{args}{file}){
if
(
open
(
"CREATECONFIG"
,
'>'
,
$self
->{args}{file})){
print
CREATECONFIG
"fileonly=1\nreadfallthrough=1\n"
;
close
(
"CREATECONFIG"
);
}
else
{
print
"zconf new error: '"
.
$self
->{args}{file}.
"' could not be opened.\n"
;
return
undef
;
}
}
}
my
$zconfzmlstring
=
""
;
if
(
open
(
"READZCONFZML"
,
$self
->{args}{file})){
$zconfzmlstring
=
join
(
""
, <READZCONFZML>);
my
$tempstring
;
close
(
"READZCONFZML"
);
}
else
{
print
"zconf new error: Could not open'"
.
$self
->{args}{file}.
"\n"
;
return
undef
;
}
my
$zml
=ZML->new();
$zml
->parse(
$zconfzmlstring
);
if
(
$zml
->{error}){
$self
->{error}=28;
$self
->{errorString}=
"ZML\-\>parse error, '"
.
$zml
->{error}.
"', '"
.
$zml
->{errorString}.
"'"
;
$self
->
warn
;
return
$self
;
}
$self
->{zconf}=
$zml
->{var};
$self
->{args}{zconf}=
$self
->{zconf};
if
(
defined
(
$self
->{zconf}{defaultChooser})){
my
(
$success
,
$choosen
)=choose(
$self
->{zconf}{defaultChooser});
if
(
$success
){
if
(setNameLegit(
$choosen
)){
$self
->{args}{
default
}=
$choosen
;
}
else
{
$self
->{args}{
default
}=
"default"
;
}
}
else
{
$self
->{args}{
default
}=
"default"
;
}
}
else
{
if
(
defined
(
$self
->{zconf}{
default
})){
$self
->{args}{
default
}=
$self
->{zconf}{
default
};
}
else
{
$self
->{args}{
default
}=
"default"
;
}
}
if
(!
defined
(
$self
->{zconf}{fileonly})){
$self
->{zconf}->{args}{fileonly}=
"0"
;
}
else
{
$self
->{args}{fileonly}=
$self
->{zconf}{fileonly};
}
if
(
$self
->{args}{fileonly} eq
"0"
){
if
(
defined
(
$self
->{zconf}{backendChooser})){
my
(
$success
,
$choosen
)=choose(
$self
->{zconf}{backendChooser});
if
(
$success
){
$self
->{args}{backend}=
$choosen
;
}
else
{
if
(
defined
{
$self
->{zconf}{backend}}){
$self
->{args}{backend}=
$self
->{zconf}{backend};
}
else
{
$self
->{args}{backend}=
"file"
;
}
}
}
else
{
if
(
defined
(
$self
->{zconf}{backend})){
$self
->{args}{backend}=
$self
->{zconf}{backend};
}
else
{
$self
->{args}{backend}=
"file"
;
}
}
}
else
{
$self
->{args}{backend}=
"file"
;
}
my
@modules
=
keys
( %{list_modules(
"ZConf::backends::"
,{
list_modules
=>1})} );
my
$int
=0;
my
$backendLegit
=0;
while
(
$modules
[
$int
]) {
my
$beTest
=
$modules
[
$int
];
$beTest
=~s/ZConf\:\:backends\:\://g;
if
(
$beTest
eq
$self
->{args}{backend}) {
$backendLegit
=1;
}
$int
++;
}
if
(!
$backendLegit
){
$self
->{error}=14;
$self
->{errorString}=
"The backend '"
.
$self
->{args}{backend}.
"' is not a recognized backend"
;
$self
->
warn
;
return
$self
}
$self
->{args}{self}=
$self
;
my
$backend
=
$self
->initBackend(
$self
->{args}{backend});
my
$error
=0;
if
(
$self
->error || (!
defined
(
$backend
))) {
if
(
$self
->error ) {
$self
->
warn
;
}
else
{
$self
->
warn
;
}
$self
->warnString(
'Using file backend'
);
$error
=1;
}
else
{
if
(
$backend
->error) {
$self
->warnString(
'Backend errored using. Using file backend'
);
$error
=1;
}
else
{
$self
->{be}=
$backend
;
}
}
if
(
$self
->{args}{backend} ne
'file'
) {
$backend
=
$self
->initBackend(
'file'
);
if
(
$self
->error ||
$backend
->error
) {
$self
->{error}=
'11'
;
$self
->{errorStirng}=
'Failed to intiate file backend'
;
$self
->
warn
;
return
$self
;
}
if
(
defined
(
$self
->{be} )) {
$self
->{fbe}=
$backend
;
}
else
{
$self
->{be}=
$backend
;
}
}
return
$self
;
}
sub
chooseSet{
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
my
$chooserstring
=
$self
->readChooser(
$config
);
if
(
$chooserstring
eq
''
) {
return
$self
->{args}{
default
};
}
if
(
$chooserstring
eq
"\n"
) {
return
$self
->{args}{
default
};
}
my
(
$success
,
$choosen
)=choose(
$chooserstring
);
if
(!
defined
(
$choosen
)){
return
$self
->{args}{
default
};
}
if
(!
$self
->setNameLegit(
$choosen
)){
$self
->{error}=27;
$self
->{errorString}=
'"'
.
$choosen
."' is not a legit set name. Using the".
" default of '"
.
$self
->{args}{
default
}.
"'."
;
$self
->
warn
;
return
$self
->{args}{
default
};
}
return
$choosen
;
}
sub
configExists{
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->configExists(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} ) {
$returned
=
$self
->{fbe}->configExists(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
return
$returned
;
}
sub
configNameCheck{
my
(
$self
,
$name
) =
@_
;
$self
->errorblank;
if
(!
defined
(
$name
)){
return
(
"11"
,
"config name is not defined."
);
}
if
(
$name
=~ /,/){
return
(
"1"
,
"config name,'"
.
$name
.
"', contains ','"
);
}
if
(
$name
=~ /\/\./){
return
(
"2"
,
"config name,'"
.
$name
.
"', contains '/.'"
);
}
if
(
$name
=~ /\/\//){
return
(
"3"
,
"config name,'"
.
$name
.
"', contains '//'"
);
}
if
(
$name
=~ /\.\.\//){
return
(
"4"
,
"config name,'"
.
$name
.
"', contains '../'"
);
}
if
(
$name
=~ /\/\.\./){
return
(
"5"
,
"config name,'"
.
$name
.
"', contains '/..'"
);
}
if
(
$name
=~ /^\.\//){
return
(
"6"
,
"config name,'"
.
$name
.
"', matched /^\.\//"
);
}
if
(
$name
=~ /\/$/){
return
(
"7"
,
"config name,'"
.
$name
.
"', matched /\/$/"
);
}
if
(
$name
=~ /^\//){
return
(
"8"
,
"config name,'"
.
$name
.
"', matched /^\//"
);
}
if
(
$name
=~ /\n/){
return
(
"10"
,
"config name,'"
.
$name
.
"', matched /\\n/"
);
}
return
(
undef
,
""
);
}
sub
createConfig{
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
undef
;
$self
->{be}->createConfig(
$config
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ){
if
(!
$self
->{fbe}->configExists(
$config
)){
my
$syncReturn
=
$self
->{fbe}->createConfig(
$config
);
if
(
$self
->{fbe}->error ){
$self
->
warn
;
}
}
}
return
1;
}
sub
defaultSetExists{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$config
)){
$self
->{error}=12;
$self
->{errorString}=
'The specified config, "'
.
$config
.
'" does not exist'
;
$self
->
warn
;
return
undef
;
}
my
$set
=
$self
->chooseSet(
$config
);
if
(
defined
(
$self
->{error})){
return
undef
;
}
my
@sets
=
$self
->getAvailableSets(
$config
);
if
(
$self
->error) {
$self
->warnString(
'getAvailableSets errored'
);
return
undef
;
}
my
$int
=0;
while
(
defined
(
$sets
[
$int
])) {
if
(
$set
eq
$sets
[
$int
]) {
return
1;
}
$int
++;
}
return
undef
;
}
sub
delConfig{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)) {
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
my
@subs
=
$self
->getSubConfigs(
$config
);
if
(
defined
(
$self
->{error})) {
return
undef
;
}
if
(
defined
(
$subs
[0])) {
$self
->{error}=33;
$self
->{errorString}=
'Could not remove the config as it has sub configs.'
;
$self
->
warn
;
return
undef
;
}
$self
->{be}->delConfig(
$config
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ){
if
(
$self
->{fbe}->configExists(
$config
)){
my
$syncReturn
=
$self
->{fbe}->createConfig(
$config
);
if
(
$self
->{fbe}->error ){
$self
->
warn
;
}
}
}
return
1;
}
sub
delSet{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$set
=
$_
[2];
$self
->errorblank;
if
(!
defined
(
$set
)){
$self
->{error}=24;
$self
->{errorString}=
'$set not defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->configExists(
$config
);
if
(
defined
(
$self
->{error})){
$self
->{error}=12;
$self
->{errorString}=
'The config "'
.
$config
.
'" does not exist'
;
$self
->
warn
;
return
undef
;
}
$self
->{be}->delSet(
$config
,
$set
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ){
if
(
$self
->{fbe}->setExists) {
my
$syncReturn
=
$self
->{fbe}->delSet(
$config
,
$set
);
if
(
$self
->{fbe}->error ){
$self
->warnString(
'File backend sync failed. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
);
}
}
}
return
$returned
;
}
sub
dumpToZML{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
$zml
=ZML->new();
my
$varhashkeysInt
=0;
my
@varhashkeys
=
keys
(%{
$self
->{conf}{
$config
}});
while
(
defined
(
$varhashkeys
[
$varhashkeysInt
])){
$zml
->addVar(
$varhashkeys
[
$varhashkeysInt
],
$self
->{conf}{
$config
}{
$varhashkeys
[
$varhashkeysInt
]});
if
(
defined
(
$zml
->{error})){
$self
->warnString(
':23: $zml->add() returned '
.
$zml
->{error}.
", '"
.
$zml
->{errorString}.
"'. Skipping variable '"
.
$varhashkeys
[
$varhashkeysInt
].
"' in '"
.
$config
.
"'."
);
}
$varhashkeysInt
++;
}
$varhashkeysInt
=0;
@varhashkeys
=
keys
(%{
$self
->{meta}{
$config
}});
while
(
defined
(
$varhashkeys
[
$varhashkeysInt
])){
my
@metahashkeys
=
keys
( %{
$self
->{meta}{
$config
}{
$varhashkeys
[
$varhashkeysInt
] }} );
my
$metahashkeysInt
=0;
while
(
defined
(
$metahashkeys
[
$metahashkeysInt
])) {
$zml
->addMeta(
$varhashkeys
[
$varhashkeysInt
],
$metahashkeys
[
$metahashkeysInt
],
$self
->{meta}{
$config
}{
$varhashkeys
[
$varhashkeysInt
] }{
$metahashkeys
[
$metahashkeysInt
] }
);
$metahashkeysInt
++;
}
$varhashkeysInt
++;
}
$varhashkeysInt
=0;
@varhashkeys
=
keys
(%{
$self
->{comment}{
$config
} });
while
(
defined
(
$varhashkeys
[
$varhashkeysInt
])){
my
@commenthashkeys
=
keys
( %{
$self
->{self}->{comment}{
$config
}{
$varhashkeys
[
$varhashkeysInt
] }} );
my
$commenthashkeysInt
=0;
while
(
defined
(
$commenthashkeys
[
$commenthashkeysInt
])) {
$zml
->addComment(
$varhashkeys
[
$varhashkeysInt
],
$commenthashkeys
[
$commenthashkeysInt
],
$self
->{comment}{
$config
}{
$varhashkeys
[
$varhashkeysInt
] }{
$commenthashkeys
[
$commenthashkeysInt
] }
);
$commenthashkeysInt
++;
}
$varhashkeysInt
++;
}
return
$zml
;
}
sub
getAutoupdate{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)) {
return
$self
->{autoupdateGlobal};
}
if
(
defined
(
$self
->{autoupdate}{
$config
} )) {
return
$self
->{autoupdate}{
$config
};
}
return
$self
->{autoupdateGlobal};
}
sub
getAvailableSets{
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$config
)){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$config
.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
my
@returned
=
$self
->{be}->getAvailableSets(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
@returned
=
$self
->{fbe}->getAvailableSets(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
return
@returned
;
}
sub
getDefault{
my
(
$self
)=
@_
;
$self
->errorblank;
return
$self
->{args}{
default
};
}
sub
getComments {
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1});
if
(!
defined
(
$self
->{comment}{
$config
})){
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{comment}{
$config
}});
return
@keys
;
}
sub
getConfigRevision{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$config
)){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$config
.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->getConfigRevision(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
$returned
=
$self
->{fbe}->getConfigRevision(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
return
$returned
;
}
sub
getCtime{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$var
=
$_
[2];
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
} )) {
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
}{
'ctime'
} )) {
return
undef
;
}
return
$self
->{meta}{
$config
}{
$var
}{
'ctime'
};
}
sub
getKeys {
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{conf}{
$config
}});
return
@keys
;
}
sub
getLoadedConfigRevision{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->isConfigLoaded(
$config
) ){
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
return
$self
->{revision}{
$config
};
}
sub
getLoadedConfigs {
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
my
@keys
=
keys
(%{
$self
->{conf}});
return
@keys
;
}
sub
getMetas {
my
(
$self
,
$config
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{meta}{
$config
}});
return
@keys
;
}
sub
getMtime{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$var
=
$_
[2];
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
} )) {
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
}{
'mtime'
} )) {
return
undef
;
}
return
$self
->{meta}{
$config
}{
$var
}{
'mtime'
};
}
sub
getOverrideChooser{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
$chooser
;
if
( (
defined
(
$self
->{meta}{
$config
}{zconf} ))&&(
defined
(
$self
->{meta}{
$config
}{zconf}{
'override/chooser'
} )) ) {
$chooser
=
$self
->{meta}{
$config
}{zconf}{
'override/chooser'
};
}
return
$chooser
;
}
sub
getSet{
my
(
$self
,
$config
)=
@_
;
$self
->errorblank;
if
( !
defined
(
$config
) ){
$self
->{error}=25;
$self
->{errorString}=
'No config defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{set}{
$config
})){
$self
->{error}=26;
$self
->{errorString}=
"Set '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
return
$self
->{set}{
$config
};
}
sub
getSubConfigs{
my
(
$self
,
$config
)=
@_
;
$self
->errorblank;
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
my
@returned
=
$self
->{be}->getSubConfigs(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
@returned
=
$self
->{fbe}->getSubConfigs(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ){
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
return
@returned
;
}
sub
getComment{
my
(
$self
,
$config
,
$var
,
$comment
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$var
)) {
$self
->{error}=18;
$self
->{errorString}=
'No variable specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$comment
)) {
$self
->{error}=41;
$self
->{errorString}=
'No comment specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{comment}{
$config
}{
$var
} )) {
return
undef
;
}
if
(!
defined
(
$self
->{comment}{
$config
}{
$var
}{
$comment
} )) {
return
undef
;
}
return
$self
->{comment}{
$config
}{
$var
}{
$comment
};
}
sub
getMeta{
my
(
$self
,
$config
,
$var
,
$meta
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$var
)) {
$self
->{error}=18;
$self
->{errorString}=
'No variable specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$meta
)) {
$self
->{error}=42;
$self
->{errorString}=
'No meta specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
} )) {
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
}{
$meta
} )) {
return
undef
;
}
return
$self
->{meta}{
$config
}{
$var
}{
$meta
};
}
sub
getVar{
my
(
$self
,
$config
,
$var
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->Warn;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$var
)) {
$self
->{error}=18;
$self
->{errorString}=
'No variable specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{conf}{
$config
}{
$var
} )) {
return
undef
;
}
return
$self
->{conf}{
$config
}{
$var
};
}
sub
initBackend{
my
$self
=
$_
[0];
my
$backend
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$backend
)) {
$self
->{error}=15;
$self
->{errorString}=
'No backend specified'
;
$self
->
warn
;
return
undef
;
}
my
$torun
=
'use ZConf::backends::'
.
$backend
.
'; $be=ZConf::backends::'
.
$backend
.
'->new( \%{ $self->{args} } );'
;
my
$be
;
eval
(
$torun
);
if
(!
defined
(
$be
)) {
$self
->{error}=47;
$self
->{errorString}=
'Trying to initialize the backend failed. It returned undefined'
;
$self
->
warn
;
return
undef
;
}
return
$be
;
}
sub
isLoadedConfigLocked{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->isConfigLoaded(
$config
) ){
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
})) {
return
1;
}
return
undef
;
}
sub
isConfigLoaded{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)) {
$self
->{error}=25;
$self
->{errorString}=
"Config is undefined"
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{conf}{
$config
} ) ) {
return
1;
}
return
undef
;
}
sub
isConfigLocked{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
my
$exists
=
$self
->configExists(
$config
);
if
(
$self
->{error}) {
$self
->warnString(
'configExists errored'
);
return
undef
;
}
if
(!
$exists
) {
$self
->{error}=12;
$self
->{errorString}=
'The config, "'
.
$config
.
'", does not exist'
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->isConfigLocked(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
$returned
=
$self
->{fbe}->isConfigLocked(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
return
$returned
;
}
sub
LDAPconnect{
my
$self
=
$_
[0];
$self
->errorblank;
my
$returned
;
if
(
ref
(
$self
->{be} ) eq
"ZConf::backends::ldap"
) {
$returned
=
$self
->{be}->LDAPconnect;
if
(
$self
->{be}->error) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
}
else
{
$self
->{error}=13;
$self
->{errorString}=
'Backend is not "ZConf::backends::ldap"'
;
$self
->
warn
;
}
return
$returned
;
}
sub
override
{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$args{config} not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$args
{config} } )) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{conf}{
$args
{config} } )){
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{profile} )) {
if
( (
defined
(
$self
->{meta}{
$args
{config}}{zconf} ))&&
(
defined
(
$self
->{meta}{
$args
{config}}{zconf}{
'override/chooser'
} ))
) {
my
$chooser
=
$self
->{meta}{
$args
{config}}{zconf}{
'override/chooser'
};
if
(
$chooser
ne
''
) {
my
(
$success
,
$choosen
)=choose(
$chooser
);
if
(
$success
) {
$args
{profile}=
$choosen
;
}
else
{
$args
{profile}=
'default'
;
}
}
else
{
$args
{profile}=
'default'
;
}
}
else
{
return
undef
;
}
}
if
(!
$self
->setNameLegit(
$args
{profile})){
$self
->{error}=27;
$self
->{errorString}=
'"'
.
$args
{profile}.
'" is not a valid set name'
;
$self
->
warn
;
return
undef
;
}
my
%metas
=
$self
->regexMetaGet({
config
=>
$args
{config},
varRegex
=>
'^zconf$'
,
metaRegex
=>
'^override\/profiles\/'
.
quotemeta
(
$args
{profile}).
'\/'
,
});
my
@keys
=
keys
( %{
$metas
{zconf} } );
my
$int
=0;
while
(
defined
(
$keys
[
$int
] )) {
my
$override
=
$keys
[
$int
];
my
$remove
=
'^override\/profiles\/'
.
quotemeta
(
$args
{profile}).
'\/'
;
$override
=s/
$override
//g;
$self
->{conf}{
$args
{config}}{
$override
}=
$self
->{meta}{
$args
{config}}{
'zconf'
}{
$keys
[
$int
]};
$int
++;
}
return
1;
}
sub
read
{
my
$self
=
$_
[0];
my
%args
=%{
$_
[1]};
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$args
{config});
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$args
{config})){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$args
{config}.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{set})){
$args
{set}=
$self
->chooseSet(
$args
{config});
if
(
defined
(
$self
->{error})) {
$self
->{error}=
'32'
;
$self
->{errorString}=
'Unable to choose a set'
;
$self
->
warn
;
return
undef
;
}
}
my
$returned
=
$self
->{be}->
read
(\
%args
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
$returned
=
$self
->{fbe}->
read
(\
%args
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
if
(
defined
(
$self
->{fbe} ) &&
( !
$self
->{be}->error )
) {
$self
->{fbe}->writeSetFromLoadedConfig(\
%args
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
$returned
;
}
sub
readChooser{
my
(
$self
,
$config
)=
@_
;
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$config
)){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$config
.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->readChooser(
$config
);
if
(
$self
->{be}->error &&
$self
->{args}{readfallthrough} &&
defined
(
$self
->{fbe} )
) {
$returned
=
$self
->{fbe}->readChooser(
$config
);
if
(
$self
->{fbe}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{fbe}->error.
'" errorString="'
.
$self
->{fbe}->errorString.
'"'
;
$self
->
warn
;
}
}
elsif
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
}
if
(
defined
(
$self
->{fbe} ) &&
( !
$self
->{be}->error )
) {
$self
->{fbe}->writeChooser(
$config
,
$returned
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
$returned
;
}
sub
regexCommentDel{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$args
{config},
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$args
{config}) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{varRegex})){
$self
->{error}=18;
$self
->{errorString}=
'$args{varRegex} not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$args
{config}})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
my
@vars
=
keys
(%{
$self
->{comment}{
$args
{config}}});
my
%returned
;
my
$varsInt
=0;
while
(
defined
(
$vars
[
$varsInt
])){
if
(
$vars
[
$varsInt
] =~ /
$args
{varRegex}/) {
my
@comments
=
keys
(%{
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }});
my
$commentsInt
=0;
while
(
defined
(
$comments
[
$commentsInt
])) {
if
(
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] } =~ /
$args
{commentRegex}/) {
if
(!
defined
(
$returned
{
$vars
[
$varsInt
] } )) {
$returned
{
$vars
[
$varsInt
] }={};
}
$returned
{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] }=
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] };
delete
(
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] });
}
$commentsInt
++;
}
}
$varsInt
++;
}
return
%returned
;
}
sub
regexCommentGet{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$args
{config},
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$args
{config})) {
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$args
{config}) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{varRegex})) {
$self
->{error}=18;
$self
->{errorString}=
'$args{varRegex} not defined'
;
$self
->
warn
;
return
undef
;
}
my
@vars
=
keys
(%{
$self
->{comment}{
$args
{config}}});
my
%returned
;
my
$varsInt
=0;
while
(
defined
(
$vars
[
$varsInt
])) {
if
(
$vars
[
$varsInt
] =~ /
$args
{varRegex}/) {
my
@comments
=
keys
(%{
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }});
my
$commentsInt
=0;
while
(
defined
(
$comments
[
$commentsInt
])) {
if
(
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] } =~ /
$args
{commentRegex}/) {
if
(!
defined
(
$returned
{
$vars
[
$varsInt
] } )) {
$returned
{
$vars
[
$varsInt
] }={};
}
$returned
{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] }=
$self
->{comment}{
$args
{config} }{
$vars
[
$varsInt
] }{
$comments
[
$commentsInt
] };
}
$commentsInt
++;
}
}
$varsInt
++;
}
return
%returned
;
}
sub
regexMetaDel{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$args
{config},
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$args
{config}) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{varRegex})){
$self
->{error}=18;
$self
->{errorString}=
'$args{varRegex} not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$args
{config}})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
my
@vars
=
keys
(%{
$self
->{meta}{
$args
{config}}});
my
%returned
;
my
$varsInt
=0;
while
(
defined
(
$vars
[
$varsInt
])){
if
(
$vars
[
$varsInt
] =~ /
$args
{varRegex}/) {
my
@metas
=
keys
(%{
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }});
my
$metasInt
=0;
while
(
defined
(
$metas
[
$metasInt
])) {
if
(
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] } =~ /
$args
{metaRegex}/) {
if
(!
defined
(
$returned
{
$vars
[
$varsInt
] } )) {
$returned
{
$vars
[
$varsInt
] }={};
}
$returned
{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] }=
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] };
delete
(
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] });
}
$metasInt
++;
}
}
$varsInt
++;
}
return
%returned
;
}
sub
regexMetaGet{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$args
{config},
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$args
{config}) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{varRegex})){
$self
->{error}=18;
$self
->{errorString}=
'$args{varRegex} not defined'
;
$self
->
warn
;
return
undef
;
}
my
@vars
=
keys
(%{
$self
->{meta}{
$args
{config}}});
my
%returned
;
my
$varsInt
=0;
while
(
defined
(
$vars
[
$varsInt
])){
if
(
$vars
[
$varsInt
] =~ /
$args
{varRegex}/) {
my
@metas
=
keys
(%{
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }});
my
$metasInt
=0;
while
(
defined
(
$metas
[
$metasInt
])) {
if
(
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] } =~ /
$args
{metaRegex}/) {
if
(!
defined
(
$returned
{
$vars
[
$varsInt
] } )) {
$returned
{
$vars
[
$varsInt
] }={};
}
$returned
{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] }=
$self
->{meta}{
$args
{config} }{
$vars
[
$varsInt
] }{
$metas
[
$metasInt
] };
}
$metasInt
++;
}
}
$varsInt
++;
}
return
%returned
;
}
sub
regexVarDel{
my
(
$self
,
$config
,
$regex
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{conf}{
$config
}});
my
@returnKeys
=();
my
$int
=0;
while
(
defined
(
$keys
[
$int
])){
if
(
$keys
[
$int
] =~ /
$regex
/){
delete
(
$self
->{conf}{
$config
}{
$keys
[
$int
]});
push
(
@returnKeys
,
$keys
[
$int
]);
}
$int
++;
}
return
@returnKeys
;
}
sub
regexVarGet{
my
(
$self
,
$config
,
$regex
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{conf}{
$config
}});
my
%returnKeys
=();
my
$int
=0;
while
(
defined
(
$keys
[
$int
])){
if
(
$keys
[
$int
] =~ /
$regex
/){
$returnKeys
{
$keys
[
$int
]}=
$self
->{conf}{
$config
}{
$keys
[
$int
]};
}
$int
++;
}
return
%returnKeys
;
}
sub
regexVarSearch{
my
(
$self
,
$config
,
$regex
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
@keys
=
keys
(%{
$self
->{conf}{
$config
}});
my
@returnKeys
=();
my
$int
=0;
while
(
defined
(
$keys
[
$int
])){
if
(
$keys
[
$int
] =~ /
$regex
/){
push
(
@returnKeys
,
$keys
[
$int
]);
}
$int
++;
}
return
@returnKeys
;
}
sub
reread{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
$set
=
$self
->getSet(
$config
);
if
(
$self
->{error}) {
$self
->
warn
(
'getSet errored'
);
return
undef
;
}
$self
->
read
({
config
=>
$config
,
set
=>
$set
});
if
(
$self
->{error}) {
$self
->
warn
(
'read errored'
);
return
undef
;
}
return
1;
}
sub
setAutoupdate{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$autoupdate
=
$_
[2];
$self
->errorblank;
if
(!
defined
(
$config
)) {
$self
->{autoupdateGlobal}=
$autoupdate
;
}
$self
->{autoupdate}{
$config
}=
$autoupdate
;
return
1;
}
sub
setComment{
my
(
$self
,
$config
,
$var
,
$comment
,
$value
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$comment
)){
$self
->{error}=41;
$self
->{errorString}=
'No comment name defined'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
(
$error
,
$errorString
)=
$self
->varNameCheck(
$var
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
(
$error
,
$errorString
)=
$self
->varNameCheck(
$comment
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{comment}{
$config
}{
$var
})){
$self
->{comment}{
$config
}{
$var
}={};
}
$self
->{comment}{
$config
}{
$var
}{
$comment
}=
$value
;
return
1;
}
sub
setDefault{
my
(
$self
,
$set
)=
@_
;
$self
->errorblank;
if
(
$self
->setNameLegit(
$set
)){
$self
->{args}{
default
}=
$set
;
}
else
{
$self
->{error}=27;
$self
->{errorString}=
"'"
.
$set
.
"' is not a legit set name."
;
$self
->
warn
;
return
undef
}
return
1;
}
sub
setExists{
my
(
$self
,
$config
,
$set
)=
@_
;
$self
->errorblank;
if
(!
defined
(
$set
)) {
return
$self
->defaultSetExists(
$config
);
if
(
$self
->{error}) {
$self
->warnString(
'No set specified and defaultSetExists errored'
);
return
undef
;
}
}
my
@sets
=
$self
->getAvailableSets(
$config
);
if
(
defined
(
$self
->{error})) {
return
undef
;
}
my
$setsInt
=0;
while
(
defined
(
$sets
[
$setsInt
])) {
if
(
$sets
[
$setsInt
] eq
$set
) {
return
1;
}
$setsInt
++;
}
return
undef
;
}
sub
setLockConfig{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$lock
=
$_
[2];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
my
$exists
=
$self
->configExists(
$config
);
if
(
$self
->error) {
warnSring(
'configExists errored'
);
return
undef
;
}
if
(!
$exists
) {
$self
->{error}=12;
$self
->{errorString}=
'The config, "'
.
$config
.
'", does not exist'
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->setLockConfig(
$config
,
$lock
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ) {
$self
->{fbe}->setLockConfig(
$config
,
$lock
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
1;
}
sub
setMeta{
my
(
$self
,
$config
,
$var
,
$meta
,
$value
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1 });
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$meta
)){
$self
->{error}=41;
$self
->{errorString}=
'No comment name defined'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->varNameCheck(
$var
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
(
$error
,
$errorString
)=
$self
->varNameCheck(
$meta
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->Warn;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
})){
$self
->{meta}{
$config
}{
$var
}={};
}
$self
->{meta}{
$config
}{
$var
}{
$meta
}=
$value
;
return
1;
}
sub
setNameLegit{
my
(
$self
,
$set
)=
@_
;
$self
->errorblank;
if
(!
defined
(
$set
)){
return
undef
;
}
if
(
$set
=~ /\//){
return
undef
;
}
if
(
$set
=~ /^\./){
return
undef
;
}
if
(
$set
=~ /^ /){
return
undef
;
}
if
(
$set
=~ / $/){
return
undef
;
}
if
(
$set
=~ /\.\./){
return
undef
;
}
return
1;
}
sub
setOverrideChooser{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
my
$chooser
=
$_
[2];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
} )) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$chooser
)){
$self
->{error}=40;
$self
->{errorString}=
'$chooser not defined'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
} )) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{meta}{
$config
}{zconf} )){
$self
->{meta}{
$config
}{zconf}={};
}
$self
->{meta}{
$config
}{zconf}{
'override/chooser'
}=
$chooser
;
return
1;
}
sub
setVar{
my
(
$self
,
$config
,
$var
,
$value
) =
@_
;
$self
->errorblank;
$self
->updateIfNeeded({
config
=>
$config
,
clearerror
=>1,
autocheck
=>1});
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{locked}{
$config
})) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->varNameCheck(
$var
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$var
)){
$self
->{error}=18;
$self
->{errorString}=
"\$var is not defined."
;
$self
->
warn
;
return
undef
;
}
$self
->{conf}{
$config
}{
$var
}=
$value
;
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
} )) {
$self
->{meta}{
$config
}{
$var
}={};
}
$self
->{meta}{
$config
}{
$var
}{
'mtime'
}=
time
;
if
(!
defined
(
$self
->{meta}{
$config
}{
$var
}{
'ctime'
} )) {
$self
->{meta}{
$config
}{
$var
}{
'ctime'
}=
time
;
}
return
1;
}
sub
unloadConfig{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$self
->{conf}{
$config
})){
$self
->{error}=26;
$self
->{errorString}=
'The specified config, ".$config.", is not loaded'
;
$self
->
warn
;
if
(
defined
(
$self
->{set}{
$config
})){
delete
(
$self
->{set}{
$config
});
}
return
undef
;
}
else
{
delete
(
$self
->{conf}{
$config
});
}
if
(
defined
(
$self
->{set}{
$config
})){
delete
(
$self
->{set}{
$config
});
}
if
(
defined
(
$self
->{locked}{
$config
})) {
delete
(
$self
->{locked}{
$config
});
}
if
(
defined
(
$self
->{meta}{
$config
})) {
delete
(
$self
->{meta}{
$config
});
}
if
(
defined
(
$self
->{comment}{
$config
})) {
delete
(
$self
->{comment}{
$config
});
}
if
(
defined
(
$self
->{revision}{
$config
})) {
delete
(
$self
->{revision}{
$config
});
}
return
1;
}
sub
updatable{
my
$self
=
$_
[0];
my
$config
=
$_
[1];
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->isConfigLoaded(
$config
) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$config
.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
my
$backendRev
=
$self
->getConfigRevision(
$config
);
if
(
$self
->{error}) {
$self
->warnString(
'getConfigRevision failed'
);
return
undef
;
}
if
(!
defined
(
$backendRev
)) {
return
undef
;
}
my
$loadedRev
=
$self
->getLoadedConfigRevision(
$config
);
if
(!
defined
(
$loadedRev
)) {
$loadedRev
=
''
;
}
if
(
$backendRev
ne
$loadedRev
) {
return
1;
}
return
undef
;
}
sub
updateIfNeeded{
my
$self
=
$_
[0];
my
%args
;
if
(
defined
(
$_
[1])) {
%args
=%{
$_
[1]};
}
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'No config specified'
;
$self
->
warn
;
return
undef
;
}
if
( !
$self
->isConfigLoaded(
$args
{config}) ) {
$self
->{error}=26;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded."
;
$self
->
warn
;
return
undef
;
}
if
(
$args
{autocheck}) {
my
$autoupdate
=
$self
->getAutoupdate(
$args
{config});
if
(!
$autoupdate
){
return
undef
;
}
}
my
$updatable
=
$self
->updatable(
$args
{config});
if
(
$self
->error) {
$self
->
warn
(
'updatable errored'
);
return
undef
;
}
if
(!
$updatable
) {
return
undef
;
}
$self
->reread(
$args
{config});
if
(
$self
->error) {
$self
->warnString(
'reread errored'
);
if
(
$args
{clearerror}) {
$self
->errorblank;
}
return
undef
;
}
return
1;
}
sub
varNameCheck{
my
(
$self
,
$name
) =
@_
;
$self
->errorblank;
if
(!
defined
(
$name
)) {
return
(
'10'
,
'variable name is not defined'
);
}
if
(
$name
=~ /,/){
return
(
"0"
,
"variavble name,'"
.
$name
.
"', contains ','"
);
}
if
(
$name
=~ /\/\./){
return
(
"1"
,
"variavble name,'"
.
$name
.
"', contains '/.'"
);
}
if
(
$name
=~ /\/\//){
return
(
"2"
,
"variavble name,'"
.
$name
.
"', contains '//'"
);
}
if
(
$name
=~ /\.\.\//){
return
(
"3"
,
"variavble name,'"
.
$name
.
"', contains '../'"
);
}
if
(
$name
=~ /\/\.\./){
return
(
"4"
,
"variavble name,'"
.
$name
.
"', contains '/..'"
);
}
if
(
$name
=~ /^\.\//){
return
(
"5"
,
"variavble name,'"
.
$name
.
"', matched /^\.\//"
);
}
if
(
$name
=~ /\/$/){
return
(
"6"
,
"variavble name,'"
.
$name
.
"', matched /\/$/"
);
}
if
(
$name
=~ /^\//){
return
(
"7"
,
"variavble name,'"
.
$name
.
"', matched /^\//"
);
}
if
(
$name
=~ /\n/){
return
(
"8"
,
"variavble name,'"
.
$name
.
"', matched /\\n/"
);
}
if
(
$name
=~ /=/){
return
(
"9"
,
"variavble name,'"
.
$name
.
"', matched /=/"
);
}
return
(
undef
,
""
);
}
sub
writeChooser{
my
(
$self
,
$config
,
$chooserstring
)=
@_
;
$self
->errorblank;
if
(!
defined
(
$config
)){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$chooserstring
)){
$self
->{error}=40;
$self
->{errorString}=
'\$chooserstring not defined'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$config
);
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$config
)){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$config
.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
my
$locked
=
$self
->isConfigLocked(
$config
);
if
(
$self
->{error}) {
$self
->warnString(
'isconfigLocked errored'
);
return
undef
;
}
if
(
$locked
) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$config
.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
my
$returned
=
$self
->{be}->writeChooser(
$config
,
$chooserstring
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ) {
$self
->{fbe}->writeChooser(
$config
,
$chooserstring
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
1;
}
sub
writeSetFromHash{
my
$self
=
$_
[0];
my
%args
=%{
$_
[1]};
my
%hash
= %{
$_
[2]};
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
my
(
$error
,
$errorString
)=
$self
->configNameCheck(
$args
{config});
if
(
defined
(
$error
)){
$self
->{error}=
$error
;
$self
->{errorString}=
$errorString
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->configExists(
$args
{config})){
$self
->{error}=12;
$self
->{errorString}=
"'"
.
$args
{config}.
"' does not exist."
;
$self
->
warn
;
return
undef
;
}
my
$locked
=
$self
->isConfigLocked(
$args
{config});
if
(
$self
->{error}) {
$self
->warnString(
'isconfigLocked errored'
);
return
undef
;
}
if
(
$locked
) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{set})){
$args
{set}=
$self
->{args}{
default
};
}
if
(!
defined
(
$args
{revision})) {
$args
{revision}=
time
.
' '
.hostname.
' '
.
rand
();
}
my
$returned
=
$self
->{be}->writeSetFromHash(\
%args
, \
%hash
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ) {
$self
->{fbe}->writeSetFromHash(\
%args
, \
%hash
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
1;
}
sub
writeSetFromLoadedConfig{
my
$self
=
$_
[0];
my
%args
= %{
$_
[1]};
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
$self
->isConfigLoaded(
$args
{config} ) ){
$self
->{error}=25;
$self
->{errorString}=
"Config '"
.
$args
{config}.
"' is not loaded"
;
$self
->
warn
;
return
undef
;
}
my
$locked
=
$self
->isConfigLocked(
$args
{config});
if
(
$self
->{error}) {
$self
->warnString(
'isconfigLocked errored'
);
return
undef
;
}
if
(
$locked
) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{set})){
$args
{set}=
$self
->{set}{
$args
{config}};
}
else
{
if
(
$self
->setNameLegit(
$args
{set})){
$self
->{args}{
default
}=
$args
{set};
}
else
{
$self
->{error}=27;
$self
->{errorString}=
"'"
.
$args
{set}.
"' is not a legit set name."
;
$self
->
warn
;
return
undef
}
}
if
(!
defined
(
$args
{revision})) {
$args
{revision}=
time
.
' '
.hostname.
' '
.
rand
();
}
my
$returned
=
$self
->{be}->writeSetFromLoadedConfig(\
%args
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ) {
$self
->{fbe}->writeSetFromLoadedConfig(\
%args
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
1;
}
sub
writeSetFromZML{
my
$self
=
$_
[0];
my
%args
= %{
$_
[1]};
$self
->errorblank;
if
(!
defined
(
$args
{config})){
$self
->{error}=25;
$self
->{errorString}=
'$config not defined'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{zml} )) {
$self
->{error}=16;
$self
->{errorString}=
'$args{zml} is not defined'
;
$self
->
warn
;
return
undef
;
}
if
(
ref
(
$args
{zml}) ne
"ZML"
) {
$self
->{error}=16;
$self
->{errorString}=
'$args{zml} is not a ZML'
;
$self
->
warn
;
return
undef
;
}
my
$locked
=
$self
->isConfigLocked(
$args
{config});
if
(
$self
->{error}) {
$self
->warnString(
'isconfigLocked errored'
);
return
undef
;
}
if
(
$locked
) {
$self
->{error}=45;
$self
->{errorString}=
'The config "'
.
$args
{config}.
'" is locked'
;
$self
->
warn
;
return
undef
;
}
if
(!
defined
(
$args
{set})){
$args
{set}=
$self
->{set}{
$args
{config}};
}
else
{
if
(
$self
->setNameLegit(
$args
{set})){
$self
->{args}{
default
}=
$args
{set};
}
else
{
$self
->{error}=27;
$self
->{errorString}=
"'"
.
$args
{set}.
"' is not a legit set name."
;
$self
->Warn;
return
undef
}
}
if
(!
defined
(
$args
{revision})) {
$args
{revision}=
time
.
' '
.hostname.
' '
.
rand
();
}
my
$returned
=
$self
->{be}->writeSetFromZML(\
%args
);
if
(
$self
->{be}->error ) {
$self
->{error}=11;
$self
->{errorString}=
'Backend errored. error="'
.
$self
->{be}->error.
'" errorString="'
.
$self
->{be}->errorString.
'"'
;
$self
->
warn
;
return
undef
;
}
if
(
defined
(
$self
->{fbe} ) ) {
$self
->{fbe}->writeSetFromZML(\
%args
);
if
(
$self
->{fbe}->error) {
$self
->warnString(
'Failed to sync to the backend error='
.
$self
->{fbe}->error.
' errorString='
.
$self
->{fbe}->errorString);
}
}
return
1;
}
1;