diff --git a/day04.pl b/day04.pl
new file mode 100644
index 0000000..c2969cf
--- /dev/null
+++ b/day04.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+my @wordgrid = ();
+while (<>) {
+	next if /^\s*$/;
+	chomp;
+	push @wordgrid, [ split //, $_ ];
+}
+
+my @directions = (
+	[[0, 0], [1, 1], [2, 2], [3, 3]],
+	[[0, 0], [-1, 1], [-2, 2], [-3, 3]],
+	[[0, 0], [0, 1], [0, 2], [0, 3]],
+	[[0, 0], [1, 0], [2, 0], [3, 0]],
+	[[0, 0], [-1, -1], [-2, -2], [-3, -3]],
+	[[0, 0], [1, -1], [2, -2], [3, -3]],
+	[[0, 0], [-1, 0], [-2, 0], [-3, 0]],
+	[[0, 0], [0, -1], [0, -2], [0, -3]],
+);
+
+my @diagonal = ([-1, -1], [0, 0], [1, 1]);
+my @otherdiagonal = ([1, -1], [0, 0], [-1, 1]);
+
+my $xmas_count = 0;
+my $mas_cross_count = 0;
+for my $y (0 .. $#wordgrid) {
+	for my $x (0 .. $#{$wordgrid[$y]}) {
+		$xmas_count += grep { search_xmas([$x, $y], $_)} @directions;
+		$mas_cross_count++ if search_max_cross([ $x, $y ]);
+	}
+}
+
+print "Part 1: ", $xmas_count, "\n";
+print "Part 2: ", $mas_cross_count, "\n";
+
+sub search_xmas {
+	my ($start, $offsets) = @_;
+
+	my @letters = ("X", "M", "A", "S");
+	for my $i (0 .. $#letters) {
+		my $cord = [$start->[0] + $offsets->[$i]->[0], $start->[1] + $offsets->[$i]->[1]];
+		return 0 if (
+			$cord->[1] < 0 || $cord->[1] > $#wordgrid ||
+			$cord->[0] < 0 || $cord->[0] > $#{$wordgrid[$cord->[1]]}
+		);
+		return 0 if $wordgrid[$cord->[1]][$cord->[0]] ne $letters[$i];
+	}
+	return 1;
+}
+
+sub search_max_cross {
+	my $start = shift;
+	return 0 if $wordgrid[$start->[1]][$start->[0]] ne "A";
+	return 0 if (
+		!search_mas($start, \@diagonal) &&
+		!search_mas($start, [reverse @diagonal])
+	);
+	return 0 if (
+		!search_mas($start, \@otherdiagonal) &&
+		!search_mas($start, [reverse @otherdiagonal])
+	);
+	return 1;
+}
+
+sub search_mas {
+	my ($start, $offsets) = @_;
+
+	my @letters = ("M", "A", "S");
+	for my $i (0 .. $#letters) {
+		my $cord = [$start->[0] + $offsets->[$i]->[0], $start->[1] + $offsets->[$i]->[1]];
+		return 0 if (
+			$cord->[1] < 0 || $cord->[1] > $#wordgrid ||
+			$cord->[0] < 0 || $cord->[0] > $#{$wordgrid[$cord->[1]]}
+		);
+		return 0 if $wordgrid[$cord->[1]][$cord->[0]] ne $letters[$i];
+	}
+	return 1;
+}