view release on metacpan or  search on metacpan

lib/Mail/Box/Manage/User.pm  view on Meta::CPAN

		my $delim = $self->delimiter;
		my $upper = $name =~ s!$delim$base!!r or panic "$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)
	{	# Revive! Raise the death!
		$id->deleted(0);
	}
	else
	{	# Bumped into existing folder
		error __x"folder {name} already exists.", name => $name;
	}

	$self->defaultFolderType->create($id->location, %args)
		if ! exists $args{create_real} || $args{create_real};

	$id;
}


sub delete($)
{	my ($self, $name) = @_;
	my $folder = $self->folder($name) or return ();
	$folder->remove;
	$self->SUPER::delete($name);
}


sub rename($$@)
{	my ($self, $oldname, $newname, %args) = @_;

	my $old     = $self->folder($oldname)
		or error __x"source folder for rename does not exist: {from} to {to}.", from => $oldname, to => $newname;

	my ($newdir, $base) = $self->folderCollection($newname);
	unless(defined $newdir)
	{	$args{create_supers}
			or error __x"cannot rename folder {from} to {to}: higher levels are missing.", from => $oldname, to => $newname;

		my $delim = $self->delimiter;
		my $upper = $newname =~ s!$delim$base!!r or panic "$newname - $base";
		$newdir   = $self->create($upper, %args, deleted => 1);
	}

	my $oldlocation = $old->location;
	my $new         = $old->rename($newdir, $base);

	my $newlocation = $new->location;
	$oldlocation eq $newlocation
		or panic "Physical folder relocation not yet implemented";  #XXX
		# this needs a $old->rename(xx,yy) which isn't implemented yet

	trace "renamed folder $oldname to $newname";
	$new;
}

1;