File: Wizard.pm

package info (click to toggle)
perlmoo 0.045
  • links: PTS
  • area: main
  • in suites: slink
  • size: 404 kB
  • ctags: 242
  • sloc: perl: 5,211; makefile: 111; sh: 77
file content (117 lines) | stat: -rw-r--r-- 2,623 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
# A person who can do *anything* in/to the moo, except execute arbitrary perl
# code.

package Wizard;
use strict;
use vars qw(@ISA);
use Db;
use Programmer;
use Verb;
use VerbCall;
use ThingList;
use Password;
use UNIVERSAL qw(isa);
@ISA=qw{Programmer};

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $this  = Programmer::new($class,@_);
	bless ($this, $class);
	return $this;
}

# Set a given person's password.
sub verb_setpassword {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	if ($verbcall->direct_object) {
		$verbcall->direct_object->password(Password::encrypt($verbcall->word('indirect_object')));
		return "Password set.";
	}
	else {
		return Error->new("Need to specify a person.");
	}
}

# Allows a Wizard to broadcast to everyone on the MOO
sub verb_shout {
	my $this = shift;
	my $verbcall = shift;
	
	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my $text = $verbcall->command;
	$text=~s/^\s*\w+\s+//; # remove command.
	my $name = $verbcall->caller->name;

	foreach (ThingList::FindByType("Person")) {
		if($_ && $_->connected && !($_==$verbcall->caller)) {
			$_->tell("$name shouts, \"$text\"");
		}
	}
	return "You shout, \"$text\"";
}

# Like audit, but lists everything in the whole moo.
sub verb_listall {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my $thing;
	my @list;
	my ($locname, $locnum, $ownname, $ownnum);
	my (%thingsbyid, $keyvalue);
	
	foreach $thing (ThingList::All) {
		$thingsbyid{$keyvalue++} = [$thing, $thing->id];
	}

	foreach (sort { $thingsbyid{$a}->[1] <=> $thingsbyid{$b}->[1] } keys(%thingsbyid)) {
		$thing = $thingsbyid{$_}->[0];
		if ($thing->location) {
			$locname=$thing->location->name;
			$locnum="(#".$thing->location->id.")";
		}
		else {
			$locname="<nowhere>";
			$locnum="";
		}
		if ($thing->owner) {
			$ownname=$thing->owner->name;
			$ownnum="(#".$thing->owner->id.")";
		}
		else {
			$ownname="<none>";
			$ownnum="";
		}
		push @list, [ref($thing), "#".$thing->id, $thing->name, $ownname, $ownnum, $locname, $locnum];
	}

	return Text::tablemaker("The whole moo",
		["TYPE", "ID", "NAME", "OWNER","","LOCATION",""],
		@list,
	);	
}

sub verb_dumpdb {
	my $this=shift;
	my $verbcall=shift;

	return Error->new("No way.") if ($this != ActiveUser::getactive);

	my $ret=Db::DumpDb('requested by wizard #'.$this->id);
	if (! $ret) {
		return Error->new("Database dump not preformed - another is already in progress.");
	}
	else {
		return "Now dumping database in background.";
	}
}

1