$VERSION
=
'2.067'
;
sub
init($)
{
my
(
$self
,
$args
) =
@_
;
$self
->SUPER::init(
$args
) or
return
();
my
$identity
=
$self
->{MBMU_id} =
$args
->{identity};
defined
$identity
or
die
;
my
$top
=
$args
->{folder_id_type} ||
'Mail::Box::Identity'
;
my
$coltype
=
$args
->{collection_type} ||
'Mail::Box::Collection'
;
unless
(
ref
$top
)
{
my
$name
=
$args
->{topfolder_name};
$name
=
'='
unless
defined
$name
;
$top
=
$top
->new
(
name
=>
$name
,
manager
=>
$self
,
location
=>
scalar
(
$self
->folderdir)
,
folder_type
=>
$self
->defaultFolderType
,
collection_type
=>
$coltype
);
}
$self
->{MBMU_topfolder} =
$top
;
$self
->{MBMU_delim} =
$args
->{delimiter} ||
'/'
;
$self
->{MBMU_inbox} =
$args
->{inbox};
$self
;
}
sub
identity() {
shift
->{MBMU_id} }
sub
inbox(;$)
{
my
$self
=
shift
;
@_
? (
$self
->{MBMU_inbox} =
shift
) :
$self
->{MBMU_inbox};
}
sub
topfolder() {
shift
->{MBMU_topfolder} }
sub
folder($)
{
my
(
$self
,
$name
) =
@_
;
my
$top
=
$self
->topfolder or
return
();
my
@path
=
split
$self
->{MBMU_delim},
$name
;
return
()
unless
shift
@path
eq
$top
->name;
$top
->folder(
@path
);
}
sub
folderCollection($)
{
my
(
$self
,
$name
) =
@_
;
my
$top
=
$self
->topfolder or
return
();
my
@path
=
split
$self
->{MBMU_delim},
$name
;
unless
(
shift
@path
eq
$top
->name)
{
$self
->
log
(
ERROR
=>
"Folder name $name not under top."
);
return
();
}
my
$base
=
pop
@path
;
(
$top
->folder(
@path
),
$base
);
}
sub
create($@)
{
my
(
$self
,
$name
,
%args
) =
@_
;
my
(
$dir
,
$base
) =
$self
->folderCollection(
$name
);
unless
(
defined
$dir
)
{
unless
(
$args
{create_supers})
{
$self
->
log
(
ERROR
=>
"Cannot create $name: higher levels missing"
);
return
undef
;
}
(
my
$upper
=
$name
) =~ s!
$self
->{MBMU_delim}
$base
!!
or
die
"$name - $base"
;
$dir
=
$self
->create(
$upper
,
%args
,
deleted
=> 1);
}
my
$id
=
$dir
->folder(
$base
);
if
(!
defined
$id
)
{
my
$idopt
=
$args
{id_options} || [];
$id
=
$dir
->addSubfolder(
$base
,
@$idopt
,
deleted
=>
$args
{deleted});
}
elsif
(
$args
{deleted})
{
$id
->deleted(1);
return
$id
;
}
elsif
(
$id
->deleted)
{
$id
->deleted(0);
}
else
{
$self
->
log
(
ERROR
=>
"Folder $name already exists"
);
return
undef
;
}
if
(!
defined
$args
{create_real} ||
$args
{create_real})
{
$self
->defaultFolderType->create(
$id
->location,
%args
)
or
return
undef
;
}
$id
;
}
sub
delete
($)
{
my
(
$self
,
$name
) =
@_
;
my
$id
=
$self
->folder(
$name
) or
return
();
$id
->remove;
$self
->SUPER::
delete
(
$name
);
}
sub
rename
($$@)
{
my
(
$self
,
$oldname
,
$newname
,
%args
) =
@_
;
my
$old
=
$self
->folder(
$oldname
);
unless
(
defined
$old
)
{
$self
->
log
(
WARNING
=>
"Source for rename does not exist: $oldname to $newname"
);
return
();
}
my
(
$newdir
,
$base
) =
$self
->folderCollection(
$newname
);
unless
(
defined
$newdir
)
{
unless
(
$args
{create_supers})
{
$self
->
log
(
ERROR
=>
"Cannot rename $oldname to $newname: higher levels missing"
);
return
();
}
(
my
$upper
=
$newname
) =~ s!
$self
->{MBMU_delim}
$base
!!
or
die
"$newname - $base"
;
$newdir
=
$self
->create(
$upper
,
%args
,
deleted
=> 1);
}
my
$oldlocation
=
$old
->location;
my
$new
=
$old
->
rename
(
$newdir
,
$base
);
my
$newlocation
=
$new
->location;
if
(
$oldlocation
ne
$newlocation
)
croak(
"Physical folder relocation not yet implemented"
);
}
$self
->
log
(
PROGRESS
=>
"Renamed folder $oldname to $newname"
);
$new
;
}
1;