1 files changed, 110 insertions, 0 deletions
diff --git a/lib/Youri/Check/Input/Age.pm b/lib/Youri/Check/Input/Age.pm
new file mode 100644
index 0000000..fda4222
--- /dev/null
+++ b/lib/Youri/Check/Input/Age.pm
@@ -0,0 +1,110 @@
+# $Id: Age.pm 1179 2006-08-05 08:30:57Z warly $
+package Youri::Check::Input::Age;
+
+=head1 NAME
+
+Youri::Check::Input::Age - Check maximum age
+
+=head1 DESCRIPTION
+
+This plugin checks packages age, and report the ones exceeding maximum limit.
+
+=cut
+
+use warnings;
+use strict;
+use Carp;
+use DateTime;
+use DateTime::Format::Duration;
+use base 'Youri::Check::Input';
+
+sub columns {
+    return qw/
+        arch
+        buildtime
+    /;
+}
+
+sub links {
+    return qw//;
+}
+
+=head2 new(%args)
+
+Creates and returns a new Youri::Check::Input::Age object.
+
+Specific parameters:
+
+=over
+
+=item max_age $age
+
+Maximum age allowed (default: 1 year)
+
+=item pattern $pattern
+
+Pattern used to describe age (default: %Y year)
+
+=back
+
+=cut
+
+sub _init {
+    my $self    = shift;
+    my %options = (
+        max_age => '1 year',
+        pattern => '%Y year',
+        @_
+    );
+
+    $self->{_format} = DateTime::Format::Duration->new(
+        pattern => $options{pattern}
+    );
+
+    $self->{_now} = DateTime->from_epoch(
+        epoch => time()
+    );
+
+    $self->{_max_age} = $options{max_age};
+}
+
+sub run {
+    my ($self, $media, $resultset) = @_;
+    croak "Not a class method" unless ref $self;
+
+    my $max_age_string = $media->max_age() ?
+        $media->max_age() :
+        $self->{_max_age};
+
+    my $max_age = $self->{_format}->parse_duration($max_age_string);
+
+    my $check = sub {
+        my ($package) = @_;
+
+        my $buildtime = DateTime->from_epoch(
+            epoch => $package->get_age()
+        );
+        
+        my $age = $self->{_now}->subtract_datetime($buildtime);
+
+        if (DateTime::Duration->compare($age, $max_age) > 0) {
+            my $date = $buildtime->strftime("%a %d %b %G");
+
+            $resultset->add_result($self->{_id}, $media, $package, {
+                arch      => $package->get_arch(),
+                buildtime => $date
+            });
+        }
+    };
+    $media->traverse_headers($check);
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2002-2006, YOURI project
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1;