47 lines
688 B
Perl
47 lines
688 B
Perl
#! /usr/bin/env perl
|
|
|
|
package Right;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
|
|
sub new ($$)
|
|
{
|
|
my $class = shift;
|
|
my $self = {
|
|
negate => 0,
|
|
};
|
|
|
|
bless $self, $class;
|
|
if ($self->parse(shift)) {
|
|
return $self;
|
|
}
|
|
else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
sub parse($$)
|
|
{
|
|
my $self = shift;
|
|
my $right = shift;
|
|
|
|
if ($right =~ /^(!)?(((([0-9]{4}):)?([^:]*):)?([^:]*):)?([a-zA-Z0-9_]+)(;(([^;]+);)?(.*))?/)
|
|
{
|
|
$self->{negate} = 1 if ($1);
|
|
$self->{year} = $5 if ($5);
|
|
$self->{module} = $6 if ($6);
|
|
$self->{project} = $7 if ($7);
|
|
$self->{right} = $8;
|
|
$self->{arg} = $11 if ($11);
|
|
$self->{comm} = $12 if ($12);
|
|
return 1;
|
|
}
|
|
else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
1;
|