Perl Weekly Challenge 039

ch-1.pl

use strict;
use warnings;
##
# A guest house had a policy that the light remain ON as 
# long as the at least one guest is in the house. There 
# is guest book which tracks all guest in/out time. 
# Write a script to find out how long in minutes the light were ON.
##
use DateTime;
use DateTime::Duration;
my $lights_on = new DateTime::Duration(
                    hours   => 0, 
                    minutes => 0,
                    seconds => 0   
);
my $start_time;  

while(my $line = <DATA>){
    chomp($line);
    my @fields = split(/:/, $line);
    my($in_hour, $in_minute, $out_hour, $out_minute) = @fields[1, 2, 3, 4];  
    $in_hour =~ tr/ //d;
    $in_minute =~ tr/ OUT//d;
    $out_hour =~ tr/ //d;
    if(!$start_time){
        $start_time = DateTime -> now(); 
        $start_time->set_hour($in_hour);  
        $start_time->set_minute($in_minute);  
        $start_time->set_second(0);  
    } 
    
    my $in = DateTime -> now();  
    $in->set_hour($in_hour);  
    $in->set_minute($in_minute);  
    $in->set_second(0);  
    my $out = DateTime -> now();  
    $out->set_hour($out_hour);  
    $out->set_minute($out_minute);  
    $out->set_second(0);  
    if(DateTime->compare($start_time, $in) <= 0){
        $lights_on -> add_duration($out->subtract_datetime($in));
    } 
    if(DateTime->compare($start_time, $in) > 0 && 
           DateTime->compare($start_time, $out) < 0
        ){
        $lights_on -> add_duration($out->subtract_datetime($start_time));
    } 
    $start_time = $out if (DateTime->compare($start_time, $out) < 0); 
} 
print $lights_on->hours() . " hours "; 
print $lights_on->minutes() . " minutes\n"; 

__DATA__
1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00

ch-2.pl

use strict;
use warnings;
##
# Write a script to demonstrate Reverse Polish notation(RPN).     
##
use Rpn;
use constant RPN_ADD => "10 8 + \n";
use constant RPN_SUBTRACT => "18 66 - \n";
use constant RPN_MULTIPLY => "10 8 * \n";
use constant RPN_DIVIDE => "52 2 / \n";
use constant RPN => "2 2 + 3 3 + + 1 7 - + \n"; 

MAIN:{
    my $parser = new Rpn();
    $parser->parse(RPN_ADD); 
    $parser->parse(RPN_SUBTRACT); 
    $parser->parse(RPN_MULTIPLY); 
    $parser->parse(RPN_DIVIDE);
    $parser->parse(RPN);
}   

Rpn.yp

%token NUMBER   
%%

line: '\n' | rpn '\n' {print $_[1] . "\n"} 
;

rpn: NUMBER
   | rpn rpn '+' {$_[1] + $_[2]}
   | rpn rpn '-' {$_[1] - $_[2]}
   | rpn rpn '*' {$_[1] * $_[2]}
   | rpn rpn '/' {$_[1] / $_[2]}
;

%%

sub lexer{
    my($parser) = @_;
    $parser->YYData->{INPUT} or return('', undef);
    $parser->YYData->{INPUT} =~ s/^[ \t]//;
    ##
    # send tokens to parser
    ##
    for($parser->YYData->{INPUT}){
        s/^([0-9]+)// and return ("NUMBER", $1);
        s/^(\+)// and return ("+", $1);
        s/^(-)// and return ("-", $1);
        s/^(\*)// and return ("*", $1);
        s/^(\/)// and return ("/", $1);
        s/^(\n)// and return ("\n", $1);
    }  
}

sub error{
    exists $_[0]->YYData->{ERRMSG}
    and do{
        print $_[0]->YYData->{ERRMSG};
            return;
    };
    print "syntax error\n"; 
}

sub parse{
    my($self, $input) = @_;
    $self->YYData->{INPUT} = $input;
    my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
    return $result;  
}