File Coverage

blib/lib/Video/Event/Manual.pm

Criterion	Covered	Total	%
statement	6	34	17.6
branch	0	14	0.0
condition	0	6	0.0
subroutine	2	7	28.5
pod	0	5	0.0
total	8	66	12.1

package Video::Event::Manual;

use vars qw($VERSION @EXPORT);
$VERSION = 0.01;
@EXPORT = qw(new endtime tag gettag matches);

use base Video::Event;

sub new {
    my ($class, $time, $envelope, $probability, $type, $name) = @_;

=pod
don't confuse $probability with envelope for coolness function
$probability is the probability that the event actually happened,
independent of how interesting the event was.
=cut

    my $self = bless {}, ref($class) || $class;
    $self->{'time'} = $time;
    $self->{'envelope'} = $envelope;
    $self->{'probability'} = $probability;
    $self->{'type'} = $type if $type;
    $self->{'name'} = $name if $name;
    return $self;
}

sub endtime {
    my ($self, $eventtime, $coolness) = @_;
    my $totaltime = $eventtime - $self->{'time'};
    $self->{'endtime'} = $eventtime;
    $self->{'cool'} = $coolness;
    return $totaltime;
}

sub tag {
    my ($self, $tag) = @_;
    if ($self->gettag()) {
        $self->{'tag'} .= $tag;
    }
    else {
        $self->{'tag'} = $tag;
    }
    return 1;
}

sub matches {
    my ($self, $searchterm, $tags) = @_;
    if (ref $tags eq 'ARRAY' or $tags eq 'all') {
        foreach my $tag (@tags) {
            #hooray for perl 6
            return 1 if ($self->gettag() eq $tag);
        }
        return 0;
    }
    #if no tags specified, look in name
    else {
        return 1 if ($self->{'name'} =~ /$searchterm/);
        return 0;
    }
}

sub gettag {
    my ($self) = @_;
    return $self->{'tag'} if defined $self->{'tag'};
    return $self->{'name'};
}

1;