Merge pull request #5 from voegelas/perl

Add Perl 5 implementation

perl/GildedRose.pm

@@ -0,0 +1,74 @@
+package GildedRose;
+
+use strict;
+use warnings;
+
+sub new {
+    my ( $class, %attrs ) = @_;
+    return bless \%attrs, $class;
+}
+
+sub update_quality {
+    my $self = shift;
+    for my $item ( @{ $self->{items} } ) {
+        if (   $item->{name} ne 'Aged Brie'
+            && $item->{name} ne 'Backstage passes to a TAFKAL80ETC concert' )
+        {
+            if ( $item->{quality} > 0 ) {
+                if ( $item->{name} ne 'Sulfuras, Hand of Ragnaros' ) {
+                    $item->{quality} = $item->{quality} - 1;
+                }
+            }
+        }
+        else {
+            if ( $item->{quality} < 50 ) {
+                $item->{quality} = $item->{quality} + 1;
+
+                if ( $item->{name} eq
+                    'Backstage passes to a TAFKAL80ETC concert' )
+                {
+                    if ( $item->{sell_in} < 11 ) {
+                        if ( $item->{quality} < 50 ) {
+                            $item->{quality} = $item->{quality} + 1;
+                        }
+                    }
+
+                    if ( $item->{sell_in} < 6 ) {
+                        if ( $item->{quality} < 50 ) {
+                            $item->{quality} = $item->{quality} + 1;
+                        }
+                    }
+                }
+            }
+        }
+
+        if ( $item->{name} ne 'Sulfuras, Hand of Ragnaros' ) {
+            $item->{sell_in} = $item->{sell_in} - 1;
+        }
+
+        if ( $item->{sell_in} < 0 ) {
+            if ( $item->{name} ne 'Aged Brie' ) {
+                if ( $item->{name} ne
+                    'Backstage passes to a TAFKAL80ETC concert' )
+                {
+                    if ( $item->{quality} > 0 ) {
+                        if ( $item->{name} ne 'Sulfuras, Hand of Ragnaros' ) {
+                            $item->{quality} = $item->{quality} - 1;
+                        }
+                    }
+                }
+                else {
+                    $item->{quality} = $item->{quality} - $item->{quality};
+                }
+            }
+            else {
+                if ( $item->{quality} < 50 ) {
+                    $item->{quality} = $item->{quality} + 1;
+                }
+            }
+        }
+    }
+    return;
+}
+
+1;

perl/Item.pm

@@ -0,0 +1,16 @@
+package Item;
+
+use strict;
+use warnings;
+
+sub new {
+    my ( $class, %attrs ) = @_;
+    return bless \%attrs, $class;
+}
+
+sub to_string {
+    my ($self) = @_;
+    return $self->{name} . ', ' . $self->{sell_in} . ', ' . $self->{quality};
+}
+
+1;

perl/test.pl

@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More 0.96;
+
+use_ok 'GildedRose';
+use_ok 'Item';
+
+subtest 'foo' => sub {
+    my $items = [ Item->new( name => 'foo', sell_in => 0, quality => 0 ) ];
+    my $app = GildedRose->new( items => $items );
+    $app->update_quality();
+    is( $app->{items}->[0]->{name}, 'fixme' );
+};
+
+done_testing();

perl/texttest_fixture.pl

@@ -0,0 +1,72 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use GildedRose;
+use Item;
+
+print 'OMGHAI!', "\n";
+my $items = [
+    Item->new(
+        name    => '+5 Dexterity Vest',
+        sell_in => 10,
+        quality => 20
+    ),
+    Item->new(
+        name    => 'Aged Brie',
+        sell_in => 2,
+        quality => 0
+    ),
+    Item->new(
+        name    => 'Elixir of the Mongoose',
+        sell_in => 5,
+        quality => 7
+    ),
+    Item->new(
+        name    => 'Sulfuras, Hand of Ragnaros',
+        sell_in => 0,
+        quality => 80
+    ),
+    Item->new(
+        name    => 'Sulfuras, Hand of Ragnaros',
+        sell_in => -1,
+        quality => 80
+    ),
+    Item->new(
+        name    => 'Backstage passes to a TAFKAL80ETC concert',
+        sell_in => 15,
+        quality => 20
+    ),
+    Item->new(
+        name    => 'Backstage passes to a TAFKAL80ETC concert',
+        sell_in => 10,
+        quality => 49
+    ),
+    Item->new(
+        name    => 'Backstage passes to a TAFKAL80ETC concert',
+        sell_in => 5,
+        quality => 49
+    ),
+    Item->new(    # This Conjured item does not work properly yet
+        name    => 'Conjured Mana Cake',
+        sell_in => 3,
+        quality => 6
+    ),
+];
+
+my $days = 2;
+if ( $#ARGV >= 0 ) {
+    $days = $ARGV[0];
+}
+
+my $gilded_rose = GildedRose->new( items => $items );
+for my $day ( 0 .. $days ) {
+    print "-------- day $day --------", "\n";
+    print 'name, sellIn, quality',      "\n";
+    for my $item ( @{$items} ) {
+        print $item->to_string(), "\n";
+    }
+    print "\n";
+    $gilded_rose->update_quality();
+}

texttests/config.gr

@@ -22,6 +22,10 @@ interpreter:java
 # Settings for the C# version
 #executable:${TEXTTEST_CHECKOUT}/GildedRose.exe
 
+# Settings for the Perl version
+#executable:${TEXTTEST_CHECKOUT}/perl/texttest_fixture.pl
+#interpreter:perl
+
 # turn on one of these if you prefer them to notepad or emacs.
 [view_program]
 *:mate

texttests/environment.gr

@@ -1,2 +1,3 @@
 # If your .class files are somewhere else, add the path to the list
 CLASSPATH:${TEXTTEST_CHECKOUT}/Java:${TEXTTEST_CHECKOUT}/Java/bin
+PERL5OPT:-I${TEXTTEST_CHECKOUT}/perl