Building Browsergames » perl http://buildingbrowsergames.com Ever wanted to build a browsergame? Mon, 29 Mar 2010 14:00:39 +0000 http://wordpress.org/?v=2.8.5 en hourly 1 Building Browsergames: Buying Armor (Perl) http://buildingbrowsergames.com/2008/09/25/buying-armor-perl/ http://buildingbrowsergames.com/2008/09/25/buying-armor-perl/#comments Thu, 25 Sep 2008 14:00:08 +0000 Luke http://buildingbrowsergames.com/?p=418 For all that we’ve built weapons into our game, we’re still missing armor! Today we will be starting on the code for our armor system.

To start off, check out a copy of the source code for our tutorial:

svn checkout http://building-browsergames-tutorial.googlecode.com/svn/trunk/perl/pbbg tutorial -r 30

With that finished, we’re ready to start writing some code.

Based on our poll from earlier, there are going to be 5 armor slots – head, torso, legs, right arm, and left arm. That’s a lot of stats – but not altogether difficult to add to our stats table:

INSERT INTO stats(display_name,short_name) VALUES
	('Armor - Head','ahead'),
	('Armor - Torso','atorso'),
	('Armor - Legs','alegs'),
	('Armor - Right Arm','aright'),
	('Armor - Left Arm','aleft'),
	('Item Armor Slot','aslot');

If you’ve been paying attention at all, you’ll have noticed that there are actually six stats being inserted above – the sixth one being Item Armor Slot. This stat was added so that we can keep track of which armor slot an item should end up in – we will take advantage of it later.

In order to display things, we’re going to need a template. With that in mind, we’ll create armor-shop.tmpl:

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

<html>
<head>
	<title>The Armor Shop</title>
</head>
<body>
	<p>Welcome to the Armor Shop.</p>
	<p><a href='index.cgi'>Back to main</a></p>
	<h3>Current Armor:</h3>
	<ul>
		<li>
			Head:
			<tmpl_if name='ahead'>
				<!-- tmpl_var name='ahead'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='ahead' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Torso:
			<tmpl_if name='atorso'>
				<!-- tmpl_var name='atorso'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='atorso' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Legs:
			<tmpl_if name='alegs'>
				<!-- tmpl_var name='alegs'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='alegs' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Right Arm:
			<tmpl_if name='aright'>
				<!-- tmpl_var name='aright'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='aright' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Left Arm:
			<tmpl_if name='aleft'>
				<!-- tmpl_var name='aleft'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='aleft' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
	</ul>
	<p>You may purchase any of the armor listed below.</p>
	<tmpl_if name='error'>
		<p style='color:red'><!--tmpl_var name='error'--></p>
	</tmpl_if>
	<tmpl_if name='message'>
		<p style='color:green'><!--tmpl_var name='message'--></p>
	</tmpl_if>
	<ul>
		<tmpl_loop name='armor'>
			<li>
				<strong><!--tmpl_var name='name'--></strong> - <em><!--tmpl_var name='price'--> gold coins</em>
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='armor-id' value='<!--tmpl_var name="id"-->' />
					<input type='submit' value='Buy' />
				</form>
			</li>
		</tmpl_loop>
	</ul>
</body>
</html>

If that code looks at all similar to you, that’s because it is – it’s almost entirely copied from the weapon shop template code. While I prefer to write templates for each individual piece of functionality/view, no matter how similar they are, it’s entirely up to you – and you could probably refactor the two templates into one – although I’ll leave that as an exercise for the reader.

Seeing as there will probably be a lot more armor in our game compared to weapons(5 slots to fill instead of just 1 or 2), we’ll display a little bit more armor – and retrieve 10 different pieces using this query:

SELECT DISTINCT(id), name, price FROM items WHERE type = 'Armor' ORDER BY RAND() LIMIT 10;

We’ve figured out how to display our armor shop, and how to retrieve the items that will be for sale inside of it – but we still haven’t written the page that will actually handle all of our functionality. It’s time to build armor-shop.cgi:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
$sth = $dbh->prepare("SELECT DISTINCT(id), name, price FROM items WHERE type = 'Armor' ORDER BY RAND() LIMIT 10");
$sth->execute();
my @armor = ();
while(my $row = $sth->fetchrow_hashref) {
	push @armor, $row;
}
$parameters{armor} = \@armor;
my @stats = qw(atorso ahead alegs aright aleft);
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
foreach my $key (@stats) {
	my $id = stats::getStat($key,$userID);
	$sth->execute($id);
	my $name;
	$sth->bind_columns(\$name);
	if($sth->fetch) {
		$parameters{$key} = $name;
	}
 
}
 
my $template = HTML::Template->new(
		filename	=>	'armor-shop.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;

This code is extremely similar to the weapons shop, too – because at the core of it, all we’re doing for weapons or armor or any other type of item is shuffling items around. However, you may notice one fairly large difference between this and weapon shop code: there doesn’t seem to be any code to display the user’s current armor!

However, this isn’t actually true – all we’ve done is convert our retrieval logic to something that’s a little more generic when it retrieves things. Lines 34-45 contain all of the code we need to display as many stats we want – although we’re currently only displaying the current armor for the user.

It’s a fairly simple piece of code, really. We begin by defining the keys within our stats system for the different stats, and then looping through those keys. At that point, our code is the same as it’s always been – we just retrieve the name of our item, and then store it into our template. It’s pretty simple, and pretty handy – instead of writing 50+ lines of code(10 lines per armor slot), we’ve written just 10 that will handle it all for us. We can get away with doing this because of the way that we’ve set up the keys in both our stats system and our template – because they’re the same, we can retrieve from the database and store the data back into the template using the same key.

As cool as that is, though, we haven’t gotten to the actual point of our armor shop – buying armor! Therefore, we now need to build that logic. But before we can build that, we need to create armorstats.pm, so that we can retrieve stats for individual pieces of armor:

1
2
3
4
5
6
7
8
9
10
11

package armorstats;
use DBI;
 
use statsDRY;
 
sub getArmorStat {
	my ($statName,$userID) = @_;
	return statsDRY::getStatDRY('Item',$statName,$userID);
}
 
1;

With that finished, we can now write our code to purchase armor:

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

if(%arguments) {
	use armorstats;
	my $armorID = $arguments{'armor-id'};
	$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
	$sth->execute($armorID);
	my $cost;
	$sth->bind_columns(\$cost);
	$sth->fetch;
	my $gold = stats::getStat('gc',$userID);
	if ($gold > $cost) {
		my $slot = armorstats::getArmorStat('aslot',$armorID);
		my $equipped = stats::getStat($slot,$userID);
		if(!$equipped) {
			stats::setStat($slot,$userID,$armorID);
			stats::setStat('gc',$userID,($gold - $cost));
			$parameters{'message'} = 'You purchased and equipped the new armor.';
		} else {
			# they already have something equipped - display an error message
			$parameters{'error'} = 'You are already wearing a piece of that kind of armor! You will need to sell your current armor before you can buy new armor.';
		}
	} else {
		$parameters{'error'} = 'You cannot afford that piece of armor.';
	}
}

And with that added, users can purchase armor to wear. As you can see, we are using our aslot stat to keep track of which armor slot a specific piece of armor goes in – that way, we can reduce the amount of code that we have to write to handle more than one different armor slot.

So now players can buy armor – but they can’t quite sell it yet. We’ll add in the code to handle what happens when a user clicks the ’sell’ button next to a piece of armor they’re wearing:

30
31
32
33
34
35
36
37
38
39
40

	if($arguments{sell}) {
		my $armorID = stats::getStat($arguments{sell},$userID);
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($armorID);
		my $price;
		$sth->bind_columns(\$price);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		stats::setStat('gc',$userID,($gold + $price));
		stats::setStat($arguments{sell},$userID,'');
	} else {

And with that, users can now buy and sell armor. The last change we need to make is to index.tmpl, where we’ll add the ‘Armor Shop’ link:

19

	<p><a href='armor-shop.cgi'>The Armor Shop</a></p>

And that’s all there is to it! Here’s the code for armor-shop.cgi:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
if(%arguments) {
	use armorstats;
	if($arguments{sell}) {
		my $armorID = stats::getStat($arguments{sell},$userID);
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($armorID);
		my $price;
		$sth->bind_columns(\$price);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		stats::setStat('gc',$userID,($gold + $price));
		stats::setStat($arguments{sell},$userID,'');
	} else {
		my $armorID = $arguments{'armor-id'};
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($armorID);
		my $cost;
		$sth->bind_columns(\$cost);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		if ($gold > $cost) {
			my $slot = armorstats::getArmorStat('aslot',$armorID);
			my $equipped = stats::getStat($slot,$userID);
			if(!$equipped) {
				stats::setStat($slot,$userID,$armorID);
				stats::setStat('gc',$userID,($gold - $cost));
				$parameters{'message'} = 'You purchased and equipped the new armor.';
			} else {
				# they already have something equipped - display an error message
				$parameters{'error'} = 'You are already wearing a piece of that kind of armor! You will need to sell your current armor before you can buy new armor.';
			}
		} else {
			$parameters{'error'} = 'You cannot afford that piece of armor.';
		}
	}
}
 
$sth = $dbh->prepare("SELECT DISTINCT(id), name, price FROM items WHERE type = 'Armor' ORDER BY RAND() LIMIT 10");
$sth->execute();
my @armor = ();
while(my $row = $sth->fetchrow_hashref) {
	push @armor, $row;
}
$parameters{armor} = \@armor;
my @stats = qw(atorso ahead alegs aright aleft);
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
foreach my $key (@stats) {
	my $id = stats::getStat($key,$userID);
	$sth->execute($id);
	my $name;
	$sth->bind_columns(\$name);
	if($sth->fetch) {
		$parameters{$key} = $name;
	}
 
}
 
my $template = HTML::Template->new(
		filename	=>	'armor-shop.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;

And here’s our template file(armor-shop.tmpl):

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

<html>
<head>
	<title>The Armor Shop</title>
</head>
<body>
	<p>Welcome to the Armor Shop.</p>
	<p><a href='index.cgi'>Back to main</a></p>
	<h3>Current Armor:</h3>
	<ul>
		<li>
			Head:
			<tmpl_if name='ahead'>
				<!-- tmpl_var name='ahead'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='ahead' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Torso:
			<tmpl_if name='atorso'>
				<!-- tmpl_var name='atorso'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='atorso' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Legs:
			<tmpl_if name='alegs'>
				<!-- tmpl_var name='alegs'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='alegs' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Right Arm:
			<tmpl_if name='aright'>
				<!-- tmpl_var name='aright'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='aright' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Left Arm:
			<tmpl_if name='aleft'>
				<!-- tmpl_var name='aleft'-->
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='aleft' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
	</ul>
	<p>You may purchase any of the armor listed below.</p>
	<tmpl_if name='error'>
		<p style='color:red'><!--tmpl_var name='error'--></p>
	</tmpl_if>
	<tmpl_if name='message'>
		<p style='color:green'><!--tmpl_var name='message'--></p>
	</tmpl_if>
	<ul>
		<tmpl_loop name='armor'>
			<li>
				<strong><!--tmpl_var name='name'--></strong> - <em><!--tmpl_var name='price'--> gold coins</em>
				<form action='armor-shop.cgi' method='post'>
					<input type='hidden' name='armor-id' value='<!--tmpl_var name="id"-->' />
					<input type='submit' value='Buy' />
				</form>
			</li>
		</tmpl_loop>
	</ul>
</body>
</html>

If you’re having issues getting some armor into your shop to play with, here’s a quick SQL query you can run to insert some sample armors:

INSERT INTO items(name,type,price) VALUES ('Sample Helmet','Armor',10);
	INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE short_name='aslot'),(SELECT id FROM items WHERE name='Sample Helmet'),'ahead','Item');
INSERT INTO items(name,type,price) VALUES ('Sample Torso','Armor',10);
	INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE short_name='aslot'),(SELECT id FROM items WHERE name='Sample Torso'),'atorso','Item');
INSERT INTO items(name,type,price) VALUES ('Sample Legs','Armor',10);
	INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE short_name='aslot'),(SELECT id FROM items WHERE name='Sample Legs'),'alegs','Item');
INSERT INTO items(name,type,price) VALUES ('Sample Right Arm','Armor',10);
	INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE short_name='aslot'),(SELECT id FROM items WHERE name='Sample Right Arm'),'aright','Item');
INSERT INTO items(name,type,price) VALUES ('Sample Left Arm','Armor',10);
	INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE short_name='aslot'),(SELECT id FROM items WHERE name='Sample Left Arm'),'aleft','Item');

Extra Credit

  1. Refactor the weapon shop code to use the same code as the armor shop for displaying current equipment.
  2. Refactor the weapon/armor shop templates so that both pages can use the same template.
  3. Refactor both pieces of code, so that there is only one template and one code file for weapons and armor.

There was a small bug found in the weapon stat’s retrieval code during the writing of this entry – make sure to update your checked out version!

]]> http://buildingbrowsergames.com/2008/09/25/buying-armor-perl/feed/ 0 Building Browsergames: Integrating weapons into our combat system (Perl) http://buildingbrowsergames.com/2008/09/15/integrating-weapons-into-our-combat-system-perl/ http://buildingbrowsergames.com/2008/09/15/integrating-weapons-into-our-combat-system-perl/#comments Mon, 15 Sep 2008 14:00:29 +0000 Luke http://buildingbrowsergames.com/?p=358 Even though we’ve built a combat system and a weapons system, we haven’t done anything yet to make them work together. Today, we’re going to be modifying our combat system so that it takes into account the ‘attack’ attribute of the user’s current primary weapon.

This is a quick, easy change – all we have to do is retrieve the ‘attack’ stat for the user’s primary weapon, and then add it onto their attack stat for our combat calculations. Here’s the code that retrieves a players stats, from forest.cgi:

28
29
30
31
32
33

my %player = (
	name		=>	$username,
	attack		=>	stats::getStat('atk',$userID),
	defence		=>	stats::getStat('def',$userID),
	curhp		=>	stats::getStat('curhp',$userID)
);

If you’ve been following along with all of the tutorials so far, you might have noticed a slight problem: we can’t retrieve weapon stats yet. Thanks to our DRY changes from earlier, it’s easy to write that code:

1
2
3
4
5
6
7
8
9
10
11

package weaponstats;
use DBI;
 
use statsDRY;
 
sub getWeaponStat {
	my ($statName,$userID) = @_;
	return statsDRY::getStatDRY('Weapon',$statName,$userID);
}
 
1;

It’s even easier because we aren’t going to be allowing users to change the stats – which means we only need to write the code to retrieve them(and not update them).

With that finished, we’re going to make sure that forest.cgi includes the new code:

8

use weaponstats;

Because our combat formula is as simple as it is(attack – defence), all we need to do is modify the ‘attack’ value that we stored in the %player hash with the attack for their primary weapon:

my $phand = stats::getStat('phand',$userID);
$player{attack} += weaponstats::getWeaponStat('atk',$phand);

And with that small piece of code added, we’re done! If the weapon has an attack value, it will be added to the player’s attack when they fight the monster – even if it’s negative.

Extra Credit

  • Make it so that only positive attack values are added to the player’s attack.

There was a small bug with the stats retrieval code found in this version of the tutorial – it has been fixed in the latest revision of the Google Code Repository. Make sure to update if you’ve been using it!

]]> http://buildingbrowsergames.com/2008/09/15/integrating-weapons-into-our-combat-system-perl/feed/ 0 Building Browsergames: now on Google Code! http://buildingbrowsergames.com/2008/08/28/building-browsergames-now-on-google-code/ http://buildingbrowsergames.com/2008/08/28/building-browsergames-now-on-google-code/#comments Thu, 28 Aug 2008 14:00:43 +0000 Luke http://buildingbrowsergames.com/?p=274 If you’ve been following along with our tutorial at all, you may have noticed that our code files tend to…evolve over time. Templates go from being simple list-of-links affairs to being filled with loops and conditionals and all kinds of other goodies.

Today, I have news for you that will make it much easier to follow the different versions that our tutorial goes through – it’s now under source control! With the help of John Munsch, the Building Browsergames tutorial is now on Google Code. You can take a look at the project by visiting http://code.google.com/p/building-browsergames-tutorial/. You can check out the latest version of the entire tutorial’s codebase by issuing this command:

svn checkout http://building-browsergames-tutorial.googlecode.com/svn/trunk building-browsergames-tutorial-read-only

Which will retrieve the latest version(in all languages) and store it into a directory called building-browsergames-tutorial-read-only. If you’d like to check out the latest version of the code for a specific language, you can use this command:

svn checkout http://building-browsergames-tutorial.googlecode.com/svn/trunk/language/pbbg buildingbrowsergames-tutorial-read-only

..Where ‘language’ is one of the languages that the tutorial has been implemented in(currently, ‘perl’, ‘php’, and ‘rubyonrails’ are available).

You can also update the code if you retrieved the latest copy and then new changes are committed by running the svn update command:

svn update

Don’t know what Subversion is, or how to use it on your system? Take a look at this introduction to Subversion screencast to learn more.

]]> http://buildingbrowsergames.com/2008/08/28/building-browsergames-now-on-google-code/feed/ 1 Building Browsergames: Swapping Weapons (Perl) http://buildingbrowsergames.com/2008/08/20/swapping-weapons-perl/ http://buildingbrowsergames.com/2008/08/20/swapping-weapons-perl/#comments Wed, 20 Aug 2008 14:00:13 +0000 Luke http://buildingbrowsergames.com/?p=236 The results of our poll from earlier have been decided, and the option ‘Toggle active weapons’ won by a slim margin. So, that’s what we’ll be building today!

The ’swap weapon’ page is a simple one – we’ve already written most of the code when we wrote the purchasing logic in our weapon shop from earlier. To start off with, we’ll need a template(named equipment.tmpl):

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

<html>
<head>
	<title>Equipment Management</title>
</head>
<body>
	<h3>Current Equipment:</h3>
	<p><a href='index.cgi'>Back to main</a></p>
	<ul>
		<li>
			Primary Hand:
			<tmpl_if name='phand'>
				<!--tmpl_var name='phand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='phand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Secondary Hand:
			<tmpl_if name='shand'>
				<!--tmpl_var name='shand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='shand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
	</ul>
	<p>
		<form action='equipment.cgi' method='post'>
			<input type='submit' value='Swap' name='swap' />
		</form>
	</p>
</body>
</html>

This is a simple template, and is actually a duplication of our weapon shop’s template – right down to the ‘Sell’ button. By leaving the ‘Sell’ button on this page, users can sell their weapons from the equipment management screen if they so choose(also, because of this duplication we can trim this down to a common template – but that will come later). We have to make sure that the ’swap’ button has a ‘name’ attribute, so that we can make sure our page was POSTed to and swap the player’s weapons.

Next, we’ll build equipment.cgi, which is the page responsible for retrieiving the weapons a user is user, and displaying our template:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
my $phand = stats::getStat('phand',$userID);
my $shand = stats::getStat('shand',$userID);
 
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
$sth->execute($phand);
my $phand_name;
$sth->bind_columns(\$phand_name);
$sth->fetch;
if($phand_name) {
	$parameters{phand} = $phand_name;
}
 
# $sth is already prepared, so all we do is re-execute
$sth->execute($shand);
my $shand_name;
$sth->bind_columns(\$shand_name);
$sth->fetch;
$parameters{shand} = $shand_name if $shand_name;
my $template = HTML::Template->new(
		filename	=>	'equipment.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;

We don’t need to add much to implement weapon swapping; just a simple swap when users click on the ’swap’ button. We do this by checking to see if the page has been POSTed to – if it has, we perform the swap:

29
30
31
32
33
34
35

if(%arguments) {
	stats::setStat('phand',$userID,$shand);
	stats::setStat('shand',$userID,$phand);
	my $temp = $shand;
	$shand = $phand;
	$phand = $temp;	
}

With that done, we’re finished! Users can now swap the weapons in their primary and secondary hands quickly and easily from the equipment management page. All we have left to do is add a link to the equipment management page to our index template:

19

	<p><a href='equipment.cgi'>Equipment Management</a></p>

And we’re done! Here’s our template:

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

<html>
<head>
	<title>Equipment Management</title>
</head>
<body>
	<h3>Current Equipment:</h3>
	<p><a href='index.cgi'>Back to main</a></p>
	<ul>
		<li>
			Primary Hand:
			<tmpl_if name='phand'>
				<!--tmpl_var name='phand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='phand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Secondary Hand:
			<tmpl_if name='shand'>
				<!--tmpl_var name='shand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='shand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
	</ul>
	<p>
		<form action='equipment.cgi' method='post'>
			<input type='submit' value='Swap' name='swap' />
		</form>
	</p>
</body>
</html>

And here’s the code responsible for displaying it and handling the swap:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
my $phand = stats::getStat('phand',$userID);
my $shand = stats::getStat('shand',$userID);
if(%arguments) {
	stats::setStat('phand',$userID,$shand);
	stats::setStat('shand',$userID,$phand);
	my $temp = $shand;
	$shand = $phand;
	$phand = $temp;	
}
 
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
$sth->execute($phand);
my $phand_name;
$sth->bind_columns(\$phand_name);
$sth->fetch;
if($phand_name) {
	$parameters{phand} = $phand_name;
}
 
# $sth is already prepared, so all we do is re-execute
$sth->execute($shand);
my $shand_name;
$sth->bind_columns(\$shand_name);
$sth->fetch;
$parameters{shand} = $shand_name if $shand_name;
my $template = HTML::Template->new(
		filename	=>	'equipment.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;
]]> http://buildingbrowsergames.com/2008/08/20/swapping-weapons-perl/feed/ 0 Building Browsergames: Buying Weapons (Perl) http://buildingbrowsergames.com/2008/08/12/building-browsergames-buying-weapons-perl/ http://buildingbrowsergames.com/2008/08/12/building-browsergames-buying-weapons-perl/#comments Tue, 12 Aug 2008 14:00:21 +0000 Luke http://buildingbrowsergames.com/?p=155 The winner in our poll from earlier in regards to weapons was that players should be able to carry two weapons(of any type they want), with a primary and a secondary hand that can both have weapons in them.

Our stats system is the perfect way to implement this – we just add two more stats, so that we can keep track of which weapon is in the player’s primary hand, and which is in their secondary hand.

INSERT INTO stats(display_name, short_name) VALUES ('Primary Hand Weapon','phand'),('Secondary Hand Weapon','shand');

With our new stats inserted, we can write code to take advantage of them. But how will users get weapons to populate those stats with?

For now at least, players will buy weapons at the Weapon Shop – which is what we will build today. The weapon shop will display a list of weapons that are available for players to purchase, and automatically put the weapon purchased into a player’s primary or secondary hand for the player8.

In order to make our items work in a shop setting, however, we need to add something that we’re currently missing – prices! We’ll add a column to our items table called ‘price’, because every item should have a price. We’ll also set it to a default of 10(so prices are defaulted to 10 gold coins):

ALTER TABLE  'items' ADD  'price' INT NOT NULL DEFAULT  '10';

With that change made, we can start building the template for our Weapon Shop. To start off, we’ll build a template and save it as weapon-shop.tmpl:

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

<html>
<head>
	<title>The Weapon Shop</title>
</head>
<body>
	<p>Welcome to the Weapon Shop.</p>
	<h3>Current Equipment:</h3>
	<ul>
		<li>Primary Hand: <tmpl_if name='phand'><!--tmpl_var name='phand'--><tmpl_else>None</tmpl_if></li>
		<li>Secondary Hand: <tmpl_if name='shand'><!--tmpl_var name='shand'--><tmpl_else>None</tmpl_if></li>
	</ul>
	<p>Below are the weapons currently available for purchase.</p>
	<ul>
		<tmpl_loop name='weapons'>
			<li>
				<strong><!--tmpl_var name='name'--></strong> - <em><!--tmpl_var name='price'--> gold coins</em>
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='weapon-id' value='<!--tmpl_var name="id"-->' />
					<input type='submit' value='Buy' />
				</form>
			</li>
		</tmpl_loop>
	</ul>
</body>
</html>

As you can see in our template, we’ll be using a tmpl_loop to list off all of the weapons that are available for users to purchase. We’re going to use a fairly simple SQL query to retrieve 5 weapons(If you’d like to see the SQL query to retrieve a random list of items, take a look at yesterday’s post on Building the Weapon Shop in PHP):

SELECT DISTINCT(id), name, price FROM items WHERE type = 'Weapon' LIMIT 5;

Now that we have written the SQL query we’ll be using to retrieve our wepaons for sale, we need to quickly write the Perl to handle the information returned by that query, inside weapon-shop.cgi:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
$sth = $dbh->prepare("SELECT DISTINCT(id), name, price FROM items WHERE type = 'Weapon' LIMIT 5");
$sth->execute();
my @weapons = ();
while(my $row = $sth->fetchrow_hashref) {
	push @weapons, $row;
}
 
$parameters{weapons} = \@weapons;
 
my $phand = stats::getStat('phand',$userID);
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
$sth->execute($phand);
my $phand_name;
$sth->bind_columns(\$phand_name);
$sth->fetch;
if($phand_name) {
	$parameters{phand} = $phand_name;
}
 
my $shand = stats::getStat('shand',$userID);
# $sth is already prepared, so all we do is re-execute
$sth->execute($shand);
my $shand_name;
$sth->bind_columns(\$shand_name);
$sth->fetch;
$parameters{shand} = $shand_name if $shand_name;
my $template = HTML::Template->new(
		filename	=>	'weapon-shop.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;

We loop through all of the data that our SQL query returns, and add the information to an array – using that array, we display information on each weapon that is available within our weapon shop. We display each weapon’s name, price, and a ‘Buy’ button that users can use to purchase the weapon in question. Now all we need to do is make it possible for users to actually buy the weapons.

As you saw in our template, there is a form inside each of our weapon entries, with a ‘Buy’ button and a hidden input that stores the ID of the weapon users might choose to buy. We will modify weapon-shop.cgi so that when users click on the ‘Buy’ button, we purchase the weapon in question for them – or display a helpful message if they can’t afford it. First off, we’ll modify our template so that it can display the messages for us:

13
14
15
16
17
18

<tmpl_if name='error'>
	<p style='color:red'><!--tmpl_var name='error'--></p>
</tmpl_if>
<tmpl_if name='message'>
	<p style='color:green'><!--tmpl_var name='message'--></p>
</tmpl_if>

With that quick modification made, we can add to our code so that we can handle users clicking on the ‘Buy’ button for specific weapons:

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

my $phand = stats::getStat('phand',$userID);
my $shand = stats::getStat('shand',$userID);
if(%arguments) {
	my $weaponID = $arguments{'weapon-id'};
	$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
	$sth->execute($weaponID);
	my $cost;
	$sth->bind_columns(\$cost);
	$sth->fetch;
	my $gold = stats::getStat('gc',$userID);
	if($gold > $cost) {
		if(!$phand) {
			stats::setStat('phand',$userID,$weaponID);
			stats::setStat('gc',$userID,($gold - $cost));
			$phand = $weaponID;
			$parameters{message} = 'You equipped the weapon in your primary hand.';
		} else {
			if(!$shand) {
				stats::setStat('shand',$userID,$weaponID);
				stats::setStat('gc',$userID,($gold - $cost));
				$shand = $weaponID;
				$parameters{message} = 'You equipped the weapon in your secondary hand.';
			} else {
				$parameters{error} = 'You already have two weapons! You must sell one before equipping another.';
			}
		}
	} else {
		$parameters{error} = 'You cannot afford that weapon!';
	}
}

We have written some simple logic to swap the weapons for our player in this situation – if their primary hand is empty, that is where the weapon goes. If their secondary hand is empty, it goes there – and if both hands are full, a message is displayed telling the user to sell one of their weapons.

At the moment, there isn’t a way for users to sell their weapons if they want to purchase a new one – but not for long! Open up weapon-shop.tmpl again, and edit these lines:

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

<li>
	Primary Hand:
	<tmpl_if name='phand'>
		<!--tmpl_var name='phand'-->
		<form action='weapon-shop.cgi' method='post'>
			<input type='hidden' name='sell' value='phand' />
			<input type='submit' value='Sell' />
		</form>
	<tmpl_else>
		None
	</tmpl_if>
</li>
<li>
	Secondary Hand:
	<tmpl_if name='shand'>
		<!--tmpl_var name='shand'-->
		<form action='weapon-shop.cgi' method='post'>
			<input type='hidden' name='sell' value='shand' />
			<input type='submit' value='Sell' />
		</form>
	<tmpl_else>
		None
	</tmpl_if>
</li>

With our template modified, we’ll switch back to editing weapon-shop.cgi, and make a small change so that we can work off of the new arguments sent to us:

30
31
32
33
34
35
36
37
38
39
40
41
42

	if($arguments{sell}) {
		my $weaponID = stats::getStat($arguments{sell},$userID);
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($weaponID);
		my $cost;
		$sth->bind_columns(\$cost);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		stats::setStat('gc',$userID,($gold + $cost));
		stats::setStat($arguments{sell},$userID,'');
		$shand = stats::getStat('shand',$userID);
		$phand = stats::getStat('phand',$userID);
	} else {

And with that done, users are able to buy and sell weapons at the weapon shop. There is only one change left to make – adding a link to the weapon shop in our main template:

18

	<p><a href='weapon-shop.cgi'>The Weapon Shop</a></p>

And that’s that! We’ve built a fully working weapon shop, that allows users to buy and sell weapons at will. Here’s the code from weapon-shop.cgi in it’s entirety:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use HTML::Template;
use DBI;
use config;
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
my $sth;
my %parameters;
 
use stats;
 
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
$sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
 
my $phand = stats::getStat('phand',$userID);
my $shand = stats::getStat('shand',$userID);
if(%arguments) {
	if($arguments{sell}) {
		my $weaponID = stats::getStat($arguments{sell},$userID);
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($weaponID);
		my $cost;
		$sth->bind_columns(\$cost);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		stats::setStat('gc',$userID,($gold + $cost));
		stats::setStat($arguments{sell},$userID,'');
		$shand = stats::getStat('shand',$userID);
		$phand = stats::getStat('phand',$userID);
	} else {
		my $weaponID = $arguments{'weapon-id'};
		$sth = $dbh->prepare("SELECT price FROM items WHERE id = ?");
		$sth->execute($weaponID);
		my $cost;
		$sth->bind_columns(\$cost);
		$sth->fetch;
		my $gold = stats::getStat('gc',$userID);
		if($gold > $cost) {
			if(!$phand) {
				stats::setStat('phand',$userID,$weaponID);
				stats::setStat('gc',$userID,($gold - $cost));
				$phand = $weaponID;
				$parameters{message} = 'You equipped the weapon in your primary hand.';
			} else {
				if(!$shand) {
					stats::setStat('shand',$userID,$weaponID);
					stats::setStat('gc',$userID,($gold - $cost));
					$shand = $weaponID;
					$parameters{message} = 'You equipped the weapon in your secondary hand.';
				} else {
					$parameters{error} = 'You already have two weapons! You must sell one before equipping another.';
				}
			}
		} else {
			$parameters{error} = 'You cannot afford that weapon!';
		}
	}
}
 
$sth = $dbh->prepare("SELECT DISTINCT(id), name, price FROM items WHERE type = 'Weapon' LIMIT 5");
$sth->execute();
my @weapons = ();
while(my $row = $sth->fetchrow_hashref) {
	push @weapons, $row;
}
 
$parameters{weapons} = \@weapons;
 
$sth = $dbh->prepare("SELECT name FROM items WHERE id = ?");
$sth->execute($phand);
my $phand_name;
$sth->bind_columns(\$phand_name);
$sth->fetch;
if($phand_name) {
	$parameters{phand} = $phand_name;
}
 
# $sth is already prepared, so all we do is re-execute
$sth->execute($shand);
my $shand_name;
$sth->bind_columns(\$shand_name);
$sth->fetch;
$parameters{shand} = $shand_name if $shand_name;
my $template = HTML::Template->new(
		filename	=>	'weapon-shop.tmpl',
		associate	=>	$query,
	);
$template->param(%parameters);
print $query->header(), $template->output;

And here’s our template file(weapon-shop.tmpl):

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

<html>
<head>
	<title>The Weapon Shop</title>
</head>
<body>
	<p>Welcome to the Weapon Shop.</p>
	<h3>Current Equipment:</h3>
	<ul>
		<li>
			Primary Hand:
			<tmpl_if name='phand'>
				<!--tmpl_var name='phand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='phand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
		<li>
			Secondary Hand:
			<tmpl_if name='shand'>
				<!--tmpl_var name='shand'-->
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='sell' value='shand' />
					<input type='submit' value='Sell' />
				</form>
			<tmpl_else>
				None
			</tmpl_if>
		</li>
	</ul>
	<p>Below are the weapons currently available for purchase.</p>
	<tmpl_if name='error'>
		<p style='color:red'><!--tmpl_var name='error'--></p>
	</tmpl_if>
	<tmpl_if name='message'>
		<p style='color:green'><!--tmpl_var name='message'--></p>
	</tmpl_if>
	<ul>
		<tmpl_loop name='weapons'>
			<li>
				<strong><!--tmpl_var name='name'--></strong> - <em><!--tmpl_var name='price'--> gold coins</em>
				<form action='weapon-shop.cgi' method='post'>
					<input type='hidden' name='weapon-id' value='<!--tmpl_var name="id"-->' />
					<input type='submit' value='Buy' />
				</form>
			</li>
		</tmpl_loop>
	</ul>
</body>
</html>

Extra Credit

  1. Make the shop display how much gold a user has remaining after they purchase a weapon.
  2. Make the shop display only weapons that the player can afford.
]]> http://buildingbrowsergames.com/2008/08/12/building-browsergames-buying-weapons-perl/feed/ 0 Building Browsergames: Securing our hashes (Perl) http://buildingbrowsergames.com/2008/07/16/securing-our-hashes-perl/ http://buildingbrowsergames.com/2008/07/16/securing-our-hashes-perl/#comments Wed, 16 Jul 2008 14:00:59 +0000 Luke http://buildingbrowsergames.com/?p=85 Yesterday, we worked on securing our hashes in PHP – and today, we’re going to take a look at our Perl systems.

According to tilly from perlmonks, crypt() is horribly insecure – which is definitely a big problem. We’re going to need to update our login and registration system, so that our user’s passwords are a little bit more secure if a malicious user ever gained access to our database.

First off, we’re going to convert our code to use the Digest::MD5 module so that we can MD5 our passwords – in addition to salting them. If you don’t have it already, you’ll need to install Digest::MD5. Enter this at your shell(or get your web host to install it for you if they haven’t already):

cpan install Digest::MD5

After installing Digest::MD5, we need to change each line that calls crypt() inside register.cgi and login.cgi. Here’s what the relevant line in register.cgi looks like now:

33
34

			use Digest::MD5 qw(md5);
			$sth->execute($arguments{username},md5('saltgoeshere' . $arguments{password}));

And that’s the only change that you need to make to your register or login code – just adjusting your execute() statements to md5 the password, and making sure that you 

use Digest::MD5

in each code file.

However, if you upload your new files and take a look, you’ll notice something – you can no longer log in!

Unfortunately, making this change has broken logins for all of our users who signed up before we had to make this change. Now, if your game hasn’t been released to the public yet or everyone is used to you ‘resetting’ the game, this is fine – but if users are already playing your game, this is a bit of an issue. So we’re going to modify login.cgi, so that it first checks to see whether a user is still using a crypt()’d password or not – and if they are, it will redirect them to a page where they can change their password. Here’s what login.cgi looks like now:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use DBI;
use config;		# this is our database settings
use HTML::Template;
use Digest::MD5 qw(md5);
 
my $query = new CGI;
my %arguments = $query->Vars;
 
my $template = HTML::Template->new(
		filename	=>	'login.tmpl',
		associate	=>	$query,		# for argument memory
	);
my %parameters;
 
if(%arguments) {
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT COUNT(id) FROM users WHERE UPPER(username) = UPPER(?) AND password = ?");
	my $count;
	$sth->execute($arguments{username},crypt($arguments{password},$arguments{username}));
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 1) {
		my $cookie = $query->cookie(
				-name	=>	'username+password',
				-value	=>	$arguments{username} . '+' . crypt($arguments{password},$arguments{username}),
				-expires	=>	'+3M',
			);
		my $uri = 'changepass.cgi';
		print $query->header(-cookie=>$cookie,-location=>$uri);
	} else {
		$sth = $dbh->prepare("SELECT COUNT(id) FROM users WHERE UPPER(username) = UPPER(?) AND password = ?");
		$sth->execute($arguments{username},md5('saltgoeshere' . $arguments{password}));
		$sth->bind_columns(\$count);
		$sth->fetch;
		if($count == 1) {
			$sth = $dbh->prepare("UPDATE users SET last_login = NOW() WHERE UPPER(username) = UPPER(?) AND password = ?");
			$sth->execute($arguments{username},md5('saltgoeshere' . $arguments{password}));
			$sth = $dbh->prepare("SELECT is_admin FROM users WHERE UPPER(username) = UPPER(?) AND password = ?");
			my $is_admin;
			$sth->execute($arguments{username},md5('saltgoeshere' . $arguments{password}));
			$sth->bind_columns(\$is_admin);
			$sth->fetch;
			my $cookie = $query->cookie(
					-name	=>	'username+password',
					-value	=>	$arguments{username} . '+' . md5('saltgoeshere' . $arguments{password}),
					-expires	=>	'+3M',
				);
			my $uri = 'index.cgi';
			if($is_admin == 1) {
				# redirect to admin page
				$uri = 'admin.cgi';
			}
			print $query->header(-cookie=>$cookie,-location=>$uri);
		} else {
		$parameters{error} = 'That username and password combination does not match any currently in our database.';
		}
	}
}
 
$template->param(%parameters);
print $query->header(),$template->output();

It might be hard to tell what’s different, there – but take a look at our code to check and see if the user’s information matched anything in our database. We start off by checking the username and password using crypt() – and if it matches anything, we redirect them to changepass.cgi – which we’ll be building shortly. If it doesn’t match with crypt(), we check to see if it matches with Digest::MD5’s md5() function – and if it doesn’t match either of those, we tell the user that it didn’t match anything.

If you haven’t guessed it yet, changepass.cgi is going to be the page users use to change their password. Here’s what the template(changepass.tmpl) looks like:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

<html>
<head>
	<title>Change Password</title>
</head>
<body>
	<tmpl_if name='error'>
		<span style='color:red'>Error: <!--tmpl_var name='error'--></span>
	</tmpl_if>
	<tmpl_if name='message'>
		<span style='color:green'><!--tmpl_var name='message'--></span>
	</tmpl_if>
	<form method='post' action='changepass.cgi'>
		Password: <input type='password' name='password' id='password' /><br />
		Confirm Password: <input type='password' name='confirm' /><br />
		<input type='submit' value='Change Password' />
	</form>
	<script type='text/javascript'>
	document.getElementById('password').focus();
	</script>
</body>
</html>

Here’s the code for changepass.cgi:

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

#!/usr/bin/perl -w
 
use strict;
use CGI qw(:cgi);
use DBI;
use config;
use Digest::MD5 qw(md5);
use HTML::Template;
 
require login;
 
my $query = new CGI;
my %arguments = $query->Vars;
my $cookie = $query->cookie('username+password');
my ($username) = split(/\+/,$cookie);
my %params;
 
if(%arguments) {
	if($arguments{password} ne $arguments{confirm}) {
		$params{error} = 'Passwords do not match!';
	} else {
		my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
		my $sth = $dbh->prepare("UPDATE users SET password = ? WHERE UPPER(username) = UPPER(?)");
		$sth->execute(md5('saltgoeshere' . $arguments{password}),$username);
		$params{message} = "Password updated successfully.";
	}
}
 
my $template = HTML::Template->new(
		filename	=>	'changepass.tmpl',
	);
$template->param(%params);
print $query->header(), $template->output;

And that’s all there is to it! By making this quick change, we’ve secured our user passwords a little better against any malicious users – and as an added bonus, we’ve created a change password page!

Note: don’t forget to change ’saltgoeshere’ to an actually random value, like ’s79dj@#*(hd’ or something – you won’t make any security gains if malicious users can easily guess your password salt. If you’re feeling really adventurous, you could(and probably should) turn the salt into a configuration parameter – but I’ll leave how to do that up to you.

]]> http://buildingbrowsergames.com/2008/07/16/securing-our-hashes-perl/feed/ 0 Building Browsergames: DRYing out our stats http://buildingbrowsergames.com/2008/07/11/drying-out-our-stats/ http://buildingbrowsergames.com/2008/07/11/drying-out-our-stats/#comments Fri, 11 Jul 2008 14:00:35 +0000 Luke http://buildingbrowsergames.com/?p=82 Over the course of developing our game, our database has sort of grown organically. As we added a new feature, we’d add the tables we needed to accomodate this feature. While this works(and has been working for us just fine), it’s not neccessarily the best way to design your database – because as you can see, we now have 3 stats tables(user_stats,monster_stats, and item_stats) when we only actually need one – as sepp has once again helpfully pointed out.

With that in mind, we’re going to create another table, to replace those three. Because lots of different things can have stats, I’m going to call the table entity_stats – although if you want to, you can call it whatever you want(but make sure to keep your change in mind when you’re working through this code). Here’s what we’re going to do to create the table:

CREATE TABLE entity_stats (
	id int NOT NULL AUTO_INCREMENT,
	stat_id int,
	entity_id int,
	value text,
	entity_type ENUM('User','Monster','Item'),
	PRIMARY KEY(id)
);

Now that we’ve created this new table, we’re going to need to customize our SQL queries slightly. Previously, we were only using an object’s ID value to retrieve the stats for it – now that we don’t have that separation, we will need to run the query based on two things – the object’s ID, and the object’s type.

Because we’ve been doing re-writing to our stats code, we’re actually in a good position to make this change – we only need to change the query in one file, instead of 3(or more). Our old SQL looked like this:

"SELECT value FROM table WHERE stat_id = (SELECT id FROM stats WHERE display_name = 'foo' OR short_name = 'bar') AND column = 'baz'"

The new SQL is going to look like this:

"SELECT value FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = 'foo' OR short_name = 'bar') AND entity_id = 'baz' AND type = 'bat'"

One of the benefits of doing this is that we’re actually going to be cleaning up our new DRY stats code a little bit more, too – we get to trim it down to only take a ‘type’ argument, instead of the table and column names it needs to retrieve with. Think back to our DRY stats code from earlier:

PHP

1
2
3
4
5
6
7
8
9
10
11
12

function getStatDRY($tableName,$columnName,$statName,$trackingID) {
	createIfNotExistsDRY($tableName,$columnName,$statName,$trackingID);
	$query = sprintf("SELECT value FROM %s WHERE stat_id = (SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s') AND %s = '%s'",
		mysql_real_escape_string($tableName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($columnName),
		mysql_real_escape_string($trackingID));
	$result = mysql_query($query);
	list($value) = mysql_fetch_row($result);
	return $value;		
}

Perl

1
2
3
4
5
6
7
8
9
10
11

sub getStatDRY {
	my ($tableName,$columnName,$statName,$userID) = @_;
	my $dbh = $dbh;
	createIfNotExistsDRY($tableName,$columnName,$statName,$userID);
	my $sth = $dbh->prepare("SELECT value FROM $tableName WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statName,$statName,$userID);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}

And here’s what it looks like with the change made:

PHP

1
2
3
4
5
6
7
8
9
10
11

function getStatDRY($type,$statName,$trackingID) {
	createIfNotExistsDRY($type,$statName,$trackingID);
	$query = sprintf("SELECT value FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s') AND entity_id = '%s' AND entity_type = '%s'",
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($trackingID),
		mysql_real_escape_string($type));
	$result = mysql_query($query);
	list($value) = mysql_fetch_row($result);
	return $value;		
}

Perl

1
2
3
4
5
6
7
8
9
10
11

sub getStatDRY {
	my ($type,$statName,$trackingID) = @_;
	my $dbh = $dbh;
	createIfNotExistsDRY($type,$statName,$userID);
	my $sth = $dbh->prepare("SELECT value FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND entity_id = ? AND entity_type = ?");
	$sth->execute($statName,$statName,$trackingID,$type);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}

Once we’ve made those changes, it’s easy to modify all of our code for the new database structure:

PHP

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

<?php
 
include 'database.php';
 
function getStatDRY($type,$statName,$trackingID) {
	createIfNotExistsDRY($type,$statName,$trackingID);
	$query = sprintf("SELECT value FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s') AND entity_id = '%s' AND entity_type = '%s'",
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($trackingID),
		mysql_real_escape_string($type));
	$result = mysql_query($query);
	list($value) = mysql_fetch_row($result);
	return $value;		
}
 
function setStatDRY($type,$statName,$trackingID,$value) {
	createIfNotExistsDRY($type,$statName,$trackingID);
	$query = sprintf("UPDATE entity_stats SET value = '%s' WHERE stat_id = (SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s') AND entity_id = '%s' AND entity_type = '%s'",
		mysql_real_escape_string($value),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($trackingID),
		mysql_real_escape_string($type));
	$result = mysql_query($query);
}
 
function createIfNotExistsDRY($type,$statName,$trackingID) {
	$query = sprintf("SELECT count(value) FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s') AND entity_id = '%s' AND entity_type ='%s'",
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($trackingID),
		mysql_real_escape_string($type));
	$result = mysql_query($query);
	list($count) = mysql_fetch_row($result);
	if($count == 0) {
		// the stat doesn't exist; insert it into the database
		$query = sprintf("INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE display_name = '%s' OR short_name = '%s'),'%s','%s','%s')",
		mysql_real_escape_string($statName),
		mysql_real_escape_string($statName),
		mysql_real_escape_string($trackingID),
		'0',
		mysql_real_escape_string($type));
		mysql_query($query);
	}	
}
 
?>

Perl

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

package statsDRY;
 
use database;
 
sub getStatDRY {
	my ($type,$statName,$trackingID) = @_;
	my $dbh = $dbh;
	createIfNotExistsDRY($type,$statName,$userID);
	my $sth = $dbh->prepare("SELECT value FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND entity_id = ? AND entity_type = ?");
	$sth->execute($statName,$statName,$trackingID,$type);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}
 
sub setStatDRY {
	my ($type,$statName,$trackingID,$statValue) = @_;
	my $dbh = $dbh;
	createIfNotExistsDRY($type,$statName,$userID);
	my $sth = $dbh->prepare("UPDATE entity_stats SET value = ? WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND entity_id = ? AND entity_type = ?");
	$sth->execute($statValue,$statName,$statName,$trackingID,$type);
}
 
sub createIfNotExistsDRY {
	my ($type,$statName, $trackingID) = @_;	
	my $dbh = $dbh;
	my $sth = $dbh->prepare("SELECT count(value) FROM entity_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND entity_id = ? AND entity_type = ?");
	$sth->execute($statName,$statName,$trackingID,$type);
	my $count;
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 0) {
		# no entry for that stat/user combination - insert one with a value of 0
		$sth = $dbh->prepare("INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) VALUES ((SELECT id FROM stats WHERE display_name = ? OR short_name = ?),?,?,?)");
		$sth->execute($statName,$statName,$userID,0,$type);
	}	
}
 
 
1;

And with that done, our change is made! Now it’s just a matter of modifying the code we created for each stat specifically(only one shown):

PHP

1
2
3
4
5
6
7
8
9
10
11
12

<?php
 
require_once 'stats-dry.php';
 
function getStat($statName,$userID) {
	return getStatDRY('user',$statName,$userID);
}
function setStat($statName,$userID,$value) {
	setStatDRY('user',$statName,$userID,$value);
}
 
?>

Perl

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

package stats;
use DBI;
 
use statsDRY;
 
sub getStat {
	my ($statName,$userID) = @_;
	return statsDRY::getStatDRY('user',$statName,$userID);
}
 
sub setStat {
	my ($statName,$userID,$statValue) = @_;
	statsDRY::setStatDRY('user',$statName,$userID,$statValue);
}
 
1;

And once all of the changes are done, you’re good! Now all of the stat values will be stored in a single table.

But what about users who have already registered for your game, or monsters and items that you’ve already added?

We definitely don’t want to have to tell every single person playing our game to re-register – so we’re going to write some quick SQL to copy the values over for us, before removing the tables that we no longer need:

INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) (SELECT stat_id,user_id,value,'user' FROM user_stats);
DROP TABLE user_stats;
INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) (SELECT stat_id,monster_id,value,'monster' FROM monster_stats);
DROP TABLE monster_stats;
INSERT INTO entity_stats(stat_id,entity_id,value,entity_type) (SELECT stat_id,item_id,value,'item' FROM item_stats);
DROP TABLE item_stats;

Once we’ve run that SQL, we’ll have deleted our 3 new tables – but not before we moved the data over from them to our new entity_stats table. Once you make the necessary modifications to your stats code and upload it all, take a look at your game – it will still work just like it did before!

This might seem like a weird thing to get excited about, but it’s a pretty big deal – we just changed a significant portion of our database, and didn’t break any of our existing code at all. This is why the DRY approach is so useful to have, and why you should always strive to use DRY in your designs to begin with – because making this change with the database logic spread accross dozens of files would drive even the calmest developer batty.

]]> http://buildingbrowsergames.com/2008/07/11/drying-out-our-stats/feed/ 0 Building Browsergames: DRYing out our database connections (Perl) http://buildingbrowsergames.com/2008/07/10/drying-out-our-database-connections-perl/ http://buildingbrowsergames.com/2008/07/10/drying-out-our-database-connections-perl/#comments Thu, 10 Jul 2008 14:00:39 +0000 Luke http://buildingbrowsergames.com/?p=81 One piece of our code that definitely needs a bit of DRYing out is our database connections – we keep copying and pasting the exact same code anytime we want to connect!

We’ve been repeatedly writing out the exact same three lines, any time we want to connect to a database – in some cases, even multiple times in the same file! This is the offending code:

1
2
3

use DBI;
use config;
my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});

While this has worked for us so far, it’s still a bit of a bad idea – what happens if our game suddenly changes and needs to work off of an Oracle database? You would need to go through and find every single file where this code occurs, and manually change it. Not fun.

With that in mind, we’re going to simplify things a little bit – by creating a file that exists purely to connect to the database for us. We’re going to merge our database code with some of our configuration file code, to create a file called database.pm:

1
2
3
4
5
6
7
8
9
10
11
12
13

package database;
 
use Exporter;
use DBI;
use config;
our @ISA = qw(Exporter);
 
our $dbh;
our @EXPORT = qw($dbh);
 
$dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
 
1;

And now that that’s done, we’ll never have to worry about copying and pasting those lines again! In any file that interacts with the database, all we need to do is add this line, right at the top:

use database;

Which means we can modify our DRY stats code from looking like this:

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

package statsDRY;
 
use DBI;
 
sub getStatDRY {
	my ($tableName,$columnName,$statName,$userID) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
	createIfNotExistsDRY($tableName,$columnName,$statName,$userID);
	my $sth = $dbh->prepare("SELECT value FROM $tableName WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statName,$statName,$userID);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}
 
sub setStatDRY {
	my ($tableName,$columnName,$statName,$userID,$statValue) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
	createIfNotExistsDRY($tableName,$columnName,$statName,$userID);
	my $sth = $dbh->prepare("UPDATE $tableName SET value = ? WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statValue,$statName,$statName,$userID);
}
 
sub createIfNotExistsDRY {
	my ($tableName,$columnName,$statName, $userID) = @_;	
	use config;
	my $dbh = DBI->connect("DBI:mysql:$config{dbName}:$config{dbHost}",$config{dbUser},$config{dbPass},{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT count(value) FROM $tableName WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statName,$statName,$userID);
	my $count;
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 0) {
		# no entry for that stat/user combination - insert one with a value of 0
		$sth = $dbh->prepare("INSERT INTO $tableName(stat_id,$columnName,value) VALUES ((SELECT id FROM stats WHERE display_name = ? OR short_name = ?),?,?)");
		$sth->execute($statName,$statName,$userID,0);
	}	
}
 
 
1;

Into something like this:

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

package statsDRY;
 
use database;
 
sub getStatDRY {
	my ($tableName,$columnName,$statName,$userID) = @_;
	createIfNotExistsDRY($tableName,$columnName,$statName,$userID);
	my $sth = $dbh->prepare("SELECT value FROM $tableName WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statName,$statName,$userID);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}
 
sub setStatDRY {
	my ($tableName,$columnName,$statName,$userID,$statValue) = @_;
	createIfNotExistsDRY($tableName,$columnName,$statName,$userID);
	my $sth = $dbh->prepare("UPDATE $tableName SET value = ? WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statValue,$statName,$statName,$userID);
}
 
sub createIfNotExistsDRY {
	my ($tableName,$columnName,$statName, $userID) = @_;	
	my $sth = $dbh->prepare("SELECT count(value) FROM $tableName WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND $columnName = ?");
	$sth->execute($statName,$statName,$userID);
	my $count;
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 0) {
		# no entry for that stat/user combination - insert one with a value of 0
		$sth = $dbh->prepare("INSERT INTO $tableName(stat_id,$columnName,value) VALUES ((SELECT id FROM stats WHERE display_name = ? OR short_name = ?),?,?)");
		$sth->execute($statName,$statName,$userID,0);
	}	
}
 
 
1;

Because we used the our keyword to put $dbh into the root scope, we don’t need to bother re-useing the database code that we’ve created – all we do is put a use statement at the start of our code file, and we’re in business.

There is one slight caveat, however – you need to be very careful about scope in a situation like this. Because $dbh is now in the root scope, it’s very easy to accidentally try to use it when another function is trying to as well – which causes weird bugs. A good way to prevent this is to just clone over $dbh in whatever function needs it:

my $dbh = $dbh;

At which point you don’t need to worry about scope conflicts at all.

What have we gained by making this change? Well, we’ve managed to make it so that we don’t have to write as much code – and, if the way we connect to our database ever needs to change, we’ll only need to modify one file, instead of every single file in our codebase. This is one of the big benefits of DRY, and if you ever get into a situation where you need to make a change like this, you’ll definitely appreciate it!

]]> http://buildingbrowsergames.com/2008/07/10/drying-out-our-database-connections-perl/feed/ 2 Building Browsergames: Retrieving Items (Perl) http://buildingbrowsergames.com/2008/07/04/retrieving-items-perl/ http://buildingbrowsergames.com/2008/07/04/retrieving-items-perl/#comments Fri, 04 Jul 2008 14:00:59 +0000 Luke http://buildingbrowsergames.com/?p=77 The other day, we set up the initial database structure for our items system – and today, we’re going to write the code we use to interact with that system and retrieve item data.

For the most part, you’ve seen all of this code before – it’s a slightly modified version of our stats code, along with one extra function. We don’t even have to include any functionality for setting up item information – because our players shouldn’t ever be able to(although if you want them to in your game, you should be able to figure out how to make the change after this). We’ll start off with our one new function, getItem, which will return a hash with the item’s attributes inside:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

package items;
use DBI;
 
sub getItem {
	my ($itemID) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT name, type FROM items WHERE id = ?");
	$sth->execute($itemID);
	my %item;
	$sth->bind_columns(\@item{qw(name type)});
	$sth->fetch;
	$item{id} = $itemID;
	return %item;
}
 
1;

This is just some simple database querying – the only thing that’s fancy is that we used our %item hash as an array slice so that we could bind keys directly to columns returned by our query. I find that it’s easier to deal with a hash of attributes than a bunch of variables, which is why it’s being done this way.

Unfortunately, we won’t be building anything that takes advantage of this code today – but we can at least build some testing code. To start off, run this SQL to insert a testing item into the database:

INSERT INTO items(name,type) VALUES ('Wooden Sword','Weapon');

Once that’s finished, create a file named test.cgi with this code inside:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

#!/usr/bin/perl -w
use strict;
use CGI qw(:cgi);
use items;
 
my $query = new CGI;
my %item = items::getItem(1);
 
print $query->header();
print qq ~
Name: $item{name}<br />
Type: $item{type}<br />
ID: $item{id}
~;

Once you’ve uploaded test.cgi to your server, visit that page – you should see all the information on the Wooden Sword, which means that our item retrieval code is working properly.

That’s really the only ’special’ part of our items code – the rest is just a customization of our stats code, so that we retrieve stats for items:

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

sub getStat {
	my ($statName,$itemID) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	createIfNotExists($statName,$itemID);
	my $sth = $dbh->prepare("SELECT value FROM item_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statName,$statName,$itemID);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}
sub setStat {
	my ($statName,$itemID,$statValue) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	createIfNotExists($statName,$itemID);
	my $sth = $dbh->prepare("UPDATE item_stats SET value = ? WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statValue,$statName,$statName,$itemID);
}
 
sub createIfNotExists {
	my ($statName, $itemID) = @_;	
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT count(value) FROM item_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statName,$statName,$itemID);
	my $count;
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 0) {
		# no entry for that stat/user combination - insert one with a value of 0
		$sth = $dbh->prepare("INSERT INTO item_stats(stat_id,item_id,value) VALUES ((SELECT id FROM stats WHERE display_name = ? OR short_name = ?),?,?)");
		$sth->execute($statName,$statName,$itemID,0);
	}	
}

If we want to test our stats code to make sure that it’s working, we’ll first need to add a stat to our wooden sword:

INSERT INTO item_stats(item_id,stat_id,value) VALUES ((SELECT id FROM items WHERE name = 'Wooden Sword'),(SELECT id FROM stats WHERE short_name = 'atk'),2);

Then, we’ll modify our testing page so that it retrieves the ‘atk’ stat for our sword:

8

$item{atk} = items::getStat('atk',1);
15
16

Attack: $item{atk}
~;

And with that, we’ve written the code to retrieve our item information! Once you run your test page, you’ll be able to see all of the information for the Wooden Sword. Here’s all the code inside items.pm in one place:

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

package items;
use DBI;
 
sub getItem {
	my ($itemID) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT name, type FROM items WHERE id = ?");
	$sth->execute($itemID);
	my %item;
	$sth->bind_columns(\@item{qw(name type)});
	$sth->fetch;
	$item{id} = $itemID;
	return %item;
}
 
sub getStat {
	my ($statName,$itemID) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	createIfNotExists($statName,$itemID);
	my $sth = $dbh->prepare("SELECT value FROM item_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statName,$statName,$itemID);
	my $value;
	$sth->bind_columns(\$value);
	$sth->fetch;
	return $value;
}
sub setStat {
	my ($statName,$itemID,$statValue) = @_;
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	createIfNotExists($statName,$itemID);
	my $sth = $dbh->prepare("UPDATE item_stats SET value = ? WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statValue,$statName,$statName,$itemID);
}
 
sub createIfNotExists {
	my ($statName, $itemID) = @_;	
	use config;
	my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
	my $sth = $dbh->prepare("SELECT count(value) FROM item_stats WHERE stat_id = (SELECT id FROM stats WHERE display_name = ? OR short_name = ?) AND item_id = ?");
	$sth->execute($statName,$statName,$itemID);
	my $count;
	$sth->bind_columns(\$count);
	$sth->fetch;
	if($count == 0) {
		# no entry for that stat/user combination - insert one with a value of 0
		$sth = $dbh->prepare("INSERT INTO item_stats(stat_id,item_id,value) VALUES ((SELECT id FROM stats WHERE display_name = ? OR short_name = ?),?,?)");
		$sth->execute($statName,$statName,$itemID,0);
	}	
}
 
1;

And here’s the tester page code, which lets us verify that our items code is working:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

#!/usr/bin/perl -w
use strict;
use CGI qw(:cgi);
use items;
 
my $query = new CGI;
my %item = items::getItem(1);
$item{atk} = items::getStat('atk',1);
 
print $query->header();
print qq ~
Name: $item{name}<br />
Type: $item{type}<br />
ID: $item{id}<br />
Attack: $item{atk}
~;
]]> http://buildingbrowsergames.com/2008/07/04/retrieving-items-perl/feed/ 0 Building Browsergames: forcing users to log in (Perl) http://buildingbrowsergames.com/2008/06/25/building-browsergames-forcing-users-to-log-in-perl/ http://buildingbrowsergames.com/2008/06/25/building-browsergames-forcing-users-to-log-in-perl/#comments Wed, 25 Jun 2008 14:00:51 +0000 Luke http://buildingbrowsergames.com/?p=72 While we’ve been working on building our browsergame, one thing that we haven’t really touched on is making sure that our users are logged in before they try to do anything. Most of the pages that we’ve built rely on the user being logged in so that we can retrieve their User ID and use it for whatever the page does – but none of them force the user to be logged in yet. Today, we’re going to add that piece of functionality to our game.

We already know how to figure out whether or not a user is logged in – all we do is use the values from their cookie, and compare them against the database to see if they match – if they do, we retrieve a User ID. We’ll know a user is logged in when we retrieve something, and we’ll know that they aren’t when we don’t get anything back.

If this sounds familiar, that’s because it is – here’s the code from our index page that does just that:

1
2
3
4
5
6
7
8
9
10
11
12

my $query = new CGI;
my $cookie = $query->cookie('username+password');
 
my ($username) = split(/\+/,$cookie);
use DBI;
use config;
my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
my $sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;

All we need to do is add a quick conditional check to our code to see what was returned, and modify our code slightly so that it’s re-usable in modular format:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

package login;
 
use CGI qw(:cgi);
use DBI;
use config;
 
my $query = new CGI;
my $cookie = $query->cookie('username+password');
 
my ($username) = split(/\+/,$cookie);
my $dbh = DBI->connect("DBI:mysql:$dbname:$dbhost",$dbuser,$dbpass,{RaiseError => 1});
my $sth = $dbh->prepare("SELECT id FROM users WHERE UPPER(username) = UPPER(?)");
$sth->execute($username);
my $userID;
$sth->bind_columns(\$userID);
$sth->fetch;
if(!$userID) {
	print $query->redirect('login.cgi');	
}
 
1;

If you save that code as login.pm, you’ll now be able add this line to any file that you want to force users to log in to view:

1

require login;

And if a user attempts to access the page without their cookie set properly, they’ll be automated redirected to the login page. Check out The index page to see it in action.

]]> http://buildingbrowsergames.com/2008/06/25/building-browsergames-forcing-users-to-log-in-perl/feed/ 0