[Mageia-sysadm] [210] add mandriva version of youri-core, downloaded from http://svn. mandriva.com/svn/soft/build_system/youri/core/trunk/ at revision 271600

Wed Jan 5 14:23:45 CET 2011

Revision: 210
+Author:   boklm
+Date:     2011-01-05 14:23:45 +0100 (Wed, 05 Jan 2011)
+Log Message:
+-----------
+add mandriva version of youri-core, downloaded from http://svn.mandriva.com/svn/soft/build_system/youri/core/trunk/ at revision 271600
+
+Added Paths:
+-----------
+    build_system/mdv-youri-core/
+    build_system/mdv-youri-core/branches/
+    build_system/mdv-youri-core/tags/
+    build_system/mdv-youri-core/trunk/
+    build_system/mdv-youri-core/trunk/ChangeLog
+    build_system/mdv-youri-core/trunk/MANIFEST.SKIP
+    build_system/mdv-youri-core/trunk/Makefile.PL
+    build_system/mdv-youri-core/trunk/README
+    build_system/mdv-youri-core/trunk/TODO
+    build_system/mdv-youri-core/trunk/bin/
+    build_system/mdv-youri-core/trunk/bin/fillbugzilla
+    build_system/mdv-youri-core/trunk/cgi/
+    build_system/mdv-youri-core/trunk/cgi/maintainers.cgi
+    build_system/mdv-youri-core/trunk/etc/
+    build_system/mdv-youri-core/trunk/etc/bash_completion.d/
+    build_system/mdv-youri-core/trunk/etc/bash_completion.d/youri
+    build_system/mdv-youri-core/trunk/etc/check.conf
+    build_system/mdv-youri-core/trunk/etc/upload.conf
+    build_system/mdv-youri-core/trunk/lib/
+    build_system/mdv-youri-core/trunk/lib/Youri/
+    build_system/mdv-youri-core/trunk/lib/Youri/Bugzilla.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Age.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/Iurt.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/LBD.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Conflicts.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Dependencies.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/MandrivaConflicts.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Missing.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Orphans.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Rpmlint.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Signature.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/CPAN.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Debian.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Fedora.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/GNOME.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Gentoo.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/NetBSD.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/RAA.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Input.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences/File.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/Bugzilla.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/CGI.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/HTML.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/RSS.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/Text.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/HTML.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/Text.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Output.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/DBI.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/Iterator.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Config.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Media/
+    build_system/mdv-youri-core/trunk/lib/Youri/Media/URPM.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Media.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Package/
+    build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM4.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Package/Test.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Package/URPM.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Package.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Repository/
+    build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload_pre.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Repository/PLF.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Repository.pm
+    build_system/mdv-youri-core/trunk/lib/Youri/Utils.pm
+    build_system/mdv-youri-core/trunk/t/
+    build_system/mdv-youri-core/trunk/t/00distribution.t
+    build_system/mdv-youri-core/trunk/t/cowsay-3.03-11mdv2007.0.noarch.rpm
+    build_system/mdv-youri-core/trunk/t/gpghome/
+    build_system/mdv-youri-core/trunk/t/gpghome/pubring.gpg
+    build_system/mdv-youri-core/trunk/t/gpghome/secring.gpg
+    build_system/mdv-youri-core/trunk/t/gpghome/trustdb.gpg
+    build_system/mdv-youri-core/trunk/t/package.t
+    build_system/mdv-youri-core/trunk/t/version.t
+
+Added: build_system/mdv-youri-core/trunk/ChangeLog
+===================================================================
+--- build_system/mdv-youri-core/trunk/ChangeLog	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/ChangeLog	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,2 @@
++2006-04-23 Guillaume Rousse <guillomovitch at zarb.org> 0.9
++	* initial release
+
+Added: build_system/mdv-youri-core/trunk/MANIFEST.SKIP
+===================================================================
+--- build_system/mdv-youri-core/trunk/MANIFEST.SKIP	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/MANIFEST.SKIP	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,14 @@
++CVS/.*
++\.svn/.*
++^cover_db/
++^blib/
++\.bak$
++\.swp$
++\.tar$
++\.tgz$
++\.tar\.gz$
++\.SKIP$
++~$
++^pm_to_blib$
++^Makefile$
++^Makefile\.old$
+
+Added: build_system/mdv-youri-core/trunk/Makefile.PL
+===================================================================
+--- build_system/mdv-youri-core/trunk/Makefile.PL	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/Makefile.PL	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,31 @@
++# $Id: Makefile.PL 1724 2006-10-17 13:55:27Z warly $
++use ExtUtils::MakeMaker;
++
++WriteMakefile(
++    NAME       => 'youri-core',
++    VERSION    => 0.9,
++    AUTHOR     => 'Youri project <youri at zarb.org>',
++    PREREQ_PM  => {
++        'AppConfig'              => 0,
++        'YAML'                   => 0,
++        'Pod::Simple::HTMLBatch' => 0,
++        'Test::Exception'        => 0,
++        'Exception'              => 0,
++        'RPM4'                   => 0,
++        'URPM'                   => 0
++    }
++);
++
++package MY;
++
++sub top_targets {
++    my ($self) = @_;
++    my $top_targets = $self->SUPER::top_targets(@_);
++    $top_targets =~ s/all :: pure_all manifypods/all :: pure_all manifypods htmlifypods/;
++    $top_targets .= <<'EOF';
++htmlifypods : $(TO_INST_PM)
++	if [ ! -d blib/html ]; then mkdir blib/html; fi
++	perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go lib blib/html
++EOF
++     return $top_targets;
++}
+
+Added: build_system/mdv-youri-core/trunk/README
+===================================================================
+--- build_system/mdv-youri-core/trunk/README	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/README	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,33 @@
++youri-core
++----------
++
++Youri core libraries.
++
++Description
++-----------
++YOURI stands for "Youri Offers an Upload & Repository Infrastucture". It aims
++to build tools making management of a coherent set of packages easier.
++
++This package provides basic components used by other youri programs.
++
++Installation
++------------
++To install, just use:
++perl Makefile.PL
++make
++make test
++
++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.
++
++Authors
++-------
++Guillaume Rousse <guillomovitch at zarb.org>,
++Pascal Terjan <pterjan at zarb.org>
++Damien Krotkine <dams at zarb.org>
++Olivier Thauvin <nanardon at zarb.org>
++Ville Skytt\xE4 <ville.skytta at iki.fi>
+
+Added: build_system/mdv-youri-core/trunk/TODO
+===================================================================
+--- build_system/mdv-youri-core/trunk/TODO	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/TODO	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,7 @@
++1.0 Goals 
++=========
++
++library:
++- API-based bugzilla interface, instead of SQL-based one
++- more generic check-specific options handling in medias (don't use a
++specific attribute for each of them)
+
+Added: build_system/mdv-youri-core/trunk/bin/fillbugzilla
+===================================================================
+--- build_system/mdv-youri-core/trunk/bin/fillbugzilla	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/bin/fillbugzilla	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,81 @@
++#!/usr/bin/perl
++# fillbugzilla
++# copyright (c) 2002 Guillaume Rousse <guillomovitch at zarb.org>
++# $Id: fillbugzilla 1179 2006-08-05 08:30:57Z warly $
++
++use strict;
++use warnings;
++use Getopt::Long;
++use Bugzilla;
++use Mail::Sendmail;
++
++# constants
++my $name    = "fillbugzilla";
++my $version = "1.0";
++
++# command-line parameters
++my ($base, $user, $pass, $project, $mode, $help);
++GetOptions(
++    "base=s"    => \$base,
++    "user=s"    => \$user,
++    "pass=s"    => \$pass,
++    "mode=s"    => \$mode,
++    "help"      => \$help,
++);
++
++# mandatory argument
++die usage() unless ($base && $user && $pass);
++die usage() unless ($mode eq 'package' || $mode eq 'packager');
++
++usage() && exit 0 if $help;
++
++my $bugzilla = Bugzilla->new('localhost', $base, $user, $pass);
++
++if ($mode eq 'packager') {
++    while (my $packager = <>) {
++            chomp $packager;
++        my ($name, $login) = split(/\t/, $packager);
++
++        # random passwd
++        my @chars = (0..9, 'A'..'Z', 'a'..'z', '-', '_', '!', '@', '#', '$', '%', '^', '&', '*');
++        my $password = join('', map { $chars[rand(scalar @chars)] } 1 .. 8);
++
++        # insert into database
++        $bugzilla->add_packager($name, $login, $password);
++
++        # mail user
++        my %mail = (
++            smtp       => 'localhost',
++            To         => $login,
++            From       => 'bugmaster at zarb.org',
++            Subject    => 'bugzilla password',
++            'X-Mailer' => "$name $version",
++        );
++        $mail{Message} .= "login: $login\n";
++        $mail{Message} .= "password: $password\n";
++        sendmail(%mail) or warn $Mail::Sendmail::error;
++    }
++}
++
++if ($mode eq 'package') {
++    while (my $line = <>) {
++        chomp $line;
++        my ($name, $summary, $version, $maintainer) = split(/\t/, $line);
++        $bugzilla->add_package($name, $summary, $version, $maintainer);
++    }
++}
++
++sub usage {
++    print <<EOF;
++$name $version
++
++Usage:
++$name --base <base> --user <user> --pass <pass> --mode <mode> < $file
++
++Options:
++--base <base> bugzilla base name
++--user <user> bugzilla base user
++--pass <pass> bugzilla base password
++--mode <mode> package or packager
++EOF
++}
+
+
+Property changes on: build_system/mdv-youri-core/trunk/bin/fillbugzilla
+___________________________________________________________________
+Added: svn:executable
+   + *
+
+Added: build_system/mdv-youri-core/trunk/cgi/maintainers.cgi
+===================================================================
+--- build_system/mdv-youri-core/trunk/cgi/maintainers.cgi	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/cgi/maintainers.cgi	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,65 @@
++#!/usr/bin/perl
++# $Id: maintainers.cgi 1179 2006-08-05 08:30:57Z warly $
++
++=head1 NAME
++
++maintainers.cgi - youri CGI interface to maintainers list
++
++=head1 VERSION
++
++Version 1.0
++
++=head1 DESCRIPTION
++
++This script allows to get package maintainers list through CGI interface.
++
++=head1 SYNOPSIS
++
++=head1 COPYRIGHT AND LICENSE
++
++Copyright (C) 2004-2005, YOURI project
++
++This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
++
++=head1 AUTHORS
++
++Guillaume Rousse <guillomovitch at zarb.org>,
++
++=cut
++
++use Youri::Bugzilla;
++use CGI;
++use AppConfig qw/:argcount :expand/;
++use strict;
++use warnings;
++
++my $config = AppConfig->new(
++    {
++        GLOBAL => {
++           DEFAULT  => undef,
++           EXPAND   => EXPAND_ALL,
++           ARGCOUNT => ARGCOUNT_ONE,
++       }
++    },
++    host => { ARGCOUNT => ARGCOUNT_ONE },
++    base => { ARGCOUNT => ARGCOUNT_ONE },
++    user => { ARGCOUNT => ARGCOUNT_ONE },
++    pass => { ARGCOUNT => ARGCOUNT_ONE },
++);
++
++my $home = (getpwnam($ENV{PROJECT}))[7];
++foreach my $file ("/etc/youri/maintainers.conf", "$home/.youri/maintainers.conf") {
++    $config->file($file) if -f $file && -r $file;
++}
++
++my $bugzilla = Bugzilla->new(
++    $config->host(),
++    $config->base(),
++    $config->user(),
++    $config->pass(),
++);
++
++my $cgi = CGI->new();
++print $cgi->header(-type=>'text/plain');
++
++$bugzilla->browse_packages(sub { print "$_[0]\t$_[2]\n"; });
+
+
+Property changes on: build_system/mdv-youri-core/trunk/cgi/maintainers.cgi
+___________________________________________________________________
+Added: svn:executable
+   + *
+
+Added: build_system/mdv-youri-core/trunk/etc/bash_completion.d/youri
+===================================================================
+--- build_system/mdv-youri-core/trunk/etc/bash_completion.d/youri	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/etc/bash_completion.d/youri	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,141 @@
++# youri tools completion
++# $Id$
++
++_youri-check()
++{
++
++    local cur prev config i mode
++
++    COMPREPLY=()
++    cur=${COMP_WORDS[COMP_CWORD]}
++    prev=${COMP_WORDS[COMP_CWORD-1]}
++
++    case "$prev" in
++	--config)
++	    _filedir
++	    return 0
++	    ;;
++	--skip-plugin)
++	    _find_config check.conf
++	    if [ -n "$config" ]; then
++		# try to guess mode
++		for (( i=1; i < COMP_CWORD; i++ )); do
++		    if [[ "${COMP_WORDS[i]}" != -* ]]; then
++			mode=${COMP_WORDS[i]}
++			break
++		    fi
++		done
++
++		if [ -n $mode ]; then
++		    COMPREPLY=( $( awk -F=  '/^'$mode's/ {print $2}' $config \
++			    | grep "^$cur" ) )
++		fi
++	    fi
++	    return 0
++	    ;;
++	--skip-media)
++	    _find_config check.conf
++	    if [ -n "$config" ]; then
++		COMPREPLY=( $( awk -F=  '/^medias/ {print $2}' $config \
++			| grep "^$cur" ) )
++	    fi
++	    return 0
++	    ;;
++    esac
++
++    if [[ "$cur" == -* ]]; then
++	COMPREPLY=( $( compgen -W '--config --skip-plugin --skip-media -h \
++		--help -t --test -v --verbose' -- $cur ) )
++    else
++    	_count_args
++	case $args in
++	    1)
++	    	COMPREPLY=( $( compgen -W 'input output' -- $cur ) )
++		;;
++	esac
++    fi
++
++}
++complete -F _youri-check youri-check
++
++_youri-upload()
++{
++
++    local cur prev config
++
++    COMPREPLY=()
++    cur=${COMP_WORDS[COMP_CWORD]}
++    prev=${COMP_WORDS[COMP_CWORD-1]}
++
++    case "$prev" in
++	--config)
++	    _filedir
++	    return 0
++	    ;;
++	--skip-check)
++	    _find_config upload.conf
++	    if [ -n "$config" ]; then
++		COMPREPLY=( $( awk -F=  '/^checks/ {print $2}' $config \
++		    | grep "^$cur" ) )
++	    fi
++	    return 0
++	    ;;
++	--skip-action)
++	    _find_config upload.conf
++	    if [ -n "$config" ]; then
++		COMPREPLY=( $( awk -F=  '/^actions/ {print $2}' $config \
++		    | grep "^$cur" ) )
++	    fi
++	    return 0
++	    ;;
++    esac
++
++    if [[ "$cur" == -* ]]; then
++	COMPREPLY=( $( compgen -W '--config --skip-check --skip-action \
++	    --define -h --help -t --test -v --verbose' -- $cur ) )
++    else
++    	_count_args
++	case $args in
++	    1)
++		_find_config upload.conf
++		if [ -n "$config" ]; then
++		    COMPREPLY=( $( awk -F=  '/^targets/ {print $2}' $config \
++			| grep "^$cur" ) )
++		fi
++		;;
++	    *)
++		_filedir
++		;;
++	esac
++    fi
++
++}
++complete -F _youri-upload youri-upload
++
++_find_config()
++{
++    local name i
++
++    name=$1
++
++    for (( i=1; i < COMP_CWORD; i++ )); do
++	if [[ "${COMP_WORDS[i]}" == --config ]]; then
++	    config=${COMP_WORDS[i+1]}
++	    break
++	fi
++    done
++    if [ -f "$config" ]; then
++	return 0
++    fi
++
++    if [ -f "$HOME/.youri/$name" ]; then
++	config=$HOME/.youri/$name
++	return 0
++    fi
++
++    if [ -f "/etc/youri/$name" ]; then
++	config=/etc/youri/$name
++	return 0
++    fi
++
++}
+
+Added: build_system/mdv-youri-core/trunk/etc/check.conf
+===================================================================
+--- build_system/mdv-youri-core/trunk/etc/check.conf	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/etc/check.conf	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,300 @@
++# youri-check sample configuration file
++# $Id: check.conf 1179 2006-08-05 08:30:57Z warly $
++
++# resolver declaration
++resolver = cgi
++
++# preferences declaration
++preferences = file_pref
++
++# resultset declaration
++resultset = dbi
++
++# input plugins declaration
++inputs = rpmlint \
++         age \
++         updates \
++         build \
++         conflicts \
++         dependencies \
++         missing \
++         orphans
++
++# output plugins declaration
++outputs = file mail
++
++# medias declaration
++medias = main.i586 \
++	 main.x86_64 \
++	 main.sources \
++	 contrib.i586 \
++	 contrib.x86_64 \
++	 contrib.sources \
++	 free \
++	 non-free \
++	 free.sources \
++	 non-free.sources
++
++# helper variables
++mirror        = ftp://ftp.free.fr/pub/Distributions_Linux/Mandrakelinux/devel/cooker
++mirror_i586   = $mirror/i586/media
++mirror_x86_64 = $mirror/x86_64/media
++
++# resolver definition
++[cgi]
++class = Youri::Check::Maintainer::Resolver::CGI
++url   = http://plf.zarb.org/cgi-bin/maintainers.cgi
++
++# preferences definition
++[file_pref]
++class = Youri::Check::Maintainer::Preferences::File
++
++# resultset definition
++[dbi]
++class  = Youri::Check::Resultset::DBI
++driver = mysql
++host   = localhost
++base   = plf_youri
++user   = plf
++pass   = s3kr3t
++
++# checks definitions
++[updates]
++class    = Youri::Check::Input::Updates
++aliases  = <<EOF
++--- #YAML:1.0
++libfame0.8: ~
++EOF
++sources = <<EOF
++--- #YAML:1.0
++debian:
++    class: Youri::Check::Input::Updates::Source::Debian
++    aliases:
++        fuse-emulator: ~
++cpan:
++    class: Youri::Check::Input::Updates::Source::CPAN
++fedora:
++    class: Youri::Check::Input::Updates::Source::Fedora
++gentoo:
++    class: Youri::Check::Input::Updates::Source::Gentoo
++freshmeat:
++    class: Youri::Check::Input::Updates::Source::Freshmeat
++netbsd:
++    class: Youri::Check::Input::Updates::Source::NetBSD
++raa:
++    class: Youri::Check::Input::Updates::Source::RAA
++sourceforge:
++    class: Youri::Check::Input::Updates::Source::Sourceforge
++    aliases:
++        openquicktime: ~
++        klibido: ~
++EOF
++
++[rpmlint]
++class  = Youri::Check::Input::Rpmlint
++
++[age]
++class   = Youri::Check::Input::Age
++max_age = 12 months
++pattern = %m months
++
++[dependencies]
++class = Youri::Check::Input::Dependencies
++
++[conflicts]
++class = Youri::Check::Input::Conflicts
++
++[build]
++class    = Youri::Check::Input::Build
++sources = <<EOF
++--- #YAML:1.0
++stefan:
++    class: Youri::Check::Input::Build::Source::LBD
++    url: http://eijk.homelinux.org/build/
++    medias:
++        - cooker_plf-free
++        - cooker_plf-non-free
++    archs:
++        - i586
++EOF
++
++[missing]
++class    = Youri::Check::Input::Missing
++
++[orphans]
++class    = Youri::Check::Input::Orphans
++
++# reports definitions
++[file]
++class      = Youri::Check::Output::File
++to         = ${HOME}/www/qa
++global     = 1
++individual = 1
++formats    = <<EOF
++--- #YAML:1.0
++html:
++    class: Youri::Check::Output::File::Format::HTML
++text:
++    class: Youri::Check::Output::File::Format::Text
++rss:
++    class: Youri::Check::Output::File::Format::RSS
++EOF
++
++[mail]
++class      = Youri::Check::Output::Mail
++mta        = /usr/sbin/sendmail
++to         = plf-admin at zarb.org
++from       = plf at zarb.org
++reply_to   = plf-admin at zarb.org
++formats    = <<EOF
++--- #YAML:1.0
++text:
++    class: Youri::Check::Output::Mail::Format::Text
++EOF
++
++# media definitions
++[main.i586]
++class       = Youri::Media::URPM
++name        = main
++type        = binary
++path        = $mirror_i586/main
++hdlist      = $mirror_i586/media_info/hdlist_main.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[main.x86_64]
++class       = Youri::Media::URPM
++name        = main
++type        = binary
++path        = $mirror_x86_64/main
++hdlist      = $mirror_x86_64/media_info/hdlist_main.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[main.sources]
++class       = Youri::Media::URPM
++name        = main
++type        = source
++path        = $mirror_i586/main
++hdlist      = $mirror_i586/media_info/hdlist_main.src.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[contrib.i586]
++class       = Youri::Media::URPM
++name        = contrib
++type        = binary
++path        = $mirror_i586/contrib
++hdlist      = $mirror_i586/media_info/hdlist_contrib.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[contrib.x86_64]
++class       = Youri::Media::URPM
++name        = contrib
++type        = binary
++path        = $mirror_x86_64/contrib
++hdlist      = $mirror_x86_64/media_info/hdlist_contrib.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[contrib.sources]
++class       = Youri::Media::URPM
++name        = contrib
++type        = source
++path        = $mirror_i586/contrib
++hdlist      = $mirror_i586/media_info/hdlist_contrib.src.cz
++skip_inputs = <<EOF
++--- #YAML:1.0
++- all
++EOF
++
++[free]
++class          = Youri::Media::URPM
++name           = free
++type           = binary
++path           = ${HOME}/ftp/mandrake/free/cooker/i586
++hdlist         = ${HOME}/ftp/mandrake/free/cooker/i586/hdlist.cz
++rpmlint_config = ${HOME}/etc/rpmlint-free.conf
++allow_deps     = <<EOF
++--- #YAML:1.0
++- main.i586
++- main.x86_64
++- contrib.i586
++- contrib.x86_64
++- free
++EOF
++allow_srcs      = <<EOF
++--- #YAML:1.0
++- free.sources
++- main.sources
++- contrib.sources
++EOF
++skip_archs     = <<EOF
++--- #YAML:1.0
++- ppc
++EOF
++
++[free.sources]
++class          = Youri::Media::URPM
++name           = free
++type           = source
++path           = ${HOME}/ftp/mandrake/free/src
++hdlist         = ${HOME}/ftp/mandrake/free/src/hdlist.cz
++rpmlint_config = ${HOME}/etc/rpmlint-free.conf
++allow_deps     = <<EOF
++--- #YAML:1.0
++- main.i586
++- contrib.i586
++- free
++EOF
++
++[non-free]
++class          = Youri::Media::URPM
++name           = non-free
++type           = binary
++path           = ${HOME}/ftp/mandrake/non-free/cooker/i586
++hdlist         = ${HOME}/ftp/mandrake/non-free/cooker/i586/hdlist.cz
++rpmlint_config = ${HOME}/etc/rpmlint-non-free.conf
++allow_deps     = <<EOF
++--- #YAML:1.0
++- main.i586
++- main.x86_64
++- contrib.i586
++- contrib.x86_64
++- free
++- non-free
++EOF
++allow_srcs      = <<EOF
++--- #YAML:1.0
++- non-free.sources
++EOF
++skip_archs     = <<EOF
++--- #YAML:1.0
++- ppc
++EOF
++
++[non-free.sources]
++class          = Youri::Media::URPM
++name           = non-free
++type           = source
++path           = ${HOME}/ftp/mandrake/non-free/src
++hdlist         = ${HOME}/ftp/mandrake/non-free/src/hdlist.cz
++rpmlint_config = ${HOME}/etc/rpmlint-non-free.conf
++allow_deps     = <<EOF
++--- #YAML:1.0
++- main.i586
++- contrib.i586
++- free
++- non-free
++EOF
+
+Added: build_system/mdv-youri-core/trunk/etc/upload.conf
+===================================================================
+--- build_system/mdv-youri-core/trunk/etc/upload.conf	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/etc/upload.conf	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,139 @@
++# youri-upload sample configuration file
++# $Id: upload.conf 1179 2006-08-05 08:30:57Z warly $
++
++# repository declaration
++repository = plf
++
++# targets declaration
++targets = cooker 2006.0
++
++# repository definition
++[plf]
++class        = Youri::Repository::PLF
++install_root = ${HOME}/ftp/mandriva
++version_root = ${HOME}/cvs
++archive_root = ${HOME}/backup/mandriva
++noarch       = i586
++
++# targets definition
++[cooker]
++checks = <<EOF
++--- #YAML:1.0
++- tag
++- recency
++- history
++EOF
++actions = <<EOF
++--- #YAML:1.0
++- sign
++- install
++- link
++- archive
++- clean
++- bugzilla
++- cvs
++- mail
++- rss
++EOF
++
++[2006.0]
++checks = <<EOF
++--- #YAML:1.0
++- type
++- tag
++- recency
++- history
++- precedence
++EOF
++actions = <<EOF
++--- #YAML:1.0
++- sign
++- install
++- link
++- archive
++- clean
++EOF
++
++# checks definition
++[tag]
++class        = Youri::Upload::Check::Tag
++tags = <<EOF
++--- #YAML:1.0
++release: 'plf$'
++packager: '<\w+ at zarb\.org>$'
++distribution: '^Mandriva Linux$'
++vendor: '^Penguin Liberation Front$'
++EOF
++
++[recency]
++class = Youri::Upload::Check::Recency
++
++[history]
++class = Youri::Upload::Check::History
++
++[precedence]
++class  = Youri::Upload::Check::Precedence
++target = cooker
++
++[type]
++class = Youri::Upload::Check::Type
++type  = binary
++
++# actions definitions
++[sign]
++class      = Youri::Upload::Action::Sign
++name       = plf at zarb.org
++path       = ${HOME}/.gnupg
++passphrase = s3kr3t
++
++[install]
++class = Youri::Upload::Action::Install
++
++[link]
++class = Youri::Upload::Action::Link
++
++[archive]
++class = Youri::Upload::Action::Archive
++
++[clean]
++class = Youri::Upload::Action::Clean
++
++[mail]
++class    = Youri::Upload::Action::Mail
++mta      = /usr/sbin/sendmail
++to       = plf-announce at zarb.org
++reply_to = plf-discuss at zarb.org
++from     = plf at zarb.org
++prefix   = RPM
++cc       = <<EOF
++--- #YAML:1.0
++hot-base: david at dindinx.org bellamy at neverland.net
++dcgui: mathen at ketelhot.de
++dclib: mathen at ketelhot.de
++Video-DVDRip: dvdrip-users at exit1.org
++hackVideo-DVDRip: dvdrip-users at exit1.org
++goosnes: tak at bard.sytes.net
++avidemux: fixounet at free.fr
++vobcopy: robos at muon.de
++drip: drip-devel at lists.sourceforge.net
++libdscaler: vektor at dumbterm.net
++xawdecode: pingus77 at ifrance.com
++EOF
++
++[rss]
++class       = Youri::Upload::Action::RSS
++file        = ${HOME}/www/changelog.rss
++title       = PLF packages updates
++link        = http://plf.zarb.org/
++description = ChangeLog for PLF packages
++
++[cvs]
++class = Youri::Upload::Action::CVS
++
++[bugzilla]
++class   = Youri::Upload::Action::Bugzilla
++host    = localhost
++base    = plf_bugs
++user    = plf
++pass    = s3kr3t
++contact = plf at zarb.org
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Bugzilla.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Bugzilla.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Bugzilla.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,482 @@
++# $Id: Bugzilla.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Bugzilla;
++
++=head1 NAME
++
++Youri::Bugzilla - Youri Bugzilla interface
++
++=head1 SYNOPSIS
++
++    use Youri::Bugzilla;
++
++    my $bugzilla = Youri::Bugzilla->new($host, $base, $user, $pass);
++
++    print $bugzilla->get_maintainer('foobar');
++
++=head1 DESCRIPTION
++
++This module implement a database-level Bugzilla interface for managing packages.
++
++The legacy Bugzilla database model is mapped this way:
++
++=over
++
++=item *
++
++a maintainer is a user
++
++=item *
++
++a package is a product
++
++=item *
++
++each package has two pseudo components "program" and "package", owned by the package maintainer
++
++=back
++
++=cut
++
++use DBI;
++use Carp;
++use strict;
++use warnings;
++
++my %queries = (
++    get_package_id    => 'SELECT id FROM products WHERE name = ?',
++    get_maintainer_id => 'SELECT userid FROM profiles WHERE login_name = ?',
++    get_versions      => 'SELECT value FROM versions WHERE product_id = ?',
++    get_components    => 'SELECT name FROM components WHERE product_id = ?',
++    add_package       => 'INSERT INTO products (name, description) VALUES (?, ?)',
++    add_maintainer    => 'INSERT INTO profiles (login_name, cryptpassword, realname, emailflags, refreshed_when) VALUES (?, ENCRYPT(?), ?, ?, SYSDATE())',
++    add_component     => 'INSERT INTO components (product_id, name, description,initialowner, initialqacontact) VALUES (?, ?, ?, ?, ?)',
++    add_version       => 'INSERT INTO versions (product_id, value) VALUES (?, ?)',
++    del_package       => 'DELETE FROM products WHERE product = ?',
++    del_maintainer    => 'DELETE FROM profiles WHERE login_name = ?',
++    del_components    => 'DELETE FROM components WHERE program = ?',
++    del_versions      => 'DELETE FROM versions WHERE program = ?',
++    reset_password    => 'UPDATE profiles SET cryptpassword = ENCRYPT(?) WHERE login_name = ?',
++    browse_packages => <<EOF,
++SELECT products.name, max(versions.value), login_name
++FROM products, versions, profiles, components
++WHERE versions.product_id = products.id
++    AND components.product_id = products.id
++    AND profiles.userid = components.initialowner
++    AND components.name = 'package'
++GROUP BY name
++EOF
++    get_maintainer => <<EOF
++SELECT login_name
++FROM profiles, components, products
++WHERE profiles.userid = components.initialowner
++    AND components.name = 'package' 
++    AND components.product_id = products.id
++    AND products.name = ?
++EOF
++);
++
++my @default_flags = qw/
++    ExcludeSelf
++    FlagRequestee
++    FlagRequester
++    emailOwnerRemoveme
++    emailOwnerComments
++    emailOwnerAttachments
++    emailOwnerStatus
++    emailOwnerResolved
++    emailOwnerKeywords
++    emailOwnerCC
++    emailOwnerOther
++    emailOwnerUnconfirmed
++    emailReporterRemoveme
++    emailReporterComments
++    emailReporterAttachments
++    emailReporterStatus
++    emailReporterResolved
++    emailReporterKeywords
++    emailReporterCC
++    emailReporterOther
++    emailReporterUnconfirmed
++    emailQAcontactRemoveme
++    emailQAcontactComments
++    emailQAcontactAttachments
++    emailQAcontactStatus
++    emailQAcontactResolved
++    emailQAcontactKeywords
++    emailQAcontactCC
++    emailQAcontactOther
++    emailQAcontactUnconfirmed
++    emailCClistRemoveme
++    emailCClistComments
++    emailCClistAttachments
++    emailCClistStatus
++    emailCClistResolved
++    emailCClistKeywords
++    emailCClistCC
++    emailCClistOther
++    emailCClistUnconfirmed
++    emailVoterRemoveme
++    emailVoterComments
++    emailVoterAttachments
++    emailVoterStatus
++    emailVoterResolved
++    emailVoterKeywords
++    emailVoterCC
++    emailVoterOther
++    emailVoterUnconfirmed
++/;
++
++my $default_flags = join('~', map { "$_~on" }  @default_flags);
++
++=head1 CLASS METHODS
++
++Except stated otherwise, maintainers are specified by their login, and packages
++are specified by their name.
++
++=head2 new($host, $base, $user, $password)
++
++Creates a new L<Youri::Bugzilla> object, wrapping bugzilla database I<$base>
++hosted on I<$host>, and accessed by user I<$user> with password I<$password>.
++
++=cut
++
++sub new {
++    my ($class, $host, $base, $user, $pass) = @_;
++
++    my $dbh = DBI->connect("DBI:mysql:database=$base;host=$host", $user, $pass) or croak "Unable to connect: $DBI::errstr";
++
++    my $self = bless {
++        _dbh => $dbh
++    }, $class;
++
++    return $self;
++}
++
++=head1 INSTANCE METHODS
++
++=head2 has_package($package)
++
++Return true if bugzilla contains given package.
++
++=cut
++
++sub has_package {
++    my ($self, $package) = @_;
++    return $self->_get_package_id($package);
++}
++
++=head2 has_maintainer($maintainer)
++
++Return true if bugzilla contains given maintainer.
++
++=cut
++
++sub has_maintainer {
++    my ($self, $maintainer) = @_;
++    return $self->_get_maintainer_id($maintainer);
++}
++
++=head2 get_maintainer($package)
++
++Return maintainer of given package.
++
++=cut
++
++sub get_maintainer {
++    my ($self, $package) = @_;
++    return $self->_get_single('get_maintainer', $package);
++}
++
++=head2 get_versions($package)
++
++Return versions from given package.
++
++=cut
++
++sub get_versions {
++    my ($self, $package) = @_;
++    return $self->_get_multiple(
++        'get_versions',
++        $self->_get_package_id($package)
++    );
++}
++
++=head2 get_components($package)
++
++Return components from given package.
++
++=cut
++
++sub get_components {
++    my ($self, $package) = @_;
++    return $self->_get_multiple(
++        'get_components',
++        $self->_get_package_id($package)
++    );
++}
++
++=head2 get_packages()
++
++Return all packages from the database.
++
++=cut
++
++sub get_packages {
++    my ($self) = @_;
++    return $self->_get_multiple('get_packages');
++}
++
++sub _get_package_id {
++    my ($self, $package) = @_;
++    return $self->_get_single('get_package_id', $package);
++}
++
++sub _get_maintainer_id {
++    my ($self, $maintainer) = @_;
++    return $self->_get_single('get_maintainer_id', $maintainer);
++}
++
++sub _get_single {
++    my ($self, $type, $value) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{$type};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{$type});
++        $self->{_queries}->{$type} = $query;
++    }
++
++    $query->execute($value);
++
++    my @row = $query->fetchrow_array();
++    return @row ? $row[0]: undef;
++}
++
++sub _get_multiple {
++    my ($self, $type, $value) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{$type};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{$type});
++        $self->{_queries}->{$type} = $query;
++    }
++
++    $query->execute($value);
++
++    my @results;
++    while (my @row = $query->fetchrow_array()) {
++        push @results, $row[0];
++    }
++    return @results;
++}
++
++=head2 add_package($name, $summary, $version, $maintainer, $contact)
++
++Adds a new package in the database, with given name, summary, version,
++maintainer and initial QA contact.
++
++=cut
++
++sub add_package {
++    my ($self, $name, $summary, $version, $maintainer, $contact) = @_;
++    return unless ref $self;
++
++    my $maintainer_id  = $self->_get_maintainer_id($maintainer);
++    unless ($maintainer_id) {
++        carp "Unknown maintainer $maintainer, aborting";
++        return;
++    }
++
++    my $contact_id  = $self->_get_maintainer_id($contact);
++    unless ($contact_id) {
++        carp "Unknown QA contact $contact, aborting";
++        return;
++    }
++
++    my $query = $self->{_queries}->{add_package};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{add_package});
++        $self->{_queries}->{add_package} = $query;
++    }
++
++    $query->execute($name, $summary);
++
++    my $package_id  = $self->_get_package_id($name);
++
++    $self->_add_version($package_id, $version);
++    $self->_add_component(
++        $package_id,
++        'package',
++        'problem related to the package',
++        $maintainer_id,
++        $contact_id
++    );
++    $self->_add_component(
++        $package_id,
++        'program',
++        'problem related to the program',
++        $maintainer_id,
++        $contact_id
++    );
++}
++
++=head2 add_version($package, $version)
++
++Adds a new version to given package.
++
++=cut
++
++sub add_version {
++    my ($self, $package, $version) = @_;
++    return unless ref $self;
++
++    my $package_id  = $self->_get_package_id($package);
++    $self->_add_version($package_id, $version);
++}
++
++sub _add_version {
++    my ($self, $package_id, $version) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{add_version};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{add_version});
++        $self->{_queries}->{add_version} = $query;
++    }
++
++    $query->execute($package_id, $version);
++}
++
++
++=head2 add_maintainer($name, $login, $password)
++
++Adds a new maintainer in the database, with given name, login and password.
++
++=cut
++
++sub add_maintainer {
++    my ($self, $name, $login, $pass) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{add_maintainer};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{add_maintainer});
++        $self->{_queries}->{add_maintainer} = $query;
++    }
++
++    $query->execute($login, $pass, $name, $default_flags);
++}
++
++sub _add_component {
++    my ($self, $package_id, $name, $description, $maintainer_id, $contact_id) = @_;
++
++    my $query = $self->{_queries}->{add_component};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{add_component});
++        $self->{_queries}->{add_component} = $query;
++    }
++
++    $query->execute($package_id, $name, $description, $maintainer_id, $contact_id);
++}
++
++=head2 del_package($package)
++
++Delete given package from database.
++
++=cut
++
++sub del_package {
++    my ($self, $package) = @_;
++    $self->_delete('del_package', $package);
++    $self->_delete('del_versions', $package);
++    $self->_delete('del_components', $package);
++}
++
++=head2 del_maintainer($maintainer)
++
++Delete given maintainer from database.
++
++=cut
++
++sub del_maintainer {
++    my ($self, $maintainer) = @_;
++    $self->_delete('del_maintainer', $maintainer);
++}
++
++sub _delete {
++    my ($self, $type, $value) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{$type};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{$type});
++        $self->{_queries}->{$type} = $query;
++    }
++
++    $query->execute($value);
++}
++
++=head2 reset_password(I<$maintainer>, I<$password>)
++
++Reset password of a maintainer to given password.
++
++=cut
++
++sub reset_password {
++    my ($self, $login, $pass) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{reset_password};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{reset_password});
++        $self->{_queries}->{reset_password} = $query;
++    }
++
++    $query->execute($pass, $login);
++}
++
++=head2 browse_packages($callback)
++
++Browse all packages from bugzilla, and execute given callback with name and
++maintainer as argument for each of them.
++
++=cut
++
++sub browse_packages {
++    my ($self, $callback) = @_;
++    return unless ref $self;
++
++    my $query = $self->{_queries}->{browse_packages};
++    unless ($query) {
++        $query = $self->{_dbh}->prepare($queries{browse_packages});
++        $self->{_queries}->{browse_packages} = $query;
++    }
++
++    $query->execute();
++
++    while (my @row = $query->fetchrow_array()) {
++        $callback->(@row);
++    }
++}
++
++# close database connection
++sub DESTROY {
++    my ($self) = @_;
++
++    foreach my $query (values %{$self->{_queries}}) {
++        $query->finish();
++    }
++
++    $self->{_dbh}->disconnect();
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Age.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Age.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Age.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/Iurt.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/Iurt.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/Iurt.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,117 @@
++# $Id: LBD.pm 574 2005-12-27 14:31:16Z guillomovitch $
++package Youri::Check::Input::Build::Source::Iurt;
++
++=head1 NAME
++
++Youri::Check::Input::Build::Source::Iurt - Iurt build log source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Build> collects build logs
++available from a iurt build bot.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use LWP::UserAgent;
++use HTML::TokeParser;
++use base 'Youri::Check::Input::Build::Source';
++
++my %status = (
++    install_deps => 0,
++    build        => 1,
++    binary_test  => 2
++);
++
++my $pattern = '^('
++    . join('|', keys %status)
++    . ')_\S+-[^-]+-[^-]+\.src\.rpm\.\d+\.log$';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Build::LBD object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL of logs for this iurt instance (default:
++http://qa.mandriva.com/build/iurt/cooker)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url    => 'http://qa.mandriva.com/build/iurt/cooker',
++        @_
++    );
++
++    $self->{_agent} = LWP::UserAgent->new();
++
++    # try to connect to base URL directly, and abort if not available
++    my $response = $self->{_agent}->head($options{url});
++    die "Unavailable URL $options{url}: " . $response->status_line()
++        unless $response->is_success();
++
++    $self->{_url} = $options{url};
++}
++
++sub fails {
++    my ($self, $name, $version, $release, $arch) = @_;
++
++    my $result;
++    my $url = "$self->{_url}/$arch/log/$name-$version-$release.src.rpm";
++    print "Fetching URL $url: " if $self->{_verbose} > 1;
++    my $response = $self->{_agent}->get($url);
++    print $response->status_line() . "\n" if $self->{_verbose} > 1;
++    if ($response->is_success()) {
++        my $parser = HTML::TokeParser->new(\$response->content());
++        while (my $token = $parser->get_tag('a')) {
++            my $href = $token->[1]->{href};
++            next unless $href =~ /$pattern/o;
++            my $status  = $1;
++            if (
++                !$result->{status} ||
++                $status{$result->{status}} < $status{$status}
++            ) {
++                $result->{status} = $status;
++                $result->{url}    = $url . '/' . $href;
++            }
++        }
++    }
++
++    $self->{_results}->{$name}->{$version}->{$release}->{$arch} = $result;
++
++    return $result->{status} && $result->{status} ne 'binary_test';
++}
++
++sub status {
++    my ($self, $name, $version, $release, $arch) = @_;
++    return
++        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
++}
++
++sub url {
++    my ($self, $name, $version, $release, $arch) = @_;
++    return
++        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{url};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/LBD.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/LBD.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source/LBD.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,135 @@
++# $Id: LBD.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Build::Source::LBD;
++
++=head1 NAME
++
++Youri::Check::Input::Build::Source::LBD - LBD build log source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Build> collects build logs
++available from a LBD build bot.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use LWP::UserAgent;
++use HTML::TokeParser;
++use base 'Youri::Check::Input::Build::Source';
++
++my @status = qw/
++    OK
++    arch_excl
++    broken
++    cannot_be_installed
++    debug
++    dependency
++    file_not_found
++    multiarch
++    problem
++    unpackaged_files
++/;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Build::LBD object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL of logs for this LBD instance (default: http://eijk.homelinux.org/build)
++
++=item medias $medias
++
++List of medias monitored by this LBD instance
++
++=item archs $archs
++
++List of architectures monitored by this LBD instance
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url    => 'http://eijk.homelinux.org/build',
++        medias => undef,
++        archs  => undef,
++        @_
++    );
++
++    my $agent   = LWP::UserAgent->new();
++
++    # try to connect to base URL directly, and abort if not available
++    my $response = $agent->head($options{url});
++    die "Unavailable URL $options{url}: " . $response->status_line()
++        unless $response->is_success();
++
++    my $pattern = '^(\S+)-([^-]+)-([^-]+)(?:\.gz)?$';
++
++    foreach my $arch (@{$options{archs}}) {
++        foreach my $media (@{$options{medias}}) {
++            my $url_base = "$options{url}/$arch/$media/BO";
++            foreach my $status (@status) {
++                my $url = "$url_base/$status/";
++                print "Fetching URL $url: " if $self->{_verbose} > 1;
++                my $response = $agent->get($url);
++                print $response->status_line() . "\n" if $self->{_verbose} > 1;
++                if ($response->is_success()) {
++                    my $parser = HTML::TokeParser->new(\$response->content());
++                    while (my $token = $parser->get_tag('a')) {
++                        my $href = $token->[1]->{href};
++                        next unless $href =~ /$pattern/o;
++                        my $name    = $1;
++                        my $version = $2;
++                        my $release = $3;
++                        my $result;
++                        $result->{status} = $status;
++                        $result->{url}    = $url . '/' . $href;
++                        $self->{_results}->{$name}->{$version}->{$release}->{$arch} = $result;
++                    }
++                }
++            }
++        }
++    }
++}
++
++sub fails {
++    my ($self, $name, $version, $release, $arch) = @_;
++
++    my $status =
++        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
++
++    return $status && $status ne 'OK' && $status ne 'arch_excl';
++}
++
++sub status {
++    my ($self, $name, $version, $release, $arch) = @_;
++    return
++        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{status};
++}
++
++sub url {
++    my ($self, $name, $version, $release, $arch) = @_;
++    return
++        $self->{_results}->{$name}->{$version}->{$release}->{$arch}->{url};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build/Source.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,109 @@
++# $Id: Source.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Build::Source;
++
++=head1 NAME
++
++Youri::Check::Input::Build::Source - Abstract build log source
++
++=head1 DESCRIPTION
++
++This abstract class defines the updates source interface for
++L<Youri::Check::Input::Build>.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Build object.
++
++No generic parameters (subclasses may define additional ones).
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id        => '',    # object id
++        test      => 0,     # test mode
++        verbose   => 0,     # verbose mode
++        @_
++    );
++
++    my $self = bless {
++        _id        => $options{id},
++        _test      => $options{test},
++        _verbose   => $options{verbose},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 get_id()
++
++Returns source identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=head2 fails($name, $version, $release, $arch)
++
++Returns true if build fails for package with given name, version and release on
++given architecture.
++
++=head2 status($name, $version, $release, $arch)
++
++Returns exact build status for package with given name, version and release on
++given architecture. It has to be called after fails().
++
++=head2 url($name, $version, $release, $arch)
++
++Returns URL of information source for package with given name, version and
++release on given architecture. It has to be called after fails().
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item fails
++
++=item status
++
++=item url
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Build.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,128 @@
++# $Id: Build.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Build;
++
++=head1 NAME
++
++Youri::Check::Input::Build - Check build outputs
++
++=head1 DESCRIPTION
++
++This plugin checks build outputs of packages, and report failures. Additional
++source plugins handle specific sources.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Utils;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        arch
++        bot
++        status
++    /;
++}
++
++sub links {
++    return qw/
++        status url
++    /;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Build object.
++
++Specific parameters:
++
++=over
++
++=item sources $sources
++
++Hash of source plugins definitions
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        sources => undef,
++        @_
++    );
++
++    croak "No source defined" unless $options{sources};
++    croak "sources should be an hashref" unless ref $options{sources} eq 'HASH';
++
++    foreach my $id (keys %{$options{sources}}) {
++        print "Creating source $id\n" if $options{verbose};
++        eval {
++            push(
++            @{$self->{_sources}},
++            create_instance(
++                    'Youri::Check::Input::Build::Source',
++                    id        => $id,
++                    test      => $options{test},
++                    verbose   => $options{verbose},
++                    %{$options{sources}->{$id}}
++                )
++            );
++            # register monitored archs
++            $self->{_archs}->{$_}->{$id} = 1
++                foreach @{$options{sources}->{$id}->{archs}};
++        };
++        print STDERR "Failed to create source $id: $@\n" if $@;
++    }
++
++    croak "no sources created" unless @{$self->{_sources}};
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # this is a source media check only
++    return unless $media->get_type() eq 'source';
++
++    my $callback = sub {
++        my ($package) = @_;
++
++        my $name    = $package->get_name();
++        my $version = $package->get_version();
++        my $release = $package->get_release();
++
++        foreach my $source (@{$self->{_sources}}) {
++            my $id = $source->get_id();
++            foreach my $arch (keys %{$self->{_archs}}) {
++                next unless $self->{_archs}->{$arch}->{$id};
++                $resultset->add_result($self->{_id}, $media, $package, { 
++                    arch   => $arch,
++                    bot    => $id,
++                    status => $source->status($name, $version, $release, $arch),
++                    url    => $source->url($name, $version, $release, $arch),
++                }) if $source->fails(
++                    $name,
++                    $version,
++                    $release,
++                    $arch,
++                );
++            }
++        }
++    };
++
++    $media->traverse_headers($callback);
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Conflicts.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Conflicts.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Conflicts.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,231 @@
++# $Id: Conflicts.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Conflicts;
++
++=head1 NAME
++
++Youri::Check::Input::Conflicts - Check file conflicts
++
++=head1 DESCRIPTION
++
++This plugin checks packages files, and report conflict and duplications.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use constant;
++use Youri::Package;
++use base 'Youri::Check::Input';
++
++use constant TYPE_MASK => 0170000; 
++use constant TYPE_DIR  => 0040000;
++
++use constant PACKAGE => 0;
++use constant MODE    => 1;
++use constant MD5SUM  => 2;
++
++my $compatibility = {
++    x86_64  => 'i586',
++    i586    => 'x86_64',
++    sparc64 => 'sparc',
++    sparc   => 'sparc64',
++    ppc64   => 'ppc',
++    ppc     => 'ppc64'
++};
++
++sub columns {
++    return qw/
++        arch
++        file
++        error
++        level
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Conflicts object.
++
++No specific parameters.
++
++=cut
++
++sub prepare {
++    my ($self, @medias) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $index = sub {
++        my ($package) = @_;
++
++        # index files
++        foreach my $file ($package->get_files()) {
++            push(
++                @{$self->{_files}->{$file->[Youri::Package::FILE_NAME]}},
++                [ $package, $file->[Youri::Package::FILE_MODE], $file->[Youri::Package::FILE_MD5SUM] ]
++            );
++        }
++    };
++
++    foreach my $media (@medias) {
++        # don't index source media files
++        next unless $media->get_type() eq 'binary';
++
++        my $media_id = $media->get_id();
++        $self->{_medias}->{$media_id} = 1;
++        print STDERR "Indexing media $media_id files\n"
++            if $self->{_verbose};
++
++        $media->traverse_headers($index);
++    }
++}
++
++sub run {
++    my ($self, $media, $result) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # this is a binary media check only
++    return unless $media->get_type() eq 'binary';
++
++    my $check = sub {
++        my ($package) = @_;
++
++        return if $package->get_arch() eq 'src';
++
++        my $arch = $package->get_arch();
++        my $name = $package->get_name();
++
++        foreach my $file ($package->get_files()) {
++
++            my $found =
++                $self->{_files}->{$file->[Youri::Package::FILE_NAME]};
++
++            my @found = $found ? @$found : ();
++
++            foreach my $found (@found) {
++                next if $found->[PACKAGE] == $package;
++                next unless compatible($found->[PACKAGE], $package);
++                next if conflict($found->[PACKAGE], $package);
++                next if replace($found->[PACKAGE], $package);
++                if (
++                    ($file->[Youri::Package::FILE_MODE] & TYPE_MASK) == TYPE_DIR &&
++                    ($found->[MODE] & TYPE_MASK) == TYPE_DIR
++                ) {
++                    $result->add_result($self->{_id}, $media, $package, {
++                        arch  => $arch,
++                        file  => $name,
++                        error => "directory $file->[Youri::Package::FILE_NAME] duplicated with package " . $found->[PACKAGE]->get_name(),
++                        level => Youri::Check::Input::WARNING
++                    }) unless $self->_directory_duplicate_exception(
++                        $package,
++                        $found->[PACKAGE],
++                        $file
++                    );
++                } else {
++                    if ($found->[MD5SUM] eq $file->[Youri::Package::FILE_MD5SUM]) {
++                        $result->add_result($self->{_id}, $media, $package, {
++                            arch  => $arch,
++                            file  => $name,
++                            error => "file $file->[Youri::Package::FILE_NAME] duplicated with package " . $found->[PACKAGE]->get_name(),
++                            level => Youri::Check::Input::WARNING
++                        }) unless $self->_file_duplicate_exception(
++                            $package,
++                            $found->[PACKAGE],
++                            $file
++                        );
++                    } else {
++                        $result->add_result($self->{_id}, $media, $package, {
++                            arch  => $arch,
++                            file  => $name,
++                            error => "non-explicit conflict on file $file->[Youri::Package::FILE_NAME] with package " . $found->[PACKAGE]->get_name(),
++                            level => Youri::Check::Input::ERROR
++                        }) unless $self->_file_conflict_exception(
++                            $package,
++                            $found->[PACKAGE],
++                            $file
++                        );
++                    }
++                }
++            }
++        }
++    };
++
++    $media->traverse_headers($check);
++}
++
++# return true if $package1 is arch-compatible with $package2
++sub compatible {
++    my ($package1, $package2) = @_;
++
++    my $arch1 = $package1->get_arch();
++    my $arch2 = $package2->get_arch();
++
++    return 1 if $arch1 eq $arch2;
++
++    return 1 if $compatibility->{$arch1} && $compatibility->{$arch1} eq $arch2;
++
++    return 0;
++}
++
++# return true if $package1 conflict with $package2
++# or the other way around
++sub conflict {
++    my ($package1, $package2) = @_;
++
++    my $name2 = $package2->get_name();
++
++    foreach my $conflict ($package1->get_conflicts()) {
++        return 1 if $conflict eq $name2;
++    }
++
++    my $name1 = $package1->get_name();
++
++    foreach my $conflict ($package2->get_conflicts()) {
++        return 1 if $conflict eq $name1;
++    }
++
++    return 0;
++}
++
++# return true if $package1 replace $package2
++sub replace {
++    my ($package1, $package2) = @_;
++
++
++    my $name1 = $package1->get_name();
++    my $name2 = $package2->get_name();
++
++    return 1 if $name1 eq $name2;
++
++    foreach my $obsolete ($package1->get_obsoletes()) {
++        return 1 if $obsolete->[Youri::Package::DEPENDENCY_NAME] eq $name2;
++    }
++
++    return 0;
++}
++
++sub _directory_duplicate_exception {
++    return 0;
++}
++
++sub _file_duplicate_exception {
++    return 0;
++}
++
++sub _file_conflict_exception {
++    return 0;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Dependencies.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Dependencies.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Dependencies.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,162 @@
++# $Id: Dependencies.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Dependencies;
++
++=head1 NAME
++
++Youri::Check::Input::Dependencies - Check dependencies consistency
++
++=head1 DESCRIPTION
++
++This class checks dependencies consistency.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Package;
++use base 'Youri::Check::Input';
++
++use constant MEDIA => 0;
++use constant RANGE => 1;
++
++sub columns {
++    return qw/
++        arch
++        file
++        error
++        level
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++sub prepare {
++    my ($self, @medias) = @_;
++    croak "Not a class method" unless ref $self;
++
++    foreach my $media (@medias) {
++        my $media_id = $media->get_id();
++        $self->{_medias}->{$media_id} = 1;
++        print STDERR "Indexing media $media_id dependencies\n"
++            if $self->{_verbose};
++
++        my $index = sub {
++            my ($package) = @_;
++
++            # index provides
++            foreach my $provide ($package->get_provides()) {
++                push(
++                    @{$self->{_provides}->{$provide->[Youri::Package::DEPENDENCY_NAME]}},
++                    [ $media_id, $provide->[Youri::Package::DEPENDENCY_RANGE] ]
++                );
++            }
++
++            # index files
++            foreach my $file ($package->get_files()) {
++                push(
++                    @{$self->{_files}->{$file->[Youri::Package::FILE_NAME]}},
++                    [ $media_id, undef ]
++                );
++            }
++        };
++        $media->traverse_headers($index);
++    }
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my @allowed_ids = $media->allow_deps();
++
++    # abort unless all allowed medias are present
++    foreach my $id (@allowed_ids) {
++        unless ($self->{_medias}->{$id}) {
++            carp "Missing media $id, aborting";
++            return;
++        }
++    }
++
++    # index allowed medias
++    my %allowed_ids = map { $_ => 1 } @allowed_ids;
++    my $allowed_ids = join(",", @allowed_ids);
++
++    my $class = $media->get_package_class();
++
++    my $check = sub {
++        my ($package) = @_;
++
++        my $arch = $package->get_arch();
++        my $name = $package->get_name();
++
++        foreach my $require ($package->get_requires()) {
++
++            my $found =
++                substr($require->[Youri::Package::DEPENDENCY_NAME], 0, 1) eq '/' ?
++                    $self->{_files}->{$require->[Youri::Package::DEPENDENCY_NAME]} :
++                    $self->{_provides}->{$require->[Youri::Package::DEPENDENCY_NAME]};
++
++            my @found = $found ? @$found : ();
++
++            if (!@found) {
++                $resultset->add_result($self->{_id}, $media, $package, {
++                    arch  => $arch,
++                    file  => $name,
++                    error => "$require->[Youri::Package::DEPENDENCY_NAME] not found",
++                    level => Youri::Check::Input::ERROR
++                });
++                next;
++            }
++
++            my @found_in_media =
++                grep { $allowed_ids{$_->[MEDIA]} }
++                @found;
++
++            if (!@found_in_media) {
++                $resultset->add_result($self->{_id}, $media, $package, {
++                    arch  => $arch,
++                    file  => $name,
++                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found in incorrect media $_->[MEDIA] (allowed $allowed_ids)",
++                    level => Youri::Check::Input::ERROR
++                }) foreach @found;
++                next;
++            }
++
++            next unless $require->[Youri::Package::DEPENDENCY_RANGE];
++
++            my @found_in_range =
++                grep {
++                    !$_->[RANGE] ||
++                    $class->compare_ranges(
++                        $require->[Youri::Package::DEPENDENCY_RANGE],
++                        $_->[RANGE]
++                    )
++                } @found_in_media;
++
++            if (!@found_in_range) {
++                $resultset->add_result($self->{_id}, $media, $package, {
++                    arch  => $arch,
++                    file  => $name,
++                    error => "$require->[Youri::Package::DEPENDENCY_NAME] found with incorrect range $_->[RANGE] (needed $require->[Youri::Package::DEPENDENCY_RANGE])",
++                    level => Youri::Check::Input::ERROR
++                }) foreach @found_in_media;
++                next;
++            }
++        }
++    };
++
++    $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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/MandrivaConflicts.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/MandrivaConflicts.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/MandrivaConflicts.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,63 @@
++# $Id: Conflicts.pm 533 2005-10-20 07:08:03Z guillomovitch $
++package Youri::Check::Input::MandrivaConflicts;
++
++=head1 NAME
++
++Youri::Check::Input::MandrivaConflicts - Check file conflicts on Mandriva
++
++=head1 DESCRIPTION
++
++This class checks file conflicts between packages, taking care of Mandriva
++packaging policy.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Package;
++use base 'Youri::Check::Input::Conflicts';
++
++sub _directory_duplicate_exception {
++    my ($self, $package1, $package2, $file) = @_;
++
++    # allow shared directories between devel packages of different arch
++    return 1 if _multiarch_exception($package1, $package2);
++
++    # allow shared modules directories between perl packages
++    return 1 if 
++        $file->[Youri::Package::FILE_NAME] =~ /^\/usr\/lib\/perl5\/vendor_perl\// &&
++        $file->[Youri::Package::FILE_NAME] !~ /^(auto|[^\/]+-linux)$/;
++
++    return 0;
++}
++
++sub _file_duplicate_exception {
++    my ($self, $package1, $package2, $file) = @_;
++
++    # allow shared files between devel packages of different arch
++    return 1 if _multiarch_exception($package1, $package2);
++
++    return 0;
++}
++
++sub _multiarch_exception {
++    my ($package1, $package2) = @_;
++
++    return 1 if
++        $package1->get_canonical_name() eq $package2->get_canonical_name()
++        && $package1->get_name() =~ /-devel$/
++        && $package2->get_name() =~ /-devel$/;
++
++    return 0;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Missing.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Missing.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Missing.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,138 @@
++package Youri::Check::Input::Missing;
++
++=head1 NAME
++
++Youri::Check::Input::Missing - Check components consistency
++
++=head1 DESCRIPTION
++
++This plugin checks consistency between package components, and report outdated
++ones.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use List::MoreUtils qw/all any/;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        component
++        arch
++        revision
++        error
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Missing object.
++
++No specific parameters.
++
++=cut
++
++sub prepare {
++    my ($self, @medias)  = @_;
++    croak "Not a class method" unless ref $self;
++    $self->{_srcs} = ();
++    foreach my $media (@medias) {
++        # only index source media
++        next unless $media->get_type() eq 'source';
++
++        my $media_id = $media->get_id();
++        $self->{_medias}->{$media_id} = 1;
++        print STDERR "Indexing media $media_id packages\n" if $self->{_verbose};
++
++        my $index = sub {
++            my ($package) = @_;
++            $self->{_srcs}->{$media_id}->{$package->get_name()} =
++                $package->get_version() . '-' . $package->get_release();
++        };
++
++        $media->traverse_headers($index);
++    }
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # this is a binary media check only
++    return unless $media->get_type() eq 'binary';
++
++    my @allowed_ids = $media->allow_srcs();
++
++    # abort unless all allowed medias are present
++    foreach my $id (@allowed_ids) {
++    unless ($self->{_medias}->{$id}) {
++            carp "Missing media $id, aborting";
++            return;
++        }
++    }
++
++    my $class = $media->get_package_class();
++
++    my $check_package = sub {
++        my ($package) = @_;
++        my $canonical_name = $package->get_canonical_name();
++
++        my $bin_revision =
++            $package->get_version() . '-' . $package->get_release();
++
++        my $src_revision;
++        foreach my $id (@allowed_ids) {
++            $src_revision = $self->{_srcs}->{$id}->{$canonical_name};
++            last if $src_revision;
++        }
++
++        if ($src_revision) {
++            # check if revision match
++            unless ($src_revision eq $bin_revision) {
++                if ($class->compare_versions($src_revision, $bin_revision) > 0) {
++                    # binary package is obsolete
++                    $resultset->add_result($self->{_id}, $media, $package, {
++                        component => $package->get_name(),
++                        arch      => $package->get_arch(),
++                        revision  => $bin_revision,
++                        error     => "Obsolete binaries (source $src_revision found)",
++                    });
++                } else {
++                    # source package is obsolete
++                    $resultset->add_result($self->{_id}, $media, $package, {
++                        component => $package->get_canonical_name(),
++                        arch      => 'src',
++                        revision  => $src_revision,
++                        error     => "Obsolete source (binaries $bin_revision found)",
++                    });
++                }
++            }
++        } else {
++            $resultset->add_result($self->{_id}, $media, $package, {
++                component => $package->get_name(),
++                arch      => $package->get_arch(),
++                revision  => $bin_revision,
++                error     => "Missing source package",
++            });
++        }
++    };
++
++    $media->traverse_headers($check_package);
++}
++
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Orphans.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Orphans.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Orphans.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,74 @@
++package Youri::Check::Input::Orphans;
++
++=head1 NAME
++
++Youri::Check::Input::Orphans - Check maintainance
++
++=head1 DESCRIPTION
++
++This plugin checks maintainance status of packages, and reports unmaintained
++ones.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        error
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Orphans object.
++
++No specific parameters.
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        resolver => undef,
++        @_
++    );
++
++    croak "No resolver defined" unless $options{resolver};
++
++    $self->{_resolver} = $options{resolver};
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++    
++    # this is a source media check only
++    return unless $media->get_type() eq 'source';
++
++    my $check = sub {
++        my ($package) = @_;
++        $resultset->add_result($self->{_id}, $media, $package, {
++            error => "unmaintained package"
++        }) unless $self->{_resolver}->get_maintainer($package);
++    };
++
++    $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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Rpmlint.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Rpmlint.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Rpmlint.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,113 @@
++# $Id: Rpmlint.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Rpmlint;
++
++=head1 NAME
++
++Youri::Check::Input::Rpmlint - Check packages with rpmlint
++
++=head1 DESCRIPTION
++
++This plugins checks packages with rpmlint, and reports output.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        arch
++        file
++        error
++        level
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Rpmlint object.
++
++Specific parameters:
++
++=over
++
++=item path $path
++
++Path to the rpmlint executable (default: /usr/bin/rpmlint)
++
++=item config $config
++
++Specific rpmlint configuration.
++
++=back
++
++=cut
++
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        path   => '/usr/bin/rpmlint', # path to rpmlint
++        config => '',                 # default rpmlint configuration
++        @_
++    );
++
++    $self->{_path}   = $options{path};
++    $self->{_config} = $options{config};
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $config = $media->rpmlint_config() ?
++        $media->rpmlint_config() :
++        $self->{_config};
++
++    my $check = sub {
++        my ($file, $package) = @_;
++
++        my $arch = $package->get_arch();
++        my $name = $package->get_name();
++
++        my $command = "$self->{_path} -f $config $file";
++        open(RPMLINT, "$command |") or die "Can't run $command: $!";
++        while (<RPMLINT>) {
++            chomp;
++            if (/^E: \Q$name\E (.+)/) {
++                $resultset->add_result($self->{_id}, $media, $package, { 
++                    arch  => $arch,
++                    file  => $name,
++                    error => $1,
++                    level => Youri::Check::Input::ERROR
++                });
++            } elsif (/^W: \Q$name\E (.+)/) {
++                $resultset->add_result($self->{_id}, $media, $package, { 
++                    arch  => $arch,
++                    file  => $name,
++                    error => $1,
++                    level => Youri::Check::Input::WARNING
++                });
++            }
++        }
++        close(RPMLINT);
++    };
++
++    $media->traverse_files($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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Signature.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Signature.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Signature.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,96 @@
++# $Id: Rpmlint.pm 567 2005-12-12 21:24:56Z guillomovitch $
++package Youri::Check::Input::Signature;
++
++=head1 NAME
++
++Youri::Check::Input::Signature - Check signature
++
++=head1 DESCRIPTION
++
++This plugin checks packages signature, and report unsigned ones. 
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        arch
++        file
++        error
++    /;
++}
++
++sub links {
++    return qw//;
++}
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Signature object.
++
++Specific parameters:
++
++=over
++
++=item key $key
++
++Expected GPG key identity
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        key => '',
++        @_
++    );
++
++    $self->{_key} = $options{key};
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $check = sub {
++        my ($package) = @_;
++
++        my $arch = $package->get_arch();
++        my $name = $package->get_name();
++
++        my $key = $package->get_gpg_key();
++
++        if (!$key) {
++            $resultset->add_result($self->{_id}, $media, $package, { 
++                arch  => $arch,
++                file  => $name,
++                error => "unsigned package $name"
++            });
++        } elsif ($key ne $self->{_key}) {
++            $resultset->add_result($self->{_id}, $media, $package, { 
++                arch  => $arch,
++                file  => $name,
++                error => "invalid key id $key for package $name (allowed $self->{_key})"
++            });
++        }
++        
++    };
++
++    $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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/CPAN.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/CPAN.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/CPAN.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,75 @@
++# $Id: CPAN.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::CPAN;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::CPAN - CPAN updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from CPAN.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::CPAN object.  
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to CPAN full modules list (default:
++http://www.cpan.org/modules/01modules.index.html)
++
++=back
++
++=cut
++
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://www.cpan.org/modules/01modules.index.html',
++        @_
++    );
++
++    my $versions;
++    open(INPUT, "GET $options{url} |") or croak "Can't fetch $options{url}: $!";
++    while (<INPUT>) {
++        next unless $_ =~ />([\w-]+)-([\d\.]+)\.tar\.gz<\/a>/;
++        $versions->{$1} = $2;
++    }
++    close(INPUT);
++
++    $self->{_versions} = $versions;
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://search.cpan.org/dist/$name";
++}
++
++sub _name {
++    my ($self, $name) = @_;
++    $name =~ s/^perl-//g;
++    return $name;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Debian.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Debian.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Debian.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,82 @@
++# $Id: Debian.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::Debian;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::Debian - Debian source for updates
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++ available from Debian.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Debian object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to Debian mirror content file (default: http://ftp.debian.org/ls-lR.gz)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://ftp.debian.org/ls-lR.gz',
++        @_
++    );
++
++    my $versions;
++    open(INPUT, "GET $options{url} | zcat |") or croak "Can't fetch $options{url}: $!";
++    while (my $line = <INPUT>) {
++        next unless $line =~ /([\w\.-]+)_([\d\.]+)\.orig\.tar\.gz$/;
++        my $name = $1;
++        my $version = $2;
++        $versions->{$name} = $version;
++    }
++    close(INPUT);
++
++    $self->{_versions} = $versions;
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://packages.debian.org/$name";
++}
++
++sub _name {
++    my ($self, $name) = @_;
++    
++    if ($name =~ /^(perl|ruby)-([-\w]+)$/) {
++        $name = lc("lib$2-$1");
++    } elsif ($name =~ /^apache-([-\w]+)$/) {
++        $name = "libapache-$1";
++        $name =~ s/_/-/g;
++    }
++
++    return $name;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Fedora.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Fedora.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Fedora.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,63 @@
++# $Id: Fedora.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::Fedora;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::Fedora - Fedora updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from Fedora.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Fedora object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to Fedora development SRPMS directory (default:
++http://fr.rpmfind.net/linux/fedora/core/development/SRPMS)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://fr.rpmfind.net/linux/fedora/core/development/SRPMS',
++        @_
++    );
++
++    my $versions;
++    open(INPUT, "GET $options{url} |") or die "Can't fetch $options{url}: $!\n";
++    while (<INPUT>) {
++        next unless $_ =~ />([\w-]+)-([\w\.]+)-[\w\.]+\.src\.rpm<\/a>/;
++        $versions->{$1} = $2;
++    }
++    close(INPUT);
++
++    $self->{_versions} = $versions;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Freshmeat.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,111 @@
++# $Id: Freshmeat.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::Freshmeat;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::Freshmeat - Freshmeat source for updates
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from Freshmeat.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use XML::Twig;
++use LWP::UserAgent;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Freshmeat
++object.
++
++Specific parameters:
++
++=over
++
++=item preload true/false
++
++Allows to load full Freshmeat catalogue at once instead of checking each software independantly (default: false)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        preload => 0,
++        @_
++    );
++
++    if ($options{preload}) {
++        my $versions;
++        
++        my $project = sub {
++            my ($twig, $project) = @_;
++            my $name    = $project->first_child('projectname_short')->text();
++            my $version = $project->first_child('latest_release')->first_child('latest_release_version')->text();
++            $versions->{$name} = $version;
++            $twig->purge();
++        };
++
++        my $twig = XML::Twig->new(
++           TwigRoots => { project => $project }
++        );
++
++        my $url = 'http://download.freshmeat.net/backend/fm-projects.rdf.bz2';
++
++        open(INPUT, "GET $url | bzcat |") or die "Can't fetch $url: $!\n";
++        $twig->parse(\*INPUT);
++        close(INPUT);
++
++        $self->{_versions} = $versions;
++    }
++}
++
++sub _version {
++    my ($self, $name) = @_;
++
++    if ($self->{_versions}) {
++        return $self->{_versions}->{$name};
++    } else {
++        my $version;
++
++        my $latest_release_version = sub {
++            $version = $_[1]->text();
++        };
++
++        my $twig = XML::Twig->new(
++            TwigRoots => { latest_release_version => $latest_release_version }
++        );
++
++        my $url = "http://freshmeat.net/projects-xml/$name";
++        
++        open(INPUT, "GET $url |") or die "Can't fetch $url: $!\n";
++        # freshmeat answer with an HTML page when project doesn't exist
++        $twig->safe_parse(\*INPUT);
++        close(INPUT);
++
++        return $version;
++    }
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://freshmeat.net/projects/$name";
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/GNOME.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/GNOME.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/GNOME.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,104 @@
++# $Id$
++package Youri::Check::Input::Updates::Source::GNOME;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::GNOME - GNOME updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from GNOME.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use LWP::UserAgent;
++use HTML::TokeParser;
++use List::MoreUtils 'any';
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Gnome object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to GNOME sources directory (default:
++http://fr2.rpmfind.net/linux/gnome.org/sources)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://fr2.rpmfind.net/linux/gnome.org/sources/', # default url
++	# We use HTTP as it offers a better sorting (1.2 < 1.10)
++        @_
++    );
++
++    $self->{_agent} = LWP::UserAgent->new();
++    my $response = $self->{_agent}->get($options{url});
++    if($response->is_success()) {
++        my $parser = HTML::TokeParser->new(\$response->content());
++        while (my $token = $parser->get_tag('a')) {
++            my $href = $token->[1]->{href};
++            next unless $href =~ /^([-\w]+)\/$/o;
++            $self->{_names}->{$1} = 1;
++        }
++    }
++
++    $self->{_url} = $options{url};
++}
++
++sub _version {
++    my ($self, $name) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return unless $self->{_names}->{$name};
++    
++    my $response = $self->{_agent}->get("$self->{_url}/$name/");
++    if($response->is_success()) {
++        my $major;
++        my $parser = HTML::TokeParser->new(\$response->content());
++        while (my $token = $parser->get_tag('a')) {
++            my $href = $token->[1]->{href};
++            next unless $href =~ /^([.\d]+)\/$/o;
++            $major = $1;
++        }
++        return unless $major;
++
++        $response = $self->{_agent}->get("$self->{_url}/$name/$major/");
++        if($response->is_success()) {
++            $parser = HTML::TokeParser->new(\$response->content());
++            while (my $token = $parser->get_tag('a')) {
++                my $href = $token->[1]->{href};
++                next unless $href =~ /^LATEST-IS-([.\d]+)$/o;
++                return $1;
++            }
++        }
++    }
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return $self->{_url}."$name/";
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Gentoo.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Gentoo.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Gentoo.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,75 @@
++# $Id: Gentoo.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::Gentoo;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::Gentoo - Gentoo updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from Gentoo.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use LWP::Simple;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Gentoo object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to Gentoo snapshots directory (default:
++http://gentoo.mirror.sdv.fr/snapshots)
++
++=back
++
++=cut
++
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://gentoo.mirror.sdv.fr/snapshots', # default URL
++        @_
++    );
++
++    my $versions;
++    my $content = get($options{url});
++    my $file;
++    while ($content =~ /<A HREF="(portage-\d{8}.tar.bz2)">/g) {
++        $file = $1;
++    }
++    open(INPUT, "GET $options{url}/$file | tar tjf - |") or croak "Can't fetch $options{url}/$file: $!";
++    while (my $line = <INPUT>) {
++        next unless $line =~ /.*\/([\w-]+)-([\d\.]+)(:?-r\d)?\.ebuild$/;
++        $versions->{$1} = $2;
++    }
++    close(INPUT);
++
++    $self->{_versions} = $versions;
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://packages.gentoo.org/search/?sstring=$name";
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/NetBSD.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/NetBSD.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/NetBSD.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,75 @@
++# $Id$
++package Youri::Check::Input::Updates::Source::NetBSD;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::NetBSD - NetBSD source for updates
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++ available from NetBSD.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Input::Updates::Source';
++use IO::Ftp;
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::NetBSD object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to NetBSD mirror content file, without ftp: (default: //ftp.free.fr/mirrors/ftp.netbsd.org/NetBSD-current/pkgsrc/README-all.html)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => '//ftp.free.fr/mirrors/ftp.netbsd.org/NetBSD-current/pkgsrc/README-all.html',
++        @_
++    );
++
++    my $versions;
++    my $urls;
++
++    my $in = IO::Ftp->new('<',$options{url}) or croak "Can't fetch $options{url}: $!";
++    while (my $line = <$in>) {
++        next unless $line =~ /<!-- (.+)-([^-]*?)(nb\d*)? \(for sorting\).*?href="([^"]+)"/;
++        my $name = $1;
++        my $version = $2;
++        $versions->{$name} = $version;
++        $urls->{$name} = $4;
++    }
++    close($in);
++
++    $self->{_versions} = $versions;
++    $self->{_urls} = $urls;
++    $self->{_url} = $options{url};
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return $self->{_urls}->{$name};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/RAA.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/RAA.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/RAA.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,121 @@
++# $Id: RAA.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::RAA;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::RAA - RAA updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from RAA.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use SOAP::Lite;
++use List::MoreUtils 'any';
++use Youri::Package;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::RAA object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++URL to RAA SOAP interface (default:
++http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4)
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => 'http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4/',
++        @_
++    );
++
++    my $raa = SOAP::Lite->service($options{url})
++        or croak "Can't connect to $options{url}";
++    
++    $self->{_raa}   = $raa;
++    $self->{_names} = $raa->names();
++}
++
++sub get_version {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $name;
++    if (ref $package && $package->isa('Youri::Package')) {
++        # don't bother checking for non-ruby packages
++        if (
++            any { $_->[Youri::Package::DEPENDENCY_NAME] =~ /ruby/ }
++            $package->get_requires()
++        ) {
++            $name = $package->get_canonical_name();
++        } else {
++            return;
++        }
++    } else {
++        $name = $package;
++    }
++
++    # translate in grabber namespace
++    $name = $self->get_name($name);
++
++    # return if aliased to null 
++    return unless $name;
++
++    # susceptible to throw exception for timeout
++    eval {
++        my $gem = $self->{_raa}->gem($name);
++        return $gem->{project}->{version} if $gem;
++    };
++
++    return;
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://raa.ruby-lang.org/project/$name/";
++}
++
++sub _name {
++    my ($self, $name) = @_;
++
++    if (ref $self) {
++        my $match = $name;
++        $match =~ s/^ruby[-_]//;
++        $match =~ s/[-_]ruby$//;
++        my @results =
++            grep { /^(ruby[-_])?\Q$match\E([-_]ruby)$/ }
++            @{$self->{_names}};
++        if (@results) {
++            return $results[0];
++        } else {
++            return $name;
++        }
++    } else {
++        return $name;
++    }
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source/Sourceforge.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,103 @@
++# $Id: Sourceforge.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source::Sourceforge;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source::Sourceforge - Sourceforge updates source
++
++=head1 DESCRIPTION
++
++This source plugin for L<Youri::Check::Input::Updates> collects updates
++available from Sourceforge.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use LWP::UserAgent;
++use HTML::TokeParser;
++use Youri::Check::Input::Updates;
++use base 'Youri::Check::Input::Updates::Source';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates::Source::Sourceforge
++object.  
++
++No specific parameters.
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        @_
++    );
++
++    $self->{_agent} = LWP::UserAgent->new();
++}
++
++sub get_version {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $name;
++    if (ref $package && $package->isa('Youri::Package')) {
++        # don't bother checking for packages without sf.net URL
++        my $url = $package->get_url();
++        if (
++            $url =~ /http:\/\/(.*)\.sourceforge\.net/ ||
++            $url =~ /http:\/\/.*sourceforge\.net\/projects\/([^\/]+)/
++        ) {
++            $name = $package->get_canonical_name();
++        } else {
++            return;
++        }
++    } else {
++        $name = $package;
++    }
++
++    # translate in grabber namespace
++    $name = $self->get_name($name);
++
++    # return if aliased to null 
++    return unless $name;
++
++    my $response = $self->{_agent}->get($self->_url($name));
++    if($response->is_success()) {
++        my $max = 0;
++        my $parser = HTML::TokeParser->new(\$response->content());
++        while (my $token = $parser->get_tag('a')) {
++            my $text = $parser->get_trimmed_text("/$token->[0]");
++            next unless $text;
++            next unless $text =~ /^
++                \Q$name\E
++                [._-]?($Youri::Check::Input::Updates::VERSION_REGEXP)
++                [._-]?(w(?:in)?(?:32)?|mips|sparc|bin|ppc|i\d86|src|sources?)?
++                \.(?:tar\.(?:gz|bz2)|tgz|zip)
++                $/iox;
++            my $version = $1;
++            my $arch    = $2;
++            next if $arch && $arch !~ /(src|sources?)/;
++            $max = $version if Youri::Check::Input::Updates::is_newer($version, $max);
++        }
++        return $max if $max;
++    }
++    return;
++}
++
++sub _url {
++    my ($self, $name) = @_;
++    return "http://prdownloads.sourceforge.net/$name/";
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates/Source.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,240 @@
++# $Id: Source.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates::Source;
++
++=head1 NAME
++
++Youri::Check::Input::Updates::Source - Abstract updates source
++
++=head1 DESCRIPTION
++
++This abstract class defines the updates source interface for
++L<Youri::Check::Input::Updates>.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates object.
++
++Generic parameters (subclasses may define additional ones):
++
++=over
++
++=item aliases $aliases
++
++Hash of package aliases.
++
++=back
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id          => '',    # object id
++        test        => 0,     # test mode
++        verbose     => 0,     # verbose mode
++        aliases     => undef, # aliases
++        resolver    => undef, # maintainer resolver
++        preferences => undef, # maintainer preferences
++        check_id    => '',    # parent check id
++        @_
++    );
++
++    if ($options{aliases}) {
++        croak "aliases should be an hashref" unless ref $options{aliases} eq 'HASH';
++    }
++    if ($options{resolver}) {
++        croak "resolver should be a Youri::Check::Maintainer::Resolver object" unless $options{resolver}->isa("Youri::Check::Maintainer::Resolver");
++    }
++    if ($options{preferences}) {
++        croak "preferences should be a Youri::Check::Maintainer::Preferences object" unless $options{preferences}->isa("Youri::Check::Maintainer::Preferences");
++    }
++
++    my $self = bless {
++        _id          => $options{id},
++        _test        => $options{test},
++        _verbose     => $options{verbose},
++        _aliases     => $options{aliases},
++        _resolver    => $options{resolver},
++        _preferences => $options{preferences},
++        _check_id    => $options{check_id},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++Excepted explicit statement, package name is expressed with Mandriva naming
++conventions.
++
++=head2 get_id()
++
++Returns source identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=head2 get_version($package)
++
++Returns available version for given package, which can be either a full
++L<Youri::Package> object or just a package name.
++
++=cut
++
++sub get_version {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $name = ref $package && $package->isa('Youri::Package') ?
++        $package->get_canonical_name() :
++        $package;
++
++    # translate in grabber namespace
++    $name = $self->get_name($name);
++
++    # return if aliased to null 
++    return unless $name;
++
++    # return subclass computation
++    return $self->_version($name);
++}
++
++=head2 get_url($name)
++
++Returns the URL of information source for package with given name.
++
++=cut
++
++sub get_url {
++    my ($self, $name) = @_;
++
++    # retun subclass computation
++    return $self->_url($self->get_name($name));
++}
++
++=head2 name($name)
++
++Returns name converted to specific source naming conventions for package with given name.
++
++=cut
++
++sub get_name {
++    my ($self, $name) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # return config aliases if it exists
++    if ($self->{_aliases} ) {
++        return $self->{_aliases}->{$name} if exists $self->{_aliases}->{$name};
++    }
++
++    # return maintainer aliases if it exists
++    if ($self->{_resolver} && $self->{_preferences}) {
++        my $maintainer = $self->{_resolver}->get_maintainer($name);
++        if ($maintainer) {
++            my $aliases = $self->{_preferences}->get_preference(
++                $maintainer,
++                $self->{_check_id},
++                'aliases'
++            );
++            if ($aliases) {
++                if ($aliases->{all}) {
++                    return $aliases->{all}->{$name} if exists $aliases->{all}->{$name};
++                }
++                if ($aliases->{$self->{_id}}) {
++                    return $aliases->{$self->{_id}}->{$name} if exists $aliases->{$self->{_id}}->{$name};
++                }
++            }
++        }
++    }
++
++    # return return subclass computation
++    return $self->_name($name);
++}
++
++=head2 _version($name)
++
++Hook called by default B<version()> implementation after name translation.
++
++=cut
++
++sub _version {
++    my ($self, $name) = @_;
++    return $self->{_versions}->{$name};
++}
++
++=head2 _url($name)
++
++Hook called by default B<url()> implementation after name translation.
++
++=cut
++
++sub _url {
++    my ($self, $name) = @_;
++    return undef;
++}
++
++=head2 _name($name)
++
++Hook called by default B<name()> implementation if given name was not found in
++the aliases.
++
++=cut
++
++sub _name {
++    my ($self, $name) = @_;
++    return $name;
++}
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item version
++
++As an alternative, the B<_version()> hook can be implemented.
++
++=item url
++
++As an alternative, the <_url()> hook can be implemented.
++
++=item name
++
++As an alternative, the B<_name()> hook can be implemented.
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input/Updates.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,275 @@
++# $Id: Updates.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input::Updates;
++
++=head1 NAME
++
++Youri::Check::Input::Updates - Check available updates
++
++=head1 DESCRIPTION
++
++This plugin checks available updates for packages, and report existing ones.
++Additional source plugins handle specific sources.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Memoize;
++use Youri::Utils;
++use base 'Youri::Check::Input';
++
++sub columns {
++    return qw/
++        current
++        available
++        source
++    /;
++}
++
++sub links {
++    return qw/
++        source url
++    /;
++}
++
++memoize('is_newer');
++
++our $VERSION_REGEXP = 'v?([\d._-]*\d)[._ -]*(?:(alpha|beta|pre|rc|pl|rev|cvs|svn|[a-z])[_ -.]*([\d.]*))?([_ -.]*.*)';
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input::Updates object.
++
++Specific parameters:
++
++=over
++
++=item aliases $aliases
++
++Hash of global aliases definitions
++
++=item sources $sources
++
++Hash of source plugins definitions
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        aliases => undef,
++        sources => undef,
++        @_
++    );
++
++    croak "No source defined" unless $options{sources};
++    croak "sources should be an hashref" unless ref $options{sources} eq 'HASH';
++    if ($options{aliases}) {
++        croak "aliases should be an hashref" unless ref $options{aliases} eq 'HASH';
++    }
++
++    foreach my $id (keys %{$options{sources}}) {
++        print "Creating source $id\n" if $options{verbose};
++        eval {
++            # add global aliases if defined
++            if ($options{aliases}) {
++                foreach my $alias (keys %{$options{aliases}}) {
++                    $options{sources}->{$id}->{aliases}->{$alias} =
++                    $options{aliases}->{$alias}
++                }
++            }
++
++            push(
++                @{$self->{_sources}},
++                create_instance(
++                    'Youri::Check::Input::Updates::Source',
++                    id          => $id,
++                    test        => $options{test},
++                    verbose     => $options{verbose},
++                    check_id    => $options{id},
++                    resolver    => $options{resolver},
++                    preferences => $options{preferences},
++                    %{$options{sources}->{$id}}
++                )
++            );
++        };
++        print STDERR "Failed to create source $id: $@\n" if $@;
++    }
++
++    croak "no sources created" unless @{$self->{_sources}};
++}
++
++sub run {
++    my ($self, $media, $resultset) = @_;
++    croak "Not a class method" unless ref $self;
++    
++    # this is a source media check only
++    return unless $media->get_type() eq 'source';
++
++    my $callback = sub {
++        my ($package) = @_;
++
++        my $name    = $package->get_name();
++        my $version = $package->get_version();
++        my $release = $package->get_release();
++
++        # compute version with rpm subtilities related to preversions
++        my $current_version = ($release =~ /^0\.(\w+)\.\w+$/) ?
++            $version . $1 :
++            $version;
++        my $current_stable = is_stable($current_version);
++
++        my ($max_version, $max_source, $max_url);
++        $max_version = $current_version;
++
++        foreach my $source (@{$self->{_sources}}) {
++            my $available_version = $source->get_version($package);
++            if (
++                $available_version &&
++                (! $current_stable || is_stable($available_version)) &&
++                is_newer($available_version, $max_version)
++            ) {
++                $max_version = $available_version;
++                $max_source  = $source->get_id();
++                $max_url     = $source->get_url($name);
++            }
++        }
++        $resultset->add_result($self->{_id}, $media, $package, {
++            current   => $current_version,
++            available => $max_version,
++            source    => $max_source,
++            url       => $max_url
++        }) if $max_version ne $current_version;
++    };
++
++    $media->traverse_headers($callback);
++}
++
++=head2 is_stable($version)
++
++Checks if given version is stable.
++
++=cut
++
++sub is_stable {
++    my ($version) = @_;
++    return $version !~ /alpha|beta|pre|rc|cvs|svn/i;
++    
++}
++
++=head2 is_newer($v1, $v2)
++
++Checks if $v1 is newer than $v2.
++
++This function will return true only if we are sure this is newer (and not equal).
++If we can't compare the versions, a warning will be displayed.
++
++=cut
++
++sub is_newer {
++    my ($v1, $v2) = @_;  
++    return 0 if $v1 eq $v2;
++
++    # Reject strange cases
++    # One is a large number (like date or revision) and the other one not, or
++    # has different length
++    if (($v1 =~ /^\d{3,}$/ || $v2 =~ /^\d{3,}$/) 
++       && (join('0',split(/\d/, $v1."X")) ne join('0',split(/\d/, $v2."X")))) { 
++      carp "strange : $v1 vs $v2";
++      return 0;
++    }
++
++    my %states = (alpha=>-4,beta=>-3,pre=>-2,rc=>-1);
++    my $i; $states{$_} = ++$i foreach 'a'..'z';
++
++    if ($v1 =~ /^[\d._-]+$/ && $v2 =~ /^[\d._-]+$/) {
++        my @v1 = split(/[._-]/, $v1);
++        my @v2 = split(/[._-]/, $v2);
++	if (join('', at v1) eq (join '', at v2)) {
++          # Might be something like 1.2.0 vs 1.20, usual false positive
++          carp "strange : $v1 vs $v2";
++          return 0;
++        }
++        for my $i (0 .. $#v1) {
++          $v1[$i] ||= 0;
++          $v2[$i] ||= 0;
++          return 1 if $v1[$i] > $v2[$i];
++          return 0 if $v1[$i] < $v2[$i];
++        }
++        # When v2 is longer than v1 but start the same, v1 <= v2
++        return 0;
++    } else {
++        my ($num1, $state1, $statenum1, $other1, $num2, $state2, $statenum2, $other2);
++
++        if ($v1 =~ /^$VERSION_REGEXP$/io) {
++            ($num1, $state1, $statenum1, $other1) = ($1, "\L$2", $3, $4);
++        } else {
++            carp "unknown version format $v1";
++            return 0;
++        }
++
++        if ($v2 =~ /^$VERSION_REGEXP$/io) {
++            ($num2, $state2, $statenum2, $other2) = ($1, "\L$2", $3, $4);
++        } else {
++            carp "unknown version format $v2";
++            return 0;
++        }
++
++        # If we know the format of only one, there might be an issue, do nothing
++
++        if (($other1 && ! $other2 )||(!$other1 && $other2 )) {
++            carp "can't compare $v1 vs $v2";
++            return 0;
++        }
++	
++        return 1 if is_newer($num1, $num2);
++        return 0 unless $num1 eq $num2;
++
++        # The numeric part is the same but not the end
++        
++        if ($state1 eq '') {
++            return 1 if $state2 =~ /^(alpha|beta|pre|rc)/;
++            return 0 if $state2 =~ /^([a-z]|pl)$/;
++            carp "unknown state format $state2";
++            return 0;
++        }
++
++        if ($state2 eq '') {
++            return 0 if $state1 =~ /^(alpha|beta|pre|rc)/;
++            return 1 if $state1 =~ /^([a-z]|pl)$/;
++            carp "unknown state format $state1";
++            return 0;
++        }
++
++        if ($state1 eq $state2) {
++                return 1 if is_newer($statenum1, $statenum2);
++                return 0 unless $statenum1 eq $statenum2;
++                # If everything is the same except this, just compare it
++                # as we have no idea on the format
++                return "$other1" gt "$other2";
++        }
++
++        my $s1 = 0;
++        my $s2 = 0;
++        $s1=$states{$state1} if exists $states{$state1};
++        $s2=$states{$state2} if exists $states{$state2};
++        return $s1>$s2 if ($s1 != 0 && $s2 != 0);
++        return 1 if $s1<0 && $state2 =~ /^([a-z]|pl)$/;
++        return 0 if $s2<0 && $state1 =~ /^([a-z]|pl)$/;
++        carp "unknown case $v1, $v2";
++        return 0;
++    }
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Input.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Input.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Input.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,120 @@
++# $Id: Input.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Input;
++
++=head1 NAME
++
++Youri::Check::Input - Abstract input plugin
++
++=head1 DESCRIPTION
++
++This abstract class defines input plugin interface.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Utils;
++
++use constant WARNING => 'warning';
++use constant ERROR => 'error';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Input object.
++
++No generic parameters (subclasses may define additional ones).
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id          => '',    # object id
++        test        => 0,     # test mode
++        verbose     => 0,     # verbose mode
++        resolver    => undef, # maintainer resolver
++        preferences => undef, # maintainer preferences
++        @_
++    );
++
++    if ($options{resolver}) {
++        croak "resolver should be a Youri::Check::Maintainer::Resolver object" unless $options{resolver}->isa("Youri::Check::Maintainer::Resolver");
++    }
++    if ($options{preferences}) {
++        croak "preferences should be a Youri::Check::Maintainer::Preferences object" unless $options{preferences}->isa("Youri::Check::Maintainer::Preferences");
++    }
++
++    my $self = bless {
++        _id          => $options{id},
++        _test        => $options{test},
++        _verbose     => $options{verbose},
++        _resolver    => $options{resolver},
++        _preferences => $options{preferences},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 get_id()
++
++Returns plugin identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=head2 prepare(@medias)
++
++Perform optional preliminary initialisation, using given list of
++<Youri::Media> objects.
++
++=cut
++
++sub prepare {
++    # do nothing
++}
++
++=head2 run($media, $resultset)
++
++Check the packages from given L<Youri::Media> object, and store the
++result in given L<Youri::Check::Resultset> object.
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item run
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences/File.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences/File.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences/File.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,87 @@
++# $Id: File.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Maintainer::Preferences::File;
++
++=head1 NAME
++
++Youri::Check::Maintainer::Preferences::File - File-based maintainer preferences implementation
++
++=head1 DESCRIPTION
++
++This is a file-based L<Youri::Check::Maintainer::Preferences> implementation.
++
++It uses files in maintainer home directories.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Config;
++use base 'Youri::Check::Maintainer::Preferences';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Maintainer::Preferences::File object.
++
++No specific parameters.
++
++=cut
++
++sub get_preference {
++    my ($self, $maintainer, $plugin, $value) = @_;
++    croak "Not a class method" unless ref $self;
++    return unless $maintainer && $plugin && $value;
++
++    print "Retrieving maintainer $maintainer preferences\n"
++        if $self->{_verbose} > 0;
++
++    $self->_load_config($maintainer)
++        unless exists $self->{_config}->{$maintainer};
++
++    return $self->{_config}->{$maintainer} ?
++        $self->{_config}->{$maintainer}->get($plugin . '_' . $value) :
++        undef;
++}
++
++sub _load_config {
++    my ($self, $maintainer) = @_;
++
++    print "Attempting to load maintainers preferences for $maintainer\n" if $self->{_verbose} > 1;
++
++
++    my ($login) = $maintainer =~ /^(\S+)\@\S+$/;
++    my $home = (getpwnam($login))[7];
++    my $file = "$home/.youri/check.prefs";
++
++    if (-f $file && -r $file) {
++        print "Found, loading\n" if $self->{_verbose} > 1;
++        my $config = Youri::Config->new(
++            {
++                CREATE => 1,
++                GLOBAL => {
++                   DEFAULT  => undef,
++                   EXPAND   => EXPAND_VAR | EXPAND_ENV,
++                   ARGCOUNT => ARGCOUNT_ONE,
++                }
++            }
++        );
++        $config->file($file);
++        $self->{_config}->{$maintainer} = $config;
++    } else {
++        print "Not found, aborting\n" if $self->{_verbose} > 1;
++        $self->{_config}->{$maintainer} = undef;
++    }
++
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Preferences.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,80 @@
++# $Id: Preferences.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Maintainer::Preferences;
++
++=head1 NAME
++
++Youri::Check::Maintainer::Preferences - Abstract maintainer preferences
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Check::Maintainer::Preferences interface.
++
++=head1 SYNOPSIS
++
++    use Youri::Check::Maintainer::Preferences::Foo;
++
++    my $preferences = Youri::Check::Maintainer::Preferences::Foo->new();
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Maintainer::Preferences object.
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        test    => 0,     # test mode
++        verbose => 0,     # verbose mode
++        @_
++    );
++
++    my $self = bless {
++        _test    => $options{test},
++        _verbose => $options{verbose},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head2 get_preference($maintainer, $plugin, $item)
++
++Returns preference of given maintainer for given plugin and configuration item.
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item get
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/Bugzilla.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/Bugzilla.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/Bugzilla.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,100 @@
++# $Id: Bugzilla.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Maintainer::Resolver::Bugzilla;
++
++=head1 NAME
++
++Youri::Check::Maintainer::Resolver::Bugzilla - Bugzilla-based maintainer resolver
++
++=head1 DESCRIPTION
++
++This is a Bugzilla-based L<Youri::Check::Maintainer::Resolver> implementation.
++
++It uses Bugzilla SQL database for resolving maintainers.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Bugzilla;
++use base 'Youri::Check::Maintainer::Resolver';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Maintainer::Resolver::Bugzilla object.
++
++Specific parameters:
++
++=over
++
++=item host $host
++
++Bugzilla database host.
++
++=item base $base
++
++Bugzilla database name.
++
++=item user $user
++
++Bugzilla database user.
++
++=item pass $pass
++
++Bugzilla database password.
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        host => '', # host of the bug database
++        base => '', # name of the bug database
++        user => '', # user of the bug database
++        pass => '', # pass of the bug database
++        @_
++    );
++
++    croak "No host given" unless $options{host};
++    croak "No base given" unless $options{base};
++    croak "No user given" unless $options{user};
++    croak "No pass given" unless $options{pass};
++
++    my $bugzilla = Youri::Bugzilla->new(
++        $options{host},
++        $options{base},
++        $options{user},
++        $options{pass}
++    );
++
++    $self->{_bugzilla} = $bugzilla;
++}
++
++sub get_maintainer {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++     my $name = ref $package && $package->isa('Youri::Package') ?
++        $package->get_canonical_name() :
++        $package;
++
++    $self->{_maintainers}->{$name} =
++        $self->{_bugzilla}->get_maintainer($name)
++        unless exists $self->{_maintainers}->{$name};
++
++    return $self->{_maintainers}->{$name};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/CGI.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/CGI.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver/CGI.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,79 @@
++# $Id: CGI.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Maintainer::Resolver::CGI;
++
++=head1 NAME
++
++Youri::Check::Maintainer::Resolver::CGI - CGI-based maintainer resolver
++
++=head1 DESCRIPTION
++
++This is a CGI-based L<Youri::Check::Maintainer::Resolver> implementation.
++
++It uses a remote CGI to resolve maintainers.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Maintainer::Resolver';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Maintainer::Resolver::CGI object.
++
++Specific parameters:
++
++=over
++
++=item url $url
++
++CGI's URL.
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        url => '', # url to fetch maintainers
++        @_
++    );
++
++    croak "No URL given" unless $options{url};
++
++    open (INPUT, "GET $options{url} |");
++    while (<INPUT>) {
++        chomp;
++        my ($package, $maintainer) = split(/\t/, $_);
++        $self->{_maintainers}->{$package} = $maintainer if $maintainer;
++    }
++    close(INPUT);
++}
++
++sub get_maintainer {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    print "Retrieving package $package maintainer\n"
++        if $self->{_verbose} > 0;
++
++    my $name = ref $package && $package->isa('Youri::Package') ?
++        $package->get_canonical_name() :
++        $package;
++
++    return $self->{_maintainers}->{$name};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Maintainer/Resolver.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,86 @@
++# $Id: Resolver.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Maintainer::Resolver;
++
++=head1 NAME
++
++Youri::Check::Maintainer::Resolver - Abstract maintainer resolver
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Check::Maintainer::Resolver interface.
++
++=head1 SYNOPSIS
++
++    use Youri::Check::Maintainer::Resolver::Foo;
++
++    my $resolver = Youri::Check::Maintainer::Resolver::Foo->new();
++
++    print $resolver->get_maintainer('foo');
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Utils;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Maintainer::Resolver object.
++
++No generic parameters (subclasses may define additional ones).
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        test    => 0,  # test mode
++        verbose => 0,  # verbose mode
++        @_
++    );
++
++    my $self = bless {
++        _test    => $options{test},
++        _verbose => $options{verbose}
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head2 get_maintainer($package)
++
++Returns maintainer for given package, which can be either a full
++L<Youri::Package> object or just a package name.
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item get_maintainer
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/HTML.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/HTML.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/HTML.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,222 @@
++# $Id: HTML.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Output::File::Format::HTML;
++
++=head1 NAME
++
++Youri::Check::Output::File::Format::HTML - File HTML format support
++
++=head1 DESCRIPTION
++
++This format plugin for L<Youri::Check::Output::File> provides HTML format
++support.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use CGI;
++use base 'Youri::Check::Output::File::Format';
++
++sub extension {
++    return 'html';
++}
++
++sub _init {
++    my $self = shift;
++    my %options = (
++        style => <<EOF, # css style
++h1 {
++    text-align:center;
++}
++table {
++    border-style:solid; 
++    border-width:1px; 
++    border-color:black;
++    width:100%;
++}
++tr.odd { 
++    background-color:white;
++}
++tr.even { 
++    background-color:silver;
++}
++p.footer {
++    font-size:smaller;
++    text-align:center;
++}
++EOF
++        @_
++    );
++
++    $self->{_style} = $options{style};
++    $self->{_cgi}   = CGI->new();
++}
++
++sub get_report {
++    my ($self, $time, $title, $iterator, $type, $columns, $links, $maintainer) = @_;
++
++    my $content;
++    my $lead_columns = [ 
++        $maintainer ?
++            qw/package media/ :
++            qw/package media maintainer/
++        ];
++    my $line;
++    my @results;
++    $content .= $self->{_cgi}->start_table();
++    $content .= $self->{_cgi}->Tr([
++        $self->{_cgi}->th([ 
++            @$lead_columns,
++            @$columns
++        ])
++    ]);
++    while (my $result = $iterator->get_result()) {
++        if (@results && $result->{package} ne $results[0]->{package}) {
++            $content .= $self->_get_formated_results(
++                $lead_columns,
++                $columns,
++                $links,
++                $line++ % 2 ? 'odd' : 'even',
++                \@results
++            );
++            @results = ();
++        }
++        push(@results, $result);
++    }
++    $content .= $self->_get_formated_results(
++        $lead_columns,
++        $columns,
++        $links,
++        $line++ % 2 ? 'odd' : 'even',
++        \@results
++    );
++    $content .= $self->{_cgi}->end_table();
++
++    return $self->_get_html_page($time, $title, \$content);
++}
++
++sub get_index {
++    my ($self, $time, $title, $reports, $maintainers) = @_;
++
++    my $content;
++
++    if ($reports) {
++        $content .= $self->{_cgi}->h2("Reports");
++        my @types = keys %{$reports};
++
++        $content .= $self->{_cgi}->start_ul();
++        foreach my $type (sort @types) {
++            my $item;
++            $item = $self->{_cgi}->a(
++                { href => "$type.html" },
++                $type
++            );
++            foreach my $extension (@{$reports->{$type}}) {
++                next if ($extension eq extension());
++                $item .= " ".$self->{_cgi}->a(
++                        { href => "$type.$extension" },
++                        "[$extension]"
++                );
++            }
++            $content .= $self->{_cgi}->li($item);
++        }
++        $content .= $self->{_cgi}->end_ul();
++    }
++
++    if ($maintainers) {
++        $content .= $self->{_cgi}->h2("Individual reports");
++
++        $content .= $self->{_cgi}->start_ul();
++        foreach my $maintainer (sort @{$maintainers}) {
++            $content .= $self->{_cgi}->li(
++                $self->{_cgi}->a(
++                    { href => "$maintainer/index.html" },
++                    _obfuscate($maintainer)
++                )
++            );
++        }
++        $content .= $self->{_cgi}->end_ul();
++    }
++
++    return $self->_get_html_page($time, $title, \$content);
++}
++
++sub _get_formated_results {
++    my ($self, $lead_columns, $columns, $links, $class, $results) = @_;
++
++    my $content;
++    $content .= $self->{_cgi}->end_Tr();
++    for my $i (0 .. $#$results) {
++        $content .= $self->{_cgi}->start_Tr(
++            { class => $class }
++        );
++        if ($i == 0) {
++            # first line contains spanned cells
++            $content .= $self->{_cgi}->td(
++                { rowspan => scalar @$results },
++                [
++                    map { $results->[$i]->{$_} }
++                    @$lead_columns
++                ]
++            );
++        }
++        $content .= $self->{_cgi}->td(
++            [ 
++                map { 
++                    $links->{$_} && $results->[$i]->{$links->{$_}} ?
++                        $self->{_cgi}->a(
++                            { href => $results->[$i]->{$links->{$_}} },
++                            $self->{_cgi}->escapeHTML($results->[$i]->{$_})
++                        ) :
++                        $self->{_cgi}->escapeHTML($results->[$i]->{$_})
++                } @$columns
++            ]
++        );
++        $content .= $self->{_cgi}->end_Tr();
++    }
++
++    return $content;
++}
++
++
++sub _get_html_page {
++    my ($self, $time, $title, $body) = @_;
++
++    my $content;
++    $content .= $self->{_cgi}->start_html(
++        -title => $title,
++        -style => { code => $self->{_style} }
++    );
++    $content .= $self->{_cgi}->h1($title);
++    $content .= $$body;
++    $content .= $self->{_cgi}->hr();
++    $content .= $self->{_cgi}->p(
++        { class => 'footer' },
++        "Page generated $time"
++    );
++    $content .= $self->{_cgi}->end_html();
++
++    return \$content;
++}
++
++sub _obfuscate {
++    my ($email) = @_;
++
++    return unless $email;
++
++    $email =~ s/\@/ at /;
++    $email =~ s/\./ dot /;
++
++    return $email;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/RSS.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/RSS.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/RSS.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,68 @@
++# $Id$
++package Youri::Check::Output::File::Format::RSS;
++
++=head1 NAME
++
++Youri::Check::Output::File::Format::RSS - File RSS format support
++
++=head1 DESCRIPTION
++
++This format plugin for L<Youri::Check::Output::File> provides RSS format
++support.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use XML::RSS;
++use base 'Youri::Check::Output::File::Format';
++
++sub extension {
++    return 'rss';
++}
++
++sub get_report {
++    my ($self, $time, $title, $iterator, $type, $columns, $links, $maintainer) = @_;
++
++    return unless $maintainer;
++
++    my $rss = new XML::RSS (version => '2.0');
++    $rss->channel(
++        title       => $title,
++        description => $title,
++        language    => 'en',
++        ttl         => 1440
++    );
++
++    while (my $result = $iterator->get_result()) {
++        if ($type eq 'updates') {
++            $rss->add_item(
++                title       => "$result->{package} $result->{available} is available",
++                description => "Current version is $result->{current}",
++                link        => $result->{url} ?
++                    $result->{url} : $result->{source},
++                guid => "$result->{package}-$result->{available}"
++            );
++        } else {
++            $rss->add_item(
++                title       => "[$type] $result->{package}",
++                description => join("\n", (map { $result->{$_} || '' } @$columns)),
++		link        => $result->{url},
++                guid        => "$type-$result->{package}"
++            );
++        }
++    }
++
++    return \$rss->as_string();
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/Text.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/Text.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format/Text.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,88 @@
++# $Id: Text.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Output::File::Format::Text;
++
++=head1 NAME
++
++Youri::Check::Output::File::Format::Text - File text format support
++
++=head1 DESCRIPTION
++
++This format plugin for L<Youri::Check::Output::File> provides text format
++support.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Output::File::Format';
++
++sub extension {
++    return 'txt';
++}
++
++sub get_report {
++    my ($self, $time, $title, $iterator, $type, $columns, $links, $maintainer) = @_;
++    
++    my $content;
++    $content .= $title;
++    $content .= "\n";
++
++    my $lead_columns = [ 
++        $maintainer ?
++            qw/package media/ :
++            qw/package media maintainer/
++        ];
++    my @results;
++    $content .= join("\t", @$lead_columns, @$columns) . "\n";
++    while (my $result = $iterator->get_result()) {
++        if (@results && $result->{package} ne $results[0]->{package}) {
++            $content .= $self->_get_formated_results(
++                $lead_columns,
++                $columns,
++                \@results
++            );
++            @results = ();
++        }
++        push(@results, $result);
++    }
++    $content .= $self->_get_formated_results(
++        $lead_columns,
++        $columns,
++        \@results
++    );
++
++    $content .= "\n";
++    $content .= "Page generated $time\n";
++
++    return \$content;
++}
++
++sub _get_formated_results {
++    my ($self, $lead_columns, $columns, $results) = @_;
++
++    my $content;
++    $content .= join(
++        "\t",
++        (map { $results->[0]->{$_} || '' } @$lead_columns),
++        (map { $results->[0]->{$_} || '' } @$columns)
++    ) . "\n";
++    for my $i (1 .. $#$results) {
++        $content .= join(
++            "\t",
++            (map { '' } @$lead_columns),
++            (map { $results->[$i]->{$_} || '' } @$columns)
++        ) . "\n";
++    }
++    return $content;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File/Format.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,66 @@
++# $Id: Base.pm 579 2006-01-09 21:17:54Z guillomovitch $
++package Youri::Check::Output::File::Format;
++
++=head1 NAME
++
++Youri::Check::Output::File::Format - Abstract file format support
++
++=head1 DESCRIPTION
++
++This abstract class defines the format support interface for
++L<Youri::Check::Output::File>.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id      => '',
++        test    => 0,
++        verbose => 0,
++        @_
++    );
++
++    my $self = bless {
++        _id         => $options{id},
++        _test       => $options{test},
++        _verbose    => $options{verbose},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head2 get_id()
++
++Returns format handler identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/File.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,203 @@
++# $Id: Text.pm 523 2005-10-11 08:36:49Z misc $
++package Youri::Check::Output::File;
++
++=head1 NAME
++
++Youri::Check::Output::File - Report results in files
++
++=head1 DESCRIPTION
++
++This plugin reports results in files. Additional subplugins handle specific
++formats.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use File::Basename;
++use File::Path;
++use DateTime;
++use Youri::Utils;
++use base 'Youri::Check::Output';
++
++sub _init {
++    my $self = shift;
++    my %options = (
++        to      => '', # target directory
++        noclean => 0,  # don't clean up target directory
++        noempty => 0,  # don't generate empty reports
++        formats => undef,
++        @_
++    );
++
++    croak "no format defined" unless $options{formats};
++    croak "formats should be an hashref" unless ref $options{formats} eq 'HASH';
++
++    my $now = DateTime->now(time_zone => 'local');
++    my $time = "the " . $now->ymd() . " at " . $now->hms();
++
++    $self->{_to}      = $options{to};
++    $self->{_noclean} = $options{noclean};
++    $self->{_noempty} = $options{noempty};
++    $self->{_time}    = $time;
++
++    foreach my $id (keys %{$options{formats}}) {
++        print "Creating format $id\n" if $options{verbose};
++        eval {
++            push(
++                @{$self->{_formats}},
++                create_instance(
++                    'Youri::Check::Output::File::Format',
++                    id        => $id,
++                    test      => $options{test},
++                    verbose   => $options{verbose},
++                    %{$options{formats}->{$id}}
++                )
++            );
++        };
++        print STDERR "Failed to create format $id: $@\n" if $@;
++    }
++
++    croak "no formats created" unless @{$self->{_formats}};
++}
++
++sub _init_report {
++    my ($self) = @_;
++
++    # clean up output directory
++    unless ($self->{_test} || $self->{_noclean} || !$self->{_to}) {
++        my @files = glob($self->{_to} . '/*');
++        rmtree(\@files) if @files;
++    }
++}
++
++sub _global_report {
++    my ($self, $resultset, $type, $columns, $links) = @_;
++
++    foreach my $format (@{$self->{_formats}}) {
++        my $iterator = $resultset->get_iterator(
++            $type,
++            [ 'package' ]
++        );
++
++        return if $self->{_noempty} && ! $iterator->has_results();
++
++        my $content = $format->get_report(
++            $self->{_time},
++            "$type global report",
++            $iterator,
++            $type,
++            $columns,
++            $links,
++            undef
++        );
++
++        # create and register file
++        my $extension = $format->extension();
++        $self->_write_file(
++            "$self->{_to}/$type.$extension",
++            $content
++        );
++        push(
++            @{$self->{_files}->{global}->{$type}},
++            $extension
++        );
++    }
++}
++
++sub _individual_report {
++    my ($self, $resultset, $type, $columns, $links, $maintainer) = @_;
++
++    foreach my $format (@{$self->{_formats}}) {
++        my $iterator = $resultset->get_iterator(
++            $type,
++            [ 'package' ],
++            { maintainer => [ $maintainer ] }
++        );
++
++        return if $self->{_noempty} && ! $iterator->has_results();
++
++        my $content = $format->get_report(
++            $self->{_time},
++            "$type individual report for $maintainer",
++            $iterator,
++            $type,
++            $columns,
++            $links,
++            $maintainer
++        );
++
++        # create and register file
++        my $extension = $format->extension();
++        $self->_write_file(
++            "$self->{_to}/$maintainer/$type.$extension",
++            $content
++        );
++        push(
++            @{$self->{_files}->{maintainers}->{$maintainer}->{$type}},
++            $extension
++        );
++    }
++}
++
++sub _finish_report {
++    my ($self, $types, $maintainers) = @_;
++
++    foreach my $format (@{$self->{_formats}}) {
++        next unless $format->can('get_index');
++        my $extension = $format->extension();
++        print STDERR "writing global index page\n" if $self->{_verbose};
++        $self->_write_file(
++            "$self->{_to}/index.$extension",
++            $format->get_index(
++                $self->{_time},
++                "QA global report",
++                $self->{_files}->{global},
++                [ keys %{$self->{_files}->{maintainers}} ],
++            )
++        );
++        foreach my $maintainer (@$maintainers) {
++            print STDERR "writing index page for $maintainer\n" if $self->{_verbose};
++
++            $self->_write_file(
++                "$self->{_to}/$maintainer/index.$extension",
++                $format->get_index(
++                    $self->{_time},
++                    "QA report for $maintainer",
++                    $self->{_files}->{maintainers}->{$maintainer},
++                    undef,
++                )
++            );
++        }
++    }
++}
++
++sub _write_file {
++    my ($self, $file, $content) = @_;
++
++    return unless $content;
++
++    my $dirname = dirname($file);
++    mkpath($dirname) unless -d $dirname;
++    
++    if ($self->{_test}) {
++        *OUT = *STDOUT;
++    } else {
++        open(OUT, ">$file") or die "Can't open file $file: $!";
++    }
++
++    print OUT $$content;
++
++    close(OUT) unless $self->{_test};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/HTML.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/HTML.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/HTML.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,158 @@
++# $Id: Mail.pm 580 2006-01-11 22:59:36Z guillomovitch $
++package Youri::Check::Output::Mail::Format::HTML;
++
++=head1 NAME
++
++Youri::Check::Output::Mail::Format::HTML - Mail HTML format support
++
++=head1 DESCRIPTION
++
++This format plugin for L<Youri::Check::Output::Mail> provides HTML format
++support.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use CGI;
++use base 'Youri::Check::Output::Mail::Format';
++
++sub type {
++    return 'text/html';
++}
++
++sub _init {
++    my $self = shift;
++    my %options = (
++        style => <<EOF, # css style
++h1 {
++    text-align:center;
++}
++table {
++    border-style:solid; 
++    border-width:1px; 
++    border-color:black;
++    width:100%;
++}
++tr.odd { 
++    background-color:white;
++}
++tr.even { 
++    background-color:silver;
++}
++p.footer {
++    font-size:smaller;
++    text-align:center;
++}
++EOF
++        @_
++    );
++
++    $self->{_style} = $options{style};
++    $self->{_cgi}   = CGI->new();
++}
++
++sub get_report {
++    my ($self, $time, $title, $iterator, $type, $columns, $links, $maintainer) = @_;
++
++    my $body;
++    my $lead_columns = [ 
++        $maintainer ?
++            qw/package media/ :
++            qw/package media maintainer/
++    ];
++    my $line;
++    my @results;
++    $body .= $self->{_cgi}->start_table();
++    $body .= $self->{_cgi}->Tr([
++        $self->{_cgi}->th([ 
++            @$lead_columns,
++            @$columns
++        ])
++    ]);
++    while (my $result = $iterator->get_result()) {
++        if (@results && $result->{package} ne $results[0]->{package}) {
++            $body .= $self->_get_formated_results(
++                $lead_columns,
++                $columns,
++                $links,
++                $line++ % 2 ? 'odd' : 'even',
++                \@results
++            );
++            @results = ();
++        }
++        push(@results, $result);
++    }
++    $body .= $self->_get_formated_results(
++        $lead_columns,
++        $columns,
++        $links,
++        $line++ % 2 ? 'odd' : 'even',
++        \@results
++    );
++    $body .= $self->{_cgi}->end_table();
++
++    my $content;
++    $content .= $self->{_cgi}->start_html(
++        -title => $title,
++        -style => { code => $self->{_style} }
++    );
++    $content .= $self->{_cgi}->h1($title);
++    $content .= $body;
++    $content .= $self->{_cgi}->hr();
++    $content .= $self->{_cgi}->p(
++        { class => 'footer' },
++        "Page generated $time"
++    );
++    $content .= $self->{_cgi}->end_html();
++
++    return \$content;
++}
++
++sub _get_formated_results {
++    my ($self, $lead_columns, $columns, $links, $class, $results) = @_;
++
++    my $content;
++    $content .= $self->{_cgi}->end_Tr();
++    for my $i (0 .. $#$results) {
++        $content .= $self->{_cgi}->start_Tr(
++            { class => $class }
++        );
++        if ($i == 0) {
++            # first line contains spanned cells
++            $content .= $self->{_cgi}->td(
++                { rowspan => scalar @$results },
++                [
++                    map { $results->[$i]->{$_} }
++                    @$lead_columns
++                ]
++            );
++        }
++        $content .= $self->{_cgi}->td(
++            [ 
++                map { 
++                    $links->{$_} && $results->[$i]->{$links->{$_}} ?
++                        $self->{_cgi}->a(
++                            { href => $results->[$i]->{$links->{$_}} },
++                            $self->{_cgi}->escapeHTML($results->[$i]->{$_})
++                        ) :
++                        $self->{_cgi}->escapeHTML($results->[$i]->{$_})
++                } @$columns
++            ]
++        );
++        $content .= $self->{_cgi}->end_Tr();
++    }
++
++    return $content;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/Text.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/Text.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format/Text.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,83 @@
++# $Id: Mail.pm 580 2006-01-11 22:59:36Z guillomovitch $
++package Youri::Check::Output::Mail::Format::Text;
++
++=head1 NAME
++
++Youri::Check::Output::Mail::Format::Text - Mail text format support
++
++=head1 DESCRIPTION
++
++This format plugin for L<Youri::Check::Output::Mail> provides text format
++support.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use base 'Youri::Check::Output::Mail::Format';
++
++sub type {
++    return 'text/plain';
++}
++
++sub get_report {
++    my ($self, $time, $title, $iterator, $type, $columns, $links, $maintainer) = @_;
++
++    my $content;
++    my $lead_columns = [ 
++        $maintainer ?
++            qw/package media/ :
++            qw/package media maintainer/
++        ];
++    my @results;
++    $content .= join("\t", @$lead_columns, @$columns) . "\n";
++    while (my $result = $iterator->get_result()) {
++        if (@results && $result->{package} ne $results[0]->{package}) {
++            $content .= $self->_get_formated_results(
++                $lead_columns,
++                $columns,
++                \@results
++            );
++            @results = ();
++        }
++        push(@results, $result);
++    }
++
++    $content .= $self->_get_formated_results(
++        $lead_columns,
++        $columns,
++        \@results
++    );
++
++    return \$content;
++}
++
++sub _get_formated_results {
++    my ($self, $lead_columns, $columns, $results) = @_;
++
++    my $content;
++    $content .= join(
++        "\t",
++        (map { $results->[0]->{$_} || '' } @$lead_columns),
++        (map { $results->[0]->{$_} || '' } @$columns)
++    ) . "\n";
++    for my $i (1 .. $#$results) {
++        $content .= join(
++            "\t",
++            (map { '' } @$lead_columns),
++            (map { $results->[$i]->{$_} || '' } @$columns)
++        ) . "\n";
++    }
++    return $content;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail/Format.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,66 @@
++# $Id: Base.pm 579 2006-01-09 21:17:54Z guillomovitch $
++package Youri::Check::Output::Mail::Format;
++
++=head1 NAME
++
++Youri::Check::Output::Mail::Format - Abstract mail format support
++
++=head1 DESCRIPTION
++
++This abstract class defines the format support interface for
++L<Youri::Check::Output::Mail>.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id      => '',
++        test    => 0,
++        verbose => 0,
++        @_
++    );
++
++    my $self = bless {
++        _id         => $options{id},
++        _test       => $options{test},
++        _verbose    => $options{verbose},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head2 get_id()
++
++Returns format handler identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output/Mail.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,156 @@
++# $Id: Mail.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Output::Mail;
++
++=head1 NAME
++
++Youri::Check::Output::Mail - Report results by mail
++
++=head1 DESCRIPTION
++
++This plugin reports results by mail. Additional subplugins handle specific
++formats.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use MIME::Entity;
++use Youri::Utils;
++use base 'Youri::Check::Output';
++
++sub _init {
++    my $self = shift;
++    my %options = (
++        from     => '', # mail from header
++        to       => '', # mail to header
++        reply_to => '', # mail reply-to header
++        mta      => '', # mta path
++        noempty  => 1,  # don't generate empty reports
++        formats  => {},
++        @_
++    );
++
++    croak "no format defined" unless $options{formats};
++    croak "formats should be an hashref" unless ref $options{formats} eq 'HASH';
++
++    $self->{_from}       = $options{from};
++    $self->{_to}         = $options{to};
++    $self->{_reply_to}   = $options{reply_to};
++    $self->{_mta}        = $options{mta};
++    $self->{_noempty}    = $options{noempty};
++
++    foreach my $id (keys %{$options{formats}}) {
++        print "Creating format $id\n" if $options{verbose};
++        eval {
++            push(
++                @{$self->{_formats}},
++                create_instance(
++                    'Youri::Check::Output::Mail::Format',
++                    id        => $id,
++                    test      => $options{test},
++                    verbose   => $options{verbose},
++                    %{$options{formats}->{$id}}
++                )
++            );
++        };
++        print STDERR "Failed to create format $id: $@\n" if $@;
++    }
++
++    croak "no formats created" unless @{$self->{_formats}};
++}
++
++sub _global_report {
++    my ($self, $resultset, $type, $columns, $links) = @_;
++
++    foreach my $format (@{$self->{_formats}}) {
++        my $iterator = $resultset->get_iterator(
++            $type,
++            [ 'package' ]
++        );
++
++        return if $self->{_noempty} && ! $iterator->has_results();
++
++        my $content = $format->get_report(
++            $self->{_time},
++            "$type global report",
++            $iterator,
++            $type,
++            $columns,
++            $links,
++            undef
++        );
++
++        $self->_send_mail(
++            $format->type(),
++            $self->{_to},
++            "$type global report",
++            $content,
++        );
++    }
++}
++
++sub _individual_report {
++    my ($self, $resultset, $type, $columns, $links, $maintainer) = @_;
++
++    foreach my $format (@{$self->{_formats}}) {
++        my $iterator = $resultset->get_iterator(
++            $type,
++            [ 'package' ],
++            { maintainer => [ $maintainer ] }
++        );
++
++        return if $self->{_noempty} && ! $iterator->has_results();
++
++        my $content = $format->get_report(
++            $self->{_time},
++            "$type individual report for $maintainer",
++            $iterator,
++            $type,
++            $columns,
++            $links,
++            $maintainer
++        );
++
++        $self->_send_mail(
++            $format->type(),
++            $maintainer,
++            "$type individual report for $maintainer",
++            $content,
++        );
++    }
++
++}
++
++sub _send_mail {
++    my ($self, $type, $to, $subject, $content) = @_;
++
++    return unless $content;
++
++    my $mail = MIME::Entity->build(
++        'Type'     => $type,
++        'From'     => $self->{_from},
++        'Reply-To' => $self->{_reply_to},
++        'To'       => $to,
++        'Subject'  => $subject,
++        'Data'     => $$content
++    );
++
++    if ($self->{_test}) {
++        $mail->print(\*STDOUT);
++    } else {
++        open(MAIL, "| $self->{_mta} -t -oi -oem") or die "Can't open MTA program: $!";
++        $mail->print(\*MAIL);
++        close MAIL;
++    }
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Output.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Output.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Output.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,190 @@
++# $Id: Output.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Check::Output;
++
++=head1 NAME
++
++Youri::Check::Output - Abstract output plugin
++
++=head1 DESCRIPTION
++
++This abstract class defines output plugin interface.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Youri::Utils;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Check::Output object.
++
++Generic parameters (subclasses may define additional ones):
++
++=over
++
++=item global true/false
++
++Global reports generation (default: true).
++
++=item individual true/false
++
++Individual reports generation (default: true).
++
++=back
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        id         => '',
++        test       => 0,
++        verbose    => 0,
++        global     => 1,
++        individual => 1,
++        config     => undef,
++        @_
++    );
++
++    croak "Neither global nor individual reporting selected" unless $options{global} || $options{individual};
++
++    my $self = bless {
++        _id         => $options{id},
++        _test       => $options{test},
++        _verbose    => $options{verbose},
++        _global     => $options{global},
++        _individual => $options{individual},
++        _config     => $options{config}
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 get_id()
++
++Returns plugin identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=head2 run($resultset)
++
++Reports the result stored in given L<Youri::Check::Resultset> object.
++
++=cut
++
++sub run {
++    my ($self, $resultset) = @_;
++
++    $self->_init_report();
++
++    # get types and maintainers list from resultset
++    my @maintainers = $resultset->get_maintainers();
++    my @types       = $resultset->get_types();
++
++    foreach my $type (@types) {
++        # get formatting instructions from class
++        my $class = $self->{_config}->get($type . '_class');
++        load($class);
++        my @columns = $class->columns();
++        my %links   = $class->links();
++
++        if ($self->{_global}) {
++            print STDERR "generating global report for $type\n" if $self->{_verbose};
++            $self->_global_report(
++                $resultset,
++                $type,
++                \@columns,
++                \%links
++            );
++        }
++
++        if ($self->{_individual}) {
++            foreach my $maintainer (@maintainers) {
++                print STDERR "generating individual report for $type and $maintainer\n" if $self->{_verbose};
++
++                $self->_individual_report(
++                    $resultset,
++                    $type,
++                    \@columns,
++                    \%links,
++                    $maintainer
++                );
++            }
++        }
++    }
++
++    $self->_finish_report(\@types, \@maintainers);
++}
++
++sub _init_report {
++    # do nothing
++}
++
++sub _global_report {
++    # do nothing
++}
++
++sub _individual_report {
++    # do nothing
++}
++
++sub _finish_report {
++    # do nothing
++}
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item run
++
++As an alternative, the following hooks can be implemented:
++
++=over
++
++=item _init_report
++
++=item _global_report
++
++=item _individual_report
++
++=item _finish_report
++
++=back
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/DBI.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/DBI.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/DBI.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,372 @@
++# $Id: Result.pm 485 2005-08-01 21:48:21Z guillomovitch $
++package Youri::Check::Resultset::DBI;
++
++=head1 NAME
++
++Youri::Check::Resultset::DBI - DBI-based resultset
++
++=head1 DESCRIPTION
++
++This is a DBI-based L<Youri::Check::Resultset> implementation.
++
++It can be created with any DBI-supported database.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use DBI 1.38;
++use base 'Youri::Check::Resultset';
++
++my %tables = (
++    packages => {
++        id         => 'SERIAL PRIMARY KEY',
++        package    => 'TEXT',
++        media      => 'TEXT',
++        maintainer => 'TEXT',
++    }
++);
++
++my %queries = (
++    add_package =>
++        'INSERT INTO packages (package, media, maintainer) VALUES (?, ?, ?)',
++    get_package_id =>
++        'SELECT id FROM packages WHERE package = ?',
++    get_maintainers =>
++        'SELECT DISTINCT(maintainer) FROM packages WHERE maintainer IS NOT NULL',
++);
++
++=head1 CLASS METHODS
++
++=head2 new(%hash)
++
++Creates and returns a new Youri::Check::Resultset::DBI object.
++
++Specific parameters:
++
++=over
++
++=item driver $driver
++
++Use given string as DBI driver.
++
++=item base $base
++
++Use given string as database name.
++
++=item port $port
++
++Use given string as database port.
++
++=item user $user
++
++Use given string as database user.
++
++=item pass $pass
++
++Use given string as database password.
++
++=back
++
++=cut
++
++sub _init {
++    my $self    = shift;
++    my %options = (
++        driver => '', # driver
++        base   => '', # base
++        port   => '', # port
++        user   => '', # user
++        pass   => '', # pass
++        @_
++    );
++
++    croak "No driver defined" unless $options{driver};
++    croak "No base defined" unless $options{base};
++
++    my $datasource = "DBI:$options{driver}:dbname=$options{base}";
++    $datasource .= ";host=$options{host}" if $options{host};
++    $datasource .= ";port=$options{port}" if $options{port};
++
++    $self->{_dbh} = DBI->connect($datasource, $options{user}, $options{pass}, {
++        RaiseError => 1,
++        PrintError => 0,
++        AutoCommit => 1
++    }) or croak "Unable to connect: $DBI::errstr";
++
++   $self->{_dbh}->trace($options{verbose} - 1) if $options{verbose} > 1;
++}
++
++sub clone {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $clone = bless {
++        _test     => $self->{_test},
++        _verbose  => $self->{_verbose},
++        _resolver => $self->{_resolver},
++        _dbh      => $self->{_dbh}->clone()
++    }, ref $self;
++
++    return $clone;
++}
++
++sub reset {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    foreach my $table ($self->_get_tables()) {
++        my $query = "DROP TABLE $table";
++        $self->{_dbh}->do($query); 
++    }
++
++    foreach my $table (keys %tables) {
++        $self->_create_table($table, $tables{$table});
++    }
++}
++
++sub _get_tables {
++    my ($self) = @_;
++    my @tables = $self->{_dbh}->tables(undef, undef, '%', 'TABLE');
++    # unquote table name if needed
++    my $char = $self->{_dbh}->get_info(29);
++    @tables = map { substr($_, 1 , -1) } @tables if $char;
++    return @tables;
++}
++
++sub _get_columns {
++    my ($self, $table) = @_;
++    # proper way would be to use column_info(), but unfortunatly DBD::SQLite 
++    # doesn't support it :(
++    return 
++        keys
++        %{$self->{_dbh}->selectrow_hashref("SELECT * from $table")};
++}
++
++sub _create_table {
++    my ($self, $name, $fields) = @_;
++
++    my $query = "CREATE TABLE $name (" .
++        join(',',
++            map { "$_ $fields->{$_}" }
++            keys %$fields
++        ) .
++        ")";
++    $self->{_dbh}->do($query);
++}
++
++sub add_result {
++    my ($self, $type, $media, $package, $values) = @_;
++    croak "Not a class method" unless ref $self;
++    croak "No type defined" unless $type;
++    croak "No package defined" unless $package;
++    croak "No values defined" unless $values;
++
++    my $key = "add_$type";
++    my $sth = $self->{_sths}->{$key};
++
++    unless ($sth) {
++        my @fields = keys %$values;
++        $self->_create_table($type, {
++            'package_id' => 'INT',
++            map { $_ => 'TEXT' } @fields
++        });
++        my $query = "INSERT INTO $type (" .
++           join(',', 'package_id', @fields) .
++          ") VALUES (" .
++           join(',', '?', map { '?' } @fields) .
++          ")";
++        $sth = $self->{_dbh}->prepare($query);
++        $self->{_sths}->{$key} = $sth;
++    }
++
++    print "adding result for type $type and package $package\n"
++        if $self->{_verbose} > 0;
++
++    $sth->execute(
++        $self->_get_package_id(
++            $package->get_canonical_name(),
++            $media->get_name(),
++        ),
++        values %$values
++    );
++}
++
++sub get_types {
++    my ($self) = @_;
++
++    return
++        grep { ! $tables{$_} }
++        $self->_get_tables();
++}
++
++sub get_maintainers {
++    my ($self) = @_;
++
++    return $self->_get_multiple_values('get_maintainers');
++}
++
++sub get_iterator {
++    my ($self, $id, $sort, $filter) = @_;
++
++    die 'No id given, aborting'
++        unless $id;
++    die 'sort should be an arrayref'
++        if $sort and ref $sort ne 'ARRAY';
++    die 'filter should be an hashref'
++        if $filter and ref $filter ne 'HASH';
++        
++    my $query = $self->_get_iterator_query($id, $sort, $filter);
++
++    my $sth = $self->{_dbh}->prepare($query);
++    $sth->execute();
++
++    return Youri::Check::Resultset::DBI::Iterator->new($sth);
++}
++
++sub _get_iterator_query {
++    my ($self, $table, $sort, $filter) = @_;
++
++    my @fields =
++        grep { ! /package_id/ }
++        $self->_get_columns($table);
++
++    my $query = "SELECT DISTINCT " .
++        join(',', qw/package media maintainer/, @fields) .
++        " FROM $table, packages" .
++        " WHERE packages.id = $table.package_id";
++
++    if ($filter) {
++        foreach my $column (keys %{$filter}) {
++            foreach my $value (@{$filter->{$column}}) {
++                $query .= " AND $column = " . $self->{_dbh}->quote($value);
++            }
++        }
++    }
++
++    if ($sort) {
++        $query .= " ORDER BY " . join(', ', @{$sort});
++    }
++
++    return $query;
++}
++
++sub _get_package_id {
++    my ($self, $package, $media) = @_;
++
++    my $id = $self->_get_single_value(
++        'get_package_id',
++        $package
++    );
++    $id = $self->_add_package($package, $media) unless $id;
++
++    return $id;
++}
++
++sub _add_package {
++    my ($self, $package, $media) = @_;
++
++    my $maintainer = $self->{_resolver} ? 
++        $self->{_resolver}->get_maintainer($package) :
++        undef;
++
++    my $sth =
++        $self->{_sths}->{add_package} ||=
++        $self->{_dbh}->prepare($queries{add_package});
++
++    $sth->execute(
++        $package,
++        $media,
++        $maintainer
++    );
++
++    my $id = $self->{_dbh}->last_insert_id(undef, undef, 'packages', 'id');
++
++    return $id;
++}
++
++sub _get_single_value {
++    my ($self, $query, @values) = @_;
++
++    my $sth =
++        $self->{_sths}->{$query} ||=
++        $self->{_dbh}->prepare($queries{$query});
++
++    $sth->execute(@values);
++
++    my @row = $sth->fetchrow_array();
++    return @row ? $row[0]: undef;
++}
++
++sub _get_multiple_values {
++    my ($self, $query, @values) = @_;
++
++    my $sth =
++        $self->{_sths}->{$query} ||=
++        $self->{_dbh}->prepare($queries{$query});
++
++    $sth->execute(@values);
++
++    my @results;
++    while (my @row = $sth->fetchrow_array()) {
++        push @results, $row[0];
++    }
++    return @results;
++}
++
++# close database connection
++sub DESTROY {
++    my ($self) = @_;
++
++    foreach my $sth (values %{$self->{_sths}}) {
++        $sth->finish() if $sth;
++    }
++
++    # warning, may be called before _dbh is created
++    $self->{_dbh}->disconnect() if $self->{_dbh};
++}
++
++package Youri::Check::Resultset::DBI::Iterator;
++
++sub new {
++    my ($class, $sth) = @_;
++
++    my $self = bless {
++        _sth    => $sth,
++        _queue  => []
++    }, $class;
++
++    return $self;
++}
++
++sub has_results {
++    my ($self) = @_;
++
++    return 1 if @{$self->{_queue}};
++
++    push(
++        @{$self->{_queue}},
++        $self->{_sth}->fetchrow_hashref()
++    );
++    
++    return defined $self->{_queue}->[-1];
++}
++
++sub get_result {
++    my ($self) = @_;
++    
++    return @{$self->{_queue}} ?
++        shift @{$self->{_queue}}:
++        $self->{_sth}->fetchrow_hashref();
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/Iterator.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/Iterator.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset/Iterator.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,22 @@
++# $Id: Base.pm 483 2005-08-01 21:39:05Z guillomovitch $
++package Youri::Check::Resultset::Iterator;
++
++=head1 INSTANCE METHODS
++
++=head2 has_results()
++
++Returns true if results are available.
++
++=head2 get_result()
++
++Returns next available result, as an field => value hash reference.
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Check/Resultset.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,116 @@
++# $Id: Base.pm 483 2005-08-01 21:39:05Z guillomovitch $
++package Youri::Check::Resultset;
++
++=head1 NAME
++
++Youri::Check::Resultset - Abstract resultset
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Check::Resultset interface
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Scalar::Util qw/blessed/;
++use Youri::Utils;
++
++=head1 CLASS METHODS
++
++=head2 new(%hash)
++
++Creates and returns a new Youri::Check::Resultset object.
++
++No generic parameters (subclasses may define additional ones).
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class   = shift;
++    my %options = (
++        test     => 0,     # test mode
++        verbose  => 0,     # verbose mode
++        resolver => undef,  # maintainer resolver, 
++        mode     => 'output', # access mode
++        @_
++    );
++
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my $self = bless {
++        _test     => $options{test},
++        _verbose  => $options{verbose},
++        _resolver => $options{resolver},
++        _mode     => $options{mode}
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 set_resolver()
++
++Set L<Youri::Check::Maintainer::Resolver> object used to resolve package
++maintainers.
++
++=cut
++
++sub set_resolver {
++    my ($self, $resolver) = @_;
++    croak "Not a class method" unless ref $self;
++
++    croak "resolver should be a Youri::Check::Maintainer::Resolver object"
++        unless blessed $resolver &&
++        $resolver->isa("Youri::Check::Maintainer::Resolver");
++
++    $self->{_resolver} = $resolver;
++}
++
++=head2 clone()
++
++Clone resultset object.
++
++=head2 reset()
++
++Reset resultset object, by deleting all contained results.
++
++=head2 add_result($type, $media, $package, $values)
++
++Add given hash reference as a new result for given type and L<Youri::Package> object.
++
++=head2 get_maintainers()
++
++Returns the list of all maintainers with results.
++
++=head2 get_iterator($id, $sort, $filter)
++
++Returns a L<Youri::Check::Resultset::Iterator> object over results for given input it, with optional sort and filter directives.
++
++sort must be an arrayref of column names, such as [ 'package' ].
++
++filter must be a hashref of arrayref of acceptables values indexed by column names, such as { level => [ 'warning', 'error'] }.
++
++=head1 SUBCLASSING
++
++All instances methods have to be implemented.
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Config.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Config.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Config.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,202 @@
++# $Id: Config.pm 1709 2006-10-16 16:33:43Z warly $
++package Youri::Config;
++
++=head1 NAME
++
++Youri::Application - Youri application handler
++
++=head1 SYNOPSIS
++
++    use Youri::Application;
++
++    my $app = Youri::Application->new(
++        options => {
++            help => '|h!'
++        },
++        directories => [ '/etc/youri', "$ENV{HOME}/.youri" ],
++        file        => 'app.conf',
++    );
++
++    # get command line argument
++    my $foo = $app->get_arg('foo');
++
++    # get configuration file parameter
++    my $bar = $app->get_param('bar');
++
++=head1 DESCRIPTION
++
++This class handle configuration for all YOURI applications.
++
++The command line specification is used to manage arguments through
++Getopt::Long. Unless  B<--config> argument is given, the list of directories is
++then scanned for a file with given name, and halt as soon as it find one. If no
++readable file is found, an exception is thrown. The file is then processed
++through YAML::AppConfig. If parsing fails, an exception is thrown.
++
++=head1 CONFIGURATION FILE FORMAT
++
++=head2 SHARED KEYS
++
++In addition to the application-specific optional or mandatory parameters, all
++YOURI applications support the following optional top-level parameters:
++
++=over
++
++=item B<includes>
++
++A list of additional configuration files.
++
++=item B<foo>
++
++An arbitrary variable, usable everywhere else in the file.
++
++=back
++
++=head2 PLUGIN DEFINITION
++
++All YOURI application heavily rely on plugins defined in their configuration
++files. A plugin definition is composed from the following parameters:
++
++=over
++
++=item B<class>
++
++The class of this plugin.
++
++=item B<options>
++
++The options of this plugin.
++
++=back
++
++=head1 SEE ALSO
++
++YAML::AppConfig, Getopt::Long
++
++=cut
++
++use strict;
++use warnings;
++use YAML::AppConfig;
++use Getopt::Long;
++use File::Spec;
++use Pod::Usage;
++use Carp;
++
++sub new {
++    my ($class, %options) = @_;
++
++
++    # command line arguments
++    my $args = {
++        verbose => 0
++    };
++    my @args;
++    if ($options{args}) {
++        while (my ($arg, $spec) = each %{$options{args}}) {
++            push(@args, ($arg . $spec) => \$args->{$arg});
++        }
++    }
++    push(@args,
++        'config=s'   => \$args->{config},
++        'h|help'     => \$args->{help},
++        'v|verbose+' => \$args->{verbose}
++    );
++    GetOptions(@args);
++
++    if ($args->{help}) {
++        if (!@ARGV) {
++            # standard help, available immediatly
++            my $filename = (caller)[1];
++            pod2usage(
++                -input   => $filename,
++                -verbose => 0
++            );
++        }
++    }
++
++    # config files parameters
++    
++    # find configuration file to use
++    my $main_file;
++    if ($args->{config}) {
++        if (! -f $args->{config}) {
++            croak "Non-existing file $args->{config}";
++        } elsif (! -r $args->{config}) {
++            croak "Non-readable file $args->{config}";
++        } else {
++            $main_file = $args->{config};
++        }
++    } else {
++        foreach my $directory (@{$options{directories}}) {
++            my $file = "$directory/$options{file}";
++            next unless -f $file && -r $file;
++            $main_file = $file;
++            last;
++        }
++        croak 'No config file found, aborting' unless $main_file;
++    }
++
++    my $params;
++    eval {
++        $params = YAML::AppConfig->new(file => $main_file);
++    };
++    if ($@) {
++        croak "Invalid configuration file $main_file, aborting";
++    }
++
++    # process inclusions
++    my $includes = $params->get('includes');
++    if ($includes) {
++        foreach my $include_file (@{$includes}) {
++            # convert relative path to absolute ones
++            $include_file = File::Spec->rel2abs(
++                $include_file, (File::Spec->splitpath($main_file))[1]
++            );
++
++            if (! -f $include_file) {
++                warn "Non-existing file $include_file, skipping";
++            } elsif (! -r $include_file) {
++                warn "Non-readable file $include_file, skipping";
++            } else {
++                eval {
++                    $params->merge(file => $include_file);
++                };
++                if ($@) {
++                    carp "Invalid included configuration file $include_file, skipping";
++                }
++            }
++        }
++    }
++
++    my $self = bless {
++        _args   => $args,
++        _params => $params
++    }, $class;
++
++    return $self;
++}
++
++sub get_arg {
++    my ($self, $arg) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_args}->{$arg};
++}
++
++sub get_param {
++    my ($self, $param) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_params}->get($param);
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Media/URPM.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Media/URPM.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Media/URPM.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,273 @@
++# $Id: URPM.pm 1179 2006-08-05 08:30:57Z warly $
++package Youri::Media::URPM;
++
++=head1 NAME
++
++Youri::Media::URPM - URPM-based media implementation
++
++=head1 DESCRIPTION
++
++This is an URPM-based L<Youri::Media> implementation.
++
++It can be created either from local or remote full (hdlist) or partial
++(synthesis) compressed header files, or from a package directory. File-based
++inputs are only usable with this latest option.
++
++=cut
++
++use URPM;
++use File::Find;
++use File::Temp ();
++use Youri::Utils;
++use LWP::Simple;
++use Carp;
++use strict;
++use warnings;
++use Youri::Package::URPM;
++
++use base 'Youri::Media';
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Media::URPM object.
++
++Specific parameters:
++
++=over
++
++=item synthesis $synthesis
++
++Path, URL or list of path or URL of synthesis file used for creating
++this media. If a list is given, the first successfully accessed will be used,
++so as to allow better reliability.
++
++=item hdlist $hdlist
++
++Path, URL or list of path or URL of hdlist file used for creating
++this media. If a list is given, the first successfully accessed will be used,
++so as to allow better reliability.
++
++=item path $path
++
++Path or list of pathes of package directory used for creating this
++media. If a list is given, the first successfully accessed will be used, so as
++to allow better reliability.
++
++=item max_age $age
++
++Maximum age of packages for this media.
++
++=item rpmlint_config $file
++
++rpmlint configuration file for this media.
++
++=back
++
++In case of multiple B<synthesis>, B<hdlist> and B<path> options given, they
++will be tried in this order, so as to minimize parsing time.
++
++=cut
++
++sub _init {
++    my $self   = shift;
++
++    my %options = (
++        hdlist         => '',    # hdlist from which to create this media
++        synthesis      => '',    # synthesis from which to create this media
++        path           => '',    # directory from which to create this media
++        max_age        => '',    # maximum build age for packages
++        rpmlint_config => '',    # rpmlint configuration for packages
++        @_
++    );
++
++    my $urpm = URPM->new();
++    SOURCE: {
++        if ($options{synthesis}) {
++            foreach my $file (
++                ref $options{synthesis} eq 'ARRAY' ?
++                    @{$options{synthesis}} :
++                    $options{synthesis}
++            ) {
++                print "Attempting to retrieve synthesis $file\n"
++                    if $options{verbose};
++                my $synthesis = $self->_get_file($file);
++                if ($synthesis) {
++                    $urpm->parse_synthesis($synthesis, keep_all_tags => 1);
++                    last SOURCE;
++                }
++            }
++        }
++
++        if ($options{hdlist}) { 
++            foreach my $file (
++                ref $options{hdlist} eq 'ARRAY' ?
++                    @{$options{hdlist}} :
++                    $options{hdlist}
++            ) {
++                print "Attempting to retrieve hdlist $file\n"
++                    if $options{verbose};
++                my $hdlist = $self->_get_file($file);
++                if ($hdlist) {
++                    $urpm->parse_hdlist($hdlist, keep_all_tags => 1);
++                    last SOURCE;
++                }
++            }
++        }
++
++        if ($options{path}) {
++            foreach my $path (
++                ref $options{path} eq 'ARRAY' ?
++                    @{$options{path}} :
++                    $options{path}
++            ) {
++                print "Attempting to scan directory $path\n"
++                    if $options{verbose};
++                unless (-d $path) {
++                    carp "non-existing directory $path";
++                    next;
++                }
++                unless (-r $path) {
++                    carp "non-readable directory $path";
++                    next;
++                }
++
++                my $parse = sub {
++                    return unless -f $File::Find::name;
++                    return unless -r $File::Find::name;
++                    return unless /\.rpm$/;
++
++                    $urpm->parse_rpm($File::Find::name, keep_all_tags => 1);
++                };
++
++                find($parse, $path);
++                last SOURCE;
++            }
++        }
++        
++        croak "no source specified";
++    }
++
++    $self->{_urpm}           = $urpm;
++    $self->{_path}           = $options{path};
++    $self->{_max_age}        = $options{max_age};
++    $self->{_rpmlint_config} = $options{rpmlint_config};
++
++    return $self;
++}
++
++sub _remove_all_archs {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    $self->{_urpm}->{depslist} = [];
++}
++
++sub _remove_archs {
++    my ($self, $skip_archs) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $urpm = $self->{_urpm};
++    $urpm->{depslist} = [
++         grep { ! $skip_archs->{$_->arch()} } @{$urpm->{depslist}}
++    ];
++}
++
++=head1 INSTANCE METHODS
++
++=head2 max_age()
++
++Returns maximum age of packages for this media.
++
++=cut
++
++sub max_age {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_max_age};
++}
++
++=head2 rpmlint_config()
++
++Returns rpmlint configuration file for this media.
++
++=cut
++
++sub rpmlint_config {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_rpmlint_config};
++}
++
++sub get_package_class {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return "Youri::Package::URPM";
++}
++
++sub traverse_files {
++    my ($self, $function) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $callback = sub {
++        return unless -f $File::Find::name;
++        return unless -r $File::Find::name;
++        return unless $_ =~ /\.rpm$/;
++
++        my $package = Youri::Package::URPM->new(file => $File::Find::name);
++        return if $self->{_skip_archs}->{$package->get_arch()};
++
++        $function->($File::Find::name, $package);
++    };
++
++    find($callback, $self->{_path});
++}
++
++sub traverse_headers {
++    my ($self, $function) = @_;
++    croak "Not a class method" unless ref $self;
++
++    $self->{_urpm}->traverse(sub {
++        local $_; # workaround mysterious problem between URPM and AppConfig
++        $function->(Youri::Package::URPM->new(header => $_[0]));
++    });
++    
++}
++
++sub _get_file {
++    my ($self, $file) = @_;
++
++    if ($file =~ /^(?:http|ftp):\/\/.*$/) {
++        my $tempfile = File::Temp->new();
++        my $status = getstore($file, $tempfile->filename());
++        unless (is_success($status)) {
++            carp "invalid URL $file: $status";
++            return;
++        }
++        return $tempfile;
++    } else {
++        unless (-f $file) {
++            carp "non-existing file $file";
++            return;
++        }
++        unless (-r $file) {
++            carp "non-readable file $file";
++            return;
++        }
++        return $file;
++    }
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Media.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Media.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Media.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,311 @@
++# $Id: Media.pm 1710 2006-10-16 16:35:11Z warly $
++package Youri::Media;
++
++=head1 NAME
++
++Youri::Media - Abstract media class
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Media interface.
++
++=cut
++
++use Carp;
++use strict;
++use warnings;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Media object.
++
++Generic parameters:
++
++=over
++
++=item id $id
++
++Media id.
++
++=item name $name
++
++Media name.
++
++=item type $type (source/binary)
++
++Media type.
++
++=item test true/false
++
++Test mode (default: false).
++
++=item verbose true/false
++
++Verbose mode (default: false).
++
++=item allow_deps $media_ids
++
++list of ids of medias allowed to provide dependencies.
++
++=item skip_tests $test_ids
++
++list of ids of test plugins to skip.
++
++=item skip_archs $arches
++
++list of arches to skip.
++
++=back
++
++Subclass may define additional parameters.
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        name           => '',    # media name
++        canonical_name => '',    # media canonical name
++        type           => '',    # media type
++        test           => 0,     # test mode
++        verbose        => 0,     # verbose mode
++        allow_deps     => undef, # list of media ids from which deps are allowed
++        allow_srcs     => undef, # list of media ids from which packages can be built		
++        skip_tests    => undef, # list of tests ids to skip
++        skip_archs     => undef, # list of archs for which to skip tests
++        @_
++    );
++
++
++    croak "No type given" unless $options{type};
++    croak "Wrong value for type: $options{type}"
++        unless $options{type} =~ /^(?:binary|source)$/o;
++
++    # some options need to be arrays. Check it and convert to hashes
++    foreach my $option (qw(allow_deps allow_srcs skip_archs skip_tests)) {
++        next unless defined $options{$option};
++        croak "$option should be an arrayref" unless ref $options{$option} eq 'ARRAY';
++        $options{$option}  = {
++            map { $_ => 1 } @{$options{$option}}
++        };
++    }
++
++    my $self = bless {
++        _id             => $options{id}, 
++        _name           => $options{name} || $options{id}, 
++        _type           => $options{type}, 
++        _allow_deps     => $options{allow_deps}, 
++        _allow_srcs     => $options{allow_srcs},
++        _skip_archs     => $options{skip_archs},
++        _skip_tests    => $options{skip_tests},
++    }, $class;
++
++    $self->_init(%options);
++
++    # remove unwanted archs
++    if ($options{skip_archs}->{all}) {
++        $self->_remove_all_archs()
++    } elsif ($options{skip_archs}) {
++        $self->_remove_archs($options{skip_archs});
++    }
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 get_id()
++
++Returns media identity.
++
++=cut
++
++sub get_id {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_id};
++}
++
++=head2 get_name()
++
++Returns the name of this media.
++
++=cut
++
++sub get_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_name};
++}
++
++=head2 get_type()
++
++Returns the type of this media.
++
++=cut
++
++sub get_type {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_type};
++}
++
++=head2 allow_deps()
++
++Returns the list of id of medias allowed to provide dependencies for this
++media. 
++
++=cut
++
++sub allow_deps {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return keys %{$self->{_allow_deps}};
++}
++
++=head2 allow_dep($media_id)
++
++Tells wether media with given id is allowed to provide dependencies for
++this media.
++
++=cut
++
++sub allow_dep {
++    my ($self, $dep) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_allow_deps}->{all} ||
++        $self->{_allow_deps}->{$dep};
++}
++
++=head2 allow_srcs()
++
++Returns the list medias where the source packages can be
++
++=cut
++
++sub allow_srcs {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return keys %{$self->{_allow_srcs}};
++}
++
++=head2 allow_src($media_id)
++
++Tells wether media with given id is allowed to host sources dependencies for
++this media.
++
++=cut
++
++sub allow_src {
++    my ($self, $src) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_allow_srcs}->{all} || $self->{_allow_srcs}->{$src};
++}
++
++=head2 skip_archs()
++
++Returns the list of arch which are to be skipped for this media.
++
++=cut
++
++sub skip_archs {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return keys %{$self->{_skip_archs}};
++}
++
++=head2 skip_arch($arch)
++
++Tells wether given arch is to be skipped for this media.
++
++=cut
++
++sub skip_arch {
++    my ($self, $arch) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_skip_archs}->{all} ||
++        $self->{_skip_archs}->{$arch};
++}
++
++=head2 skip_tests()
++
++Returns the list of id of test which are to be skipped for this media.
++
++=cut
++
++sub skip_tests {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return keys %{$self->{_skip_tests}};
++}
++
++=head2 skip_test($test_id)
++
++Tells wether test with given id is to be skipped for this media.
++
++=cut
++
++sub skip_test {
++    my ($self, $test) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_skip_tests}->{all} ||
++        $self->{_skip_tests}->{$test};
++}
++
++=head2 get_package_class()
++
++Return package class for this media.
++
++=head2 traverse_files($function)
++
++Apply given function to all files of this media.
++
++=head2 traverse_headers($function)
++
++Apply given function to all headers of this media.
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item traverse_headers
++
++=item traverse_files
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,58 @@
++# $Id: /local/youri/soft/trunk/lib/Youri/Package/URPM.pm 2257 2006-07-05T09:22:47.088572Z guillaume  $
++package Youri::Package::RPM;
++
++=head1 NAME
++
++Youri::Package::RPM - Base class for all RPM-based package implementation
++
++=head1 DESCRIPTION
++
++This bases class factorize code between various RPM-based package
++implementation.
++
++=cut
++
++use strict;
++use warnings;
++use base 'Youri::Package';
++use Carp;
++
++sub get_pattern {
++    my ($class, $name, $version, $release, $arch) = @_;
++
++    return 
++        ($name ? quotemeta($name) : '[\w-]+' ).
++        '-' .
++        ($version ? quotemeta($version) : '[^-]+' ).
++        '-' .
++        ($release ? quotemeta($release) : '[^-]+' ). 
++        '\.' .
++        ($arch ? quotemeta($arch) : '\w+' ).
++        '\.rpm';
++}
++
++sub as_file {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_file};
++}
++
++sub is_debug {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $name = $self->get_name();
++    my $group = $self->get_tag('group');
++
++    # debug packages' names must end in -debug, except kernel
++    if ($group =~ m,^Development/Debug$, &&
++        ($name =~ /-debug$/o || $name =~ /^kernel-.*-debug/o)) {
++        return 1;
++    }
++    else {
++        return 0;
++    }
++}
++
++1;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM4.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM4.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Package/RPM4.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,424 @@
++# $Id: /local/youri/soft/trunk/lib/Youri/Package/URPM.pm 2129 2006-06-23T09:41:01.599329Z guillomovitch  $
++package Youri::Package::RPM4;
++
++=head1 NAME
++
++Youri::Package::RPM4 - URPM-based rpm package implementation
++
++=head1 DESCRIPTION
++
++This is an RPM4-based L<Youri::Package> implementation for rpm.
++
++=cut
++
++use strict;
++use warnings;
++use Carp;
++use RPM4;
++use RPM4::Header;
++use RPM4::Sign;
++use File::Spec;
++use Scalar::Util qw/refaddr/;
++use base 'Youri::Package::RPM';
++use overload
++    '""'     => 'as_string',
++    '0+'     => '_to_number',
++    fallback => 1;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Package::RPM4 object.
++
++Specific parameters:
++
++=over
++
++=item file $file
++
++Path of file to use for creating this package.
++
++=item header $header
++
++L<RPM4::Header> object to use for creating this package.
++
++=back
++
++=cut
++
++sub _init {
++    my ($self, %options) = @_;
++
++    my $header;
++    HEADER: {
++        if (exists $options{header}) {
++            croak "undefined header"
++                unless $options{header};
++            croak "invalid header"
++                unless $options{header}->isa('RPM4::Header');
++            $header = $options{header};
++            last HEADER;
++        }
++
++        if (exists $options{file}) {
++            croak "undefined file"
++                unless $options{file};
++            croak "non-existing file $options{file}"
++                unless -f $options{file};
++            croak "non-readable file $options{file}"
++                unless -r $options{file};
++            $header = RPM4::Header->new($options{file});
++            croak "Can't get header from file $options{file}" if (!$header); 
++
++            last HEADER;
++        }
++
++        croak "no way to extract header from arguments";
++    }
++
++    $self->{_header} = $header;
++    $self->{_file}   = File::Spec->rel2abs($options{file});
++}
++
++sub compare_versions {
++    my ($class, $version1, $version2) = @_;
++
++    return RPM4::rpmvercmp($version1, $version2);
++}
++
++sub _depsense2flag {
++    my ($string) = @_;
++    my @flags = 0;
++    push(@flags, 'EQUAL') if ($string =~ /=/);
++    push(@flags, 'LESS') if ($string =~ /</);
++    push(@flags, 'GREATER') if ($string =~ />/);
++    return \@flags;
++}
++
++sub check_ranges_compatibility {
++    my ($class, $range1, $range2) = @_;
++    my @deps1 = split(/ /, $range1);
++    my @deps2 = split(/ /, $range2);
++    $deps1[1] = _depsense2flag($range1); 
++    $deps2[1] = _depsense2flag($range2); 
++    my $dep1 = RPM4::Header::Dependencies(
++        "PROVIDENAME",
++        \@deps1,
++    );
++    my $dep2 = RPM4::Header::Dependencies(
++        "PROVIDENAME",
++        \@deps2,
++    );
++
++    return $dep1->overlap($dep2);
++}
++
++sub get_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('name');
++}
++
++sub get_version {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('version');
++}
++
++sub get_release {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('release');
++}
++
++sub get_revision {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}');
++}
++
++sub get_file_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat('%{NAME}-%{VERSION}-%{RELEASE}.%|SOURCERPM?{%{ARCH}}:{src}|.rpm');
++}
++
++
++sub get_arch {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat('%|SOURCERPM?{%{ARCH}}:{src}|');
++}
++
++sub get_url {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('url');
++}
++
++sub get_summary {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('summary');
++}
++
++sub get_description {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('description');
++}
++
++sub get_packager {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('packager');
++}
++
++sub is_source {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->issrc();
++}
++
++sub is_binary {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return !$self->{_header}->issrc();
++}
++
++sub get_type {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_header}->issrc() ?
++        "source" :
++        "binary";
++}
++
++sub get_age {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('buildtime');
++}
++
++sub get_source_package {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->tag('sourcerpm');
++}
++
++sub get_canonical_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    $self->{_header}->sourcerpmname() =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/;
++    return $1;
++}
++
++sub get_tag {
++    my ($self, $tag) = @_;
++    croak "Not a class method" unless ref $self;
++    #croak "invalid tag $tag" unless $self->{_header}->can($tag);
++    return $self->{_header}->tag($tag);
++}
++
++
++sub _get_dependencies {
++    my ($self, $deptype) = @_;
++    my $deps = $self->{_header}->dep($deptype);
++    my @deps_list;
++    if ($deps) {
++    $deps->init();
++    while ($deps->next() >= 0) {
++        my @deps = $deps->info();
++        $deps[1] =~ m/^rpmlib\(/ and next; # skipping internal rpmlib dep
++        $deps[2] =~ s/^=$/==/; # rpm say foo = 1, not foo == 1, == come from URPM, which sucks
++        my $range = $deps[3] ? ($deps[2] . ' ' . $deps[3]) : undef;
++        push(@deps_list, [ $deps[1], $range ]);
++    }
++    }
++    @deps_list
++}
++
++sub get_requires {
++    my ($self) = @_;
++
++    return $self->_get_dependencies('REQUIRENAME');
++}
++
++sub get_provides {
++    my ($self) = @_;
++
++    return $self->_get_dependencies('PROVIDENAME');
++}
++
++sub get_obsoletes {
++    my ($self) = @_;
++   
++    return $self->_get_dependencies('OBSOLETENAME');
++}
++
++sub get_conflicts {
++    my ($self) = @_;
++
++    return $self->_get_dependencies('CONFLICTNAME');
++}
++
++sub get_files {
++    my ($self) = @_;
++
++    my $files = $self->{_header}->files();
++    my @fileslist;
++    if ($files) {
++        $files->init();
++        while ($files->next() >= 0) {
++            my $smode = $files->mode();
++            my $umode = 0;
++            foreach (0..15) { # converting unsigned to signed int :\
++                $umode |= $smode & (1 << $_);
++            }
++            push(@fileslist, [ $files->filename(), $umode, $files->md5() || '' ]);
++        }
++    }
++    @fileslist
++}
++
++sub get_gpg_key {
++    my ($self) = @_;
++    
++    my $signature = $self->{_header}->queryformat('%{SIGGPG:pgpsig}');
++    
++    return if $signature eq '(not a blob)';
++
++    my $key_id = (split(/\s+/, $signature))[-1];
++
++    return substr($key_id, 8);
++}
++
++sub get_information {
++    my ($self) = @_;
++
++    return $self->{_header}->queryformat(<<EOF);
++Name        : %-27{NAME}  Relocations: %|PREFIXES?{[%{PREFIXES} ]}:{(not relocatable)}|
++Version     : %-27{VERSION}       Vendor: %{VENDOR}
++Release     : %-27{RELEASE}   Build Date: %{BUILDTIME:date}
++Install Date: %|INSTALLTIME?{%-27{INSTALLTIME:date}}:{(not installed)         }|      Build Host: %{BUILDHOST}
++Group       : %-27{GROUP}   Source RPM: %{SOURCERPM}
++Size        : %-27{SIZE}%|LICENSE?{      License: %{LICENSE}}|
++Signature   : %|DSAHEADER?{%{DSAHEADER:pgpsig}}:{%|RSAHEADER?{%{RSAHEADER:pgpsig}}:{%|SIGGPG?{%{SIGGPG:pgpsig}}:{%|SIGPGP?{%{SIGPGP:pgpsig}}:{(none)}|}|}|}|
++%|PACKAGER?{Packager    : %{PACKAGER}\n}|%|URL?{URL         : %{URL}\n}|Summary     : %{SUMMARY}
++Description :\n%{DESCRIPTION}
++EOF
++}
++
++sub get_changes {
++    my ($self) = @_;
++
++    my @names = $self->{_header}->tag('changelogname');
++    my @time  = $self->{_header}->tag('changelogtime');
++    my @text  = $self->{_header}->tag('changelogtext');
++
++    my @changes;
++    foreach my $i (0 .. $#names) {
++        $changes[$i] = [
++            $names[$i],
++            $time[$i],
++	    $text[$i],
++        ];
++    }
++
++    return @changes;
++}
++
++sub get_last_change {
++    my ($self) = @_;
++
++    return [
++        ($self->{_header}->tag('changelogname'))[0],
++        ($self->{_header}->tag('changelogtime'))[0],
++	($self->{_header}->tag('changelogtext'))[0],
++    ];
++}
++
++sub as_string {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->fullname();
++}
++
++sub as_formated_string {
++    my ($self, $format) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat($format);
++}
++
++sub _to_number {
++    return refaddr($_[0]);
++}
++
++sub compare {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->compare($package->{_header}) || 0;
++}
++
++sub satisfy_range {
++    my ($self, $range) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->check_range_compatibility($self->get_revision(), $range);
++}
++
++sub sign {
++    my ($self, $name, $path, $passphrase) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # check if parent directory is writable
++    my $parent = (File::Spec->splitpath($self->{_file}))[1];
++    croak "Unsignable package, parent directory is read-only"
++        unless -w $parent;
++
++    my $sign = RPM4::Sign->new(
++        name => $name,
++        path => $path,
++    );
++    $sign->{passphrase} = $passphrase;
++
++    $sign->rpmssign($self->{_file})
++}
++
++sub extract {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    system("rpm2cpio $self->{_file} | cpio -id >/dev/null 2>&1");
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Package/Test.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Package/Test.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Package/Test.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,151 @@
++# $Id: /local/youri/soft/core/trunk/lib/Youri/Package/URPM.pm 2133 2006-09-20T21:40:20.575763Z guillaume  $
++package Youri::Package::Test;
++
++=head1 NAME
++
++Youri::Package::Test - Fake test package
++
++=head1 DESCRIPTION
++
++This is just a fake package object, intended for testing purposes.
++
++=cut
++
++use strict;
++use warnings;
++use Carp;
++use base 'Youri::Package::RPM';
++use overload
++    '""'     => 'as_string',
++    '0+'     => '_to_number',
++    fallback => 1;
++
++our $AUTOLOAD;
++
++my @tags = qw/
++    name
++    version
++    release
++    filename
++    arch
++    url
++    summary
++    description
++    packager
++    buildtime
++    sourcerpm
++/;
++
++my %tags = map { $_ => 1 } @tags;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Package::Test object.
++
++Specific parameters:
++
++=over
++
++=item tag $tag
++
++Use given value for given tag
++
++=back
++
++=cut
++
++sub _init {
++    my ($self, %options) = @_;
++
++    $self->{"_$_"} = $options{$_} foreach keys %options;
++}
++
++sub get_revision {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_epoch} ?
++        "$self->{_epoch}:$self->{_version}-$self->{_release}" :
++        "$self->{_version}-$self->{_release}";
++}
++
++sub get_tag {
++    my ($self, $tag) = @_;
++    croak "Not a class method" unless ref $self;
++    croak "invalid tag $tag" unless $tags{$tag};
++    return $self->{'_' . $tag};
++}
++
++sub is_source {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_arch} eq 'src';
++}
++
++sub is_binary {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_arch} ne 'src';
++}
++
++sub get_type {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_arch} eq 'src' ?
++        "source" :
++        "binary";
++}
++
++sub get_canonical_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    if ($self->{_arch} eq 'src') {
++       return $self->{_name};
++    } else {
++       if ($self->{_sourcerpm}) {
++           $self->{_sourcerpm} =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/;
++           return $1;
++       } else {
++           return undef;
++       }
++    }
++}
++
++sub as_string {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return 
++        $self->{_name} ? $self->{_name} : '' .
++        '-' .
++        $self->{_version} ? $self->{_version} : '' .
++        '-' .
++        $self->{_release} ? $self->{_release} : '';
++}
++
++sub _to_number {
++    return refaddr($_[0]);
++}
++
++sub AUTOLOAD {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my $method = $AUTOLOAD;
++    $method =~ s/.*:://;
++    return if $method eq 'DESTROY';
++    croak "invalid method" unless $method =~ /^get_(\w+)$/;
++
++    my $tag = $1;
++    croak "invalid tag $tag" unless $tags{$tag};
++    return $self->{'_' . $tag};
++}
++
++1;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Package/URPM.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Package/URPM.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Package/URPM.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,399 @@
++# $Id: URPM.pm 266577 2010-03-02 14:51:24Z bogdano $
++package Youri::Package::URPM;
++
++=head1 NAME
++
++Youri::Package::URPM - URPM-based rpm package implementation
++
++=head1 DESCRIPTION
++
++This is an URPM-based L<Youri::Package> implementation for rpm.
++
++It is merely a wrapper over URPM::Package class, with a more structured
++interface.
++
++=cut
++
++use strict;
++use warnings;
++use Carp;
++use URPM;
++use File::Spec;
++use Expect;
++use Scalar::Util qw/refaddr/;
++use base 'Youri::Package::RPM';
++use overload
++    '""'     => 'as_string',
++    '0+'     => '_to_number',
++    fallback => 1;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Package::URPM object.
++
++Specific parameters:
++
++=over
++
++=item file $file
++
++Path of file to use for creating this package.
++
++=item header $header
++
++L<URPM::Package> object to use for creating this package.
++
++=back
++
++=cut
++
++sub _init {
++    my ($self, %options) = @_;
++
++    my $header;
++    HEADER: {
++        if (exists $options{header}) {
++            croak "undefined header"
++                unless $options{header};
++            croak "invalid header"
++                unless $options{header}->isa('URPM::Package');
++            $header = $options{header};
++            last HEADER;
++        }
++
++        if (exists $options{file}) {
++            croak "undefined file"
++                unless $options{file};
++            croak "non-existing file $options{file}"
++                unless -f $options{file};
++            croak "non-readable file $options{file}"
++                unless -r $options{file};
++            my $urpm = URPM->new();
++            $urpm->parse_rpm($options{file}, keep_all_tags => 1);
++            $header = $urpm->{depslist}->[0];
++            croak "non-rpm file $options{file}" unless $header;
++            last HEADER;
++        }
++
++        croak "no way to extract header from arguments";
++    }
++
++    $self->{_header} = $header;
++    $self->{_file}   = File::Spec->rel2abs($options{file});
++}
++
++sub compare_versions {
++    my ($class, $version1, $version2) = @_;
++
++    return URPM::rpmvercmp($version1, $version2);
++}
++
++sub check_ranges_compatibility {
++    my ($class, $range1, $range2) = @_;
++
++    return URPM::ranges_overlap($range1, $range2);
++}
++
++sub get_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->name();
++}
++
++sub get_version {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->version();
++}
++
++sub get_release {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->release();
++}
++
++sub get_revision {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat('%|EPOCH?{%{EPOCH}:}:{}|%{VERSION}-%{RELEASE}');
++}
++
++sub get_file_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_file} || die "_file is not defined in header-only objects!\n";
++}
++
++sub get_arch {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->arch();
++}
++
++sub get_url {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->url();
++}
++
++sub get_summary {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->summary();
++}
++
++sub get_description {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->description();
++}
++
++sub get_packager {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->packager();
++}
++
++sub is_source {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->arch() eq 'src';
++}
++
++sub is_binary {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->arch() ne 'src';
++}
++
++sub get_type {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_header}->arch() eq 'src' ?
++        "source" :
++        "binary";
++}
++
++sub get_age {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->buildtime();
++}
++
++sub get_source_package {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->sourcerpm();
++}
++
++sub get_canonical_name {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    if ($self->{_header}->arch() eq 'src') {
++       return $self->{_header}->name();
++    } else {
++       $self->{_header}->sourcerpm() =~ /^(\S+)-[^-]+-[^-]+\.src\.rpm$/;
++       return $1;
++    }
++}
++
++sub get_tag {
++    my ($self, $tag) = @_;
++    croak "Not a class method" unless ref $self;
++    croak "invalid tag $tag" unless $self->{_header}->can($tag);
++    return $self->{_header}->$tag();
++}
++
++sub get_requires {
++    my ($self) = @_;
++
++    return map {
++        $_ =~ /^([^[]+)(?:\[\*\])?(?:\[(.+)\])?$/;
++        [ $1, $2 ]
++    } $self->{_header}->requires();
++}
++
++sub get_provides {
++    my ($self) = @_;
++
++    return map {
++        $_ =~ /^([^[]+)(?:\[(.+)\])?$/;
++        [ $1, $2 && $2 ne '*' ?  $2 : undef ]
++    } $self->{_header}->provides();
++}
++
++sub get_obsoletes {
++    my ($self) = @_;
++
++    return map {
++        $_ =~ /^([^[]+)(?:\[(.+)\])?$/;
++        [ $1, $2 && $2 ne '*' ?  $2 : undef ]
++    } $self->{_header}->obsoletes();
++}
++
++sub get_conflicts {
++    my ($self) = @_;
++
++    return $self->{_header}->conflicts();
++}
++
++sub get_files {
++    my ($self) = @_;
++
++    my @modes   = $self->{_header}->files_mode();
++    my @md5sums = $self->{_header}->files_md5sum();
++
++    return map {
++        [ $_, shift @modes, shift @md5sums ]
++    } $self->{_header}->files();
++}
++
++sub get_gpg_key {
++    my ($self) = @_;
++    
++    my $signature = $self->{_header}->queryformat('%{SIGGPG:pgpsig}');
++    
++    return if $signature eq '(not a blob)';
++
++    my $key_id = (split(/\s+/, $signature))[-1];
++
++    return substr($key_id, 8);
++}
++
++sub get_information {
++    my ($self) = @_;
++
++    return $self->{_header}->queryformat(<<EOF);
++Name        : %-27{NAME}  Relocations: %|PREFIXES?{[%{PREFIXES} ]}:{(not relocatable)}|
++Version     : %-27{VERSION}       Vendor: %{VENDOR}
++Release     : %-27{RELEASE}   Build Date: %{BUILDTIME:date}
++Install Date: %|INSTALLTIME?{%-27{INSTALLTIME:date}}:{(not installed)         }|      Build Host: %{BUILDHOST}
++Group       : %-27{GROUP}   Source RPM: %{SOURCERPM}
++Size        : %-27{SIZE}%|LICENSE?{      License: %{LICENSE}}|
++Signature   : %|DSAHEADER?{%{DSAHEADER:pgpsig}}:{%|RSAHEADER?{%{RSAHEADER:pgpsig}}:{%|SIGGPG?{%{SIGGPG:pgpsig}}:{%|SIGPGP?{%{SIGPGP:pgpsig}}:{(none)}|}|}|}|
++%|PACKAGER?{Packager    : %{PACKAGER}\n}|%|URL?{URL         : %{URL}\n}|Summary     : %{SUMMARY}
++Description :\n%{DESCRIPTION}
++EOF
++}
++
++sub get_changes {
++    my ($self) = @_;
++
++    my @names = $self->{_header}->changelog_name();
++    my @time  = $self->{_header}->changelog_time();
++    my @text  = $self->{_header}->changelog_text();
++
++    my @changes;
++    foreach my $i (0 .. $#names) {
++        $changes[$i] = [
++            $names[$i],
++            $time[$i],
++            $text[$i],
++        ];
++    }
++
++    return @changes;
++}
++
++sub get_last_change {
++    my ($self) = @_;
++
++    return [
++        ($self->{_header}->changelog_name())[0],
++        ($self->{_header}->changelog_time())[0],
++        ($self->{_header}->changelog_text())[0],
++    ];
++}
++
++sub as_string {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->fullname();
++}
++
++sub as_formated_string {
++    my ($self, $format) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->queryformat($format);
++}
++
++sub _to_number {
++    return refaddr($_[0]);
++}
++
++sub compare {
++    my ($self, $package) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_header}->compare_pkg($package->{_header});
++}
++
++sub satisfy_range {
++    my ($self, $range) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->check_ranges_compatibility("== " . $self->get_revision(), $range);
++}
++
++sub sign {
++    my ($self, $name, $path, $passphrase, $target) = @_;
++    croak "Not a class method" unless ref $self;
++
++    # check if parent directory is writable
++    my $parent = (File::Spec->splitpath($self->{_file}))[1];
++    croak "Unsignable package, parent directory is read-only"
++        unless -w $parent;
++    
++    # FIXME Will have to change that
++    # we sign with cooker key even fro 2007.0 because this is for testing section
++    return !system("sudo -H /root/bin/resign_cooker $self->{_file}");
++
++    my $command =
++        'LC_ALL=C rpm --resign ' . $self->{_file} .
++        ' --define "_gpg_name ' . $name . '"' .
++        ' --define "_gpg_path ' . $path . '"';
++    my $expect = Expect->spawn($command) or die "Couldn't spawn command $command: $!\n";
++    $expect->log_stdout(0);
++    $expect->expect(20, -re => 'Enter pass phrase:');
++    $expect->send("$passphrase\n");
++
++    $expect->soft_close();
++}
++
++sub extract {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    system("rpm2cpio $self->{_file} | cpio -id >/dev/null 2>&1");
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Package.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Package.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Package.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,336 @@
++# $Id: Package.pm 223952 2007-06-23 13:54:13Z pixel $
++package Youri::Package;
++
++=head1 NAME
++
++Youri::Package - Abstract package class
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Package interface.
++
++=cut
++
++use Carp;
++use strict;
++use warnings;
++
++use constant DEPENDENCY_NAME  => 0;
++use constant DEPENDENCY_RANGE => 1;
++
++use constant FILE_NAME   => 0;
++use constant FILE_MODE   => 1;
++use constant FILE_MD5SUM => 2;
++
++use constant CHANGE_AUTHOR => 0;
++use constant CHANGE_TIME   => 1;
++use constant CHANGE_TEXT   => 2;
++
++=head1 CLASS METHODS
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Package object.
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        @_
++    );
++
++    my $self = bless {
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head2 get_pattern($name, $version, $release, $arch)
++
++Returns a pattern matching a file for a package, using available informations.
++
++=head2 compare_revisions($revision1, $revision2)
++
++Compares two revision tokens, and returns a numeric value:
++
++=over
++
++=item positive if first revision is higher
++
++=item null if both revisions are equal
++
++=item negative if first revision is lower
++
++=back
++
++=head2 check_ranges_compatibility($range1, $range2)
++
++Returns a true value if given revision ranges are compatible.
++
++=head1 INSTANCE METHODS
++
++=head2 as_file()
++
++Returns the file corresponding to this package.
++
++=head2 as_string()
++
++Returns a string representation of this package.
++
++=head2 as_formated_string(I<format>)
++
++Returns a string representation of this package, formated according to
++I<format>. Format is a string, where each %{foo} token will get replaced by
++equivalent tag value.
++
++=head2 get_name()
++
++Returns the name of this package.
++
++=head2 get_version()
++
++Returns the version of this package.
++
++=head2 get_release()
++
++Returns the release of this package.
++
++=head2 get_revision()
++
++Returns the revision of this package.
++
++=head2 get_arch()
++
++Returns the architecture of this package.
++
++=head2 get_file_name()
++
++Returns the file name of this package (name-version-release.arch.extension).
++
++=head2 is_source()
++
++Returns true if this package is a source package.
++
++=head2 is_binary()
++
++Returns true if this package is a binary package.
++
++=head2 is_debug()
++
++Returns true if this package is a debug package.
++
++=head2 get_type()
++
++Returns the type (binary/source) of this package.
++
++=head2 get_age()
++
++Returns the age of this package
++
++=head2 get_url()
++
++Returns the URL of this package
++
++=head2 get_summary()
++
++Returns the summary of this package
++
++=head2 get_description()
++
++Returns the description of this package
++
++=head2 get_packager()
++
++Returns the packager of this package.
++
++=head2 get_source_package()
++
++Returns the name of the source package of this package.
++
++=head2 get_tag($tag)
++
++Returns the value of tag $tag of this package.
++
++=head2 get_canonical_name()
++
++Returns the canonical name of this package, shared by its multiple components,
++usually the one from the source package.
++
++=head2 get_requires()
++
++Returns the list of dependencies required by this package, each dependency
++being represented as an array reference, with the following informations:
++
++=over
++
++=item B<name>
++
++Name of the dependency (index DEPENDENCY_NAME)
++
++=item B<range>
++
++Range of the dependency (index DEPENDENCY_RANGE)
++
++=back
++
++For more conveniency, fields index are available as constant in this package.
++
++=head2 get_provides()
++
++Returns the list of dependencies provided by this package, each dependency
++being represented as an array reference, using the same structure as previous method.
++
++=head2 get_obsoletes()
++
++Returns the list of other packages obsoleted by this one, each one
++being represented as an array reference, using the same structure as previous method.
++
++=head2 get_conflicts()
++
++Returns the list of other packages conflicting with this one.
++
++=head2 get_files()
++
++Returns the list of files contained in this package, each file being
++represented as an array reference, with the following informations:
++
++=over
++
++=item B<name>
++
++Name of the file (index FILE_NAME).
++
++=item B<mode>
++
++Mode of the file (index FILE_MODE).
++
++=item B<md5sum>
++
++Md5sum of the file (index FILE_MD5SUM).
++
++=back
++
++For more conveniency, fields index are available as constant in this package.
++
++=head2 get_gpg_key()
++
++Returns the gpg key id of package signature.
++
++=head2 get_information()
++
++Returns formated informations about the package.
++
++=head2 get_changes()
++
++Returns the list of changes for this package, each change being
++represented as an array reference, with the following informations:
++
++=over
++
++=item B<author>
++
++Author of the change (index CHANGE_AUTHOR).
++
++=item B<time>
++
++Time of the change (index CHANGE_TIME).
++
++=item B<text>
++
++Raw textual description of the change (index CHANGE_TEXT).
++
++=back
++
++For more conveniency, fields index are available as constant in this package.
++
++=head2 get_last_change()
++
++Returns the last change for this package, as as structure described before.
++
++=head2 compare($package)
++
++Compares ordering with other package, according to their corresponding revision
++tokens, and returns a numeric value:
++
++=over
++
++=item positive if this package is newer
++
++=item null if both have same revision
++
++=item negative if this package is older
++
++=back
++
++=head2 satisfy_range($range)
++
++Returns a true value if this package revision satisfies given revision range.
++
++=head2 sign($name, $path, $passphrase)
++
++Signs the package with given name, keyring path and passphrase.
++
++=head2 extract()
++
++Extract package content in local directory.
++
++=head1 SUBCLASSING
++
++All instances methods have to be implemented.
++
++=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
++
++sub get_file {
++    my ($self) = @_;
++    carp "Deprecated method, use as_file now";
++
++    return $self->as_file();
++}
++
++sub get_full_name {
++    my ($self) = @_;
++    carp "Deprecated method, use as_string now";
++
++    return $self->as_string();
++}
++
++sub compare_versions {
++    my ($self, $version1, $version2) = @_;
++    carp "Deprecated method, use compare_revisions now";
++
++    return $self->compare_revisions($version1, $version2);
++}
++
++sub compare_ranges {
++    my ($self, $range1, $range2) = @_;
++    carp "Deprecated method, use are_range_compatible now";
++
++    return $self->check_ranges_compatibility($range1, $range2);
++}
++
++sub get_revision_name {
++    my ($self) = @_;
++    carp "Deprecated method, use as_formated_string('%name-%version-%release') now";
++
++    return $self->as_formated_string('%{name}-%{version}-%{release}');
++}
++
++
++1;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,546 @@
++# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume  $
++package Youri::Repository::Mandriva_upload;
++
++=head1 NAME
++
++Youri::Repository::PLF - PLF repository implementation
++
++=head1 DESCRIPTION
++
++This module implements PLF repository.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Memoize;
++use File::Find 'find';
++use base qw/Youri::Repository/;
++use MDV::Distribconf::Build;
++use SVN::Client;
++
++use constant {
++    PACKAGE_CLASS   => 'Youri::Package::URPM',
++    PACKAGE_CHARSET => 'utf8'
++};
++
++memoize('_get_media_config');
++
++my %translate_arch = (
++    i386 => 'i586',
++    sparc64 => 'sparcv9',
++);
++
++sub _init {
++    my $self   = shift;
++    my %options = (
++        noarch => 'i586', # noarch packages policy
++	src => 'i586',
++	install_root => '',
++        test          => 0,  # test mode
++        verbose       => 0,  # verbose mode
++	queue	      => '',
++	rejected      => '',
++        @_
++    );
++    foreach my $var ('upload_state') {
++	$self->{"_$var"} = [];
++	foreach my $value (split ' ', $options{$var}) {
++	    push @{$self->{"_$var"}}, $value
++	}
++    }
++    print "Initializing repository\n";
++    foreach my $v ('rejected', 'svn', 'queue', 'noarch', 'install_root', 'upload_root', 'verbose') {
++        $self->{"_$v"}  = $options{$v}
++    }
++    foreach my $target (@{$options{targets}}) {
++	$self->{$target} = [];
++	print "Adding $target ($options{$target}{arch})\n" if $self->{_verbose};
++	foreach my $value (split ' ', $options{$target}{arch}) {
++	    push @{$self->{_arch}{$target}}, $value;
++	    push @{$self->{_extra_arches}}, $value
++	}
++    }
++    $self
++}
++
++sub get_group_id {
++    my ($user) = @_;
++    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
++    $year+=1900;
++    $mon++;
++    my $hostname = `hostname`;
++    my ($host) = $hostname =~ /([^.]*)/;
++    sprintf "$year%02d%02d%02d%02d%02d.$user.$host.${$}_", $mon, $mday, $hour, $min, $sec;
++}
++
++sub get_target_arch {
++    my ($self, $target) = $_;
++    return $self->{_arch}{$target}
++}
++
++sub set_arch_changed {
++    my ($self, $target, $arch) = @_;
++    if ($arch eq 'noarch') {
++	    $self->{_arch_changed}{$_} = 1 foreach @{$self->{_arch}{$target}}
++    } elsif ($arch eq 'src') {
++	    $self->{_arch_changed} = $self->{_src}
++    } else {
++	$self->{_arch_changed}{$arch} = 1
++    }
++}
++
++sub get_arch_changed {
++    my ($self, $target) = @_;
++    return [ keys %{$self->{_arch_changed}} ]
++}
++
++sub set_install_dir_changed {
++    my ($self, $install_dir) = @_;
++    $self->{_install_dir_changed}{$install_dir} = 1;
++}
++
++sub get_install_dir_changed {
++    my ($self) = @_;
++    return [ keys %{$self->{_install_dir_changed}} ];
++}
++
++sub _get_media_config {
++    my ($self, $target) = @_;
++    my %media;
++    my $real_target = $target;
++    $real_target =~ s/_force//;
++    foreach my $arch (@{$self->{_arch}{$target}}) {
++	my $root = "$self->{_install_root}/$real_target/$arch";
++	my $distrib = MDV::Distribconf::Build->new($root);
++	print "Getting media config from $root\n" if $self->{_verbose};
++	$self->{distrib}{$arch} = $distrib;
++	$distrib->loadtree or die "$root does not seem to be a distribution tree\n";
++	$distrib->parse_mediacfg;
++	foreach my $media ($distrib->listmedia) {
++	    my $rpms = $distrib->getvalue($media, 'rpms');
++	    my $debug_for = $distrib->getvalue($media, 'debug_for');
++	    my $srpms = $distrib->getvalue($media, 'srpms');
++	    my $path = $distrib->getfullpath($media, 'path');
++	    if (!$rpms) {
++		if (-d $path) {
++		    print "MEDIA defining $media in $path\n" if $self->{_verbose} > 1;
++		    $media{$arch}{$media} = $path
++		} else {
++		    print "ERROR $path does not exist for media $media on $arch\n"
++		}
++	    } else {
++		my ($media) = split ' ', $rpms;
++		if (-d $path) {
++		    print "MEDIA defining SOURCE media for $media in $path\n" if $self->{_verbose} > 1;
++		    $media{src}{$media} = $path
++		} else {
++		    print "ERROR $path does not exist for source media $media on $arch\n"
++		}
++	    }
++	}
++    }
++    \%media
++}
++
++sub get_package_class {
++    return PACKAGE_CLASS;
++}
++
++sub get_package_charset {
++    return PACKAGE_CHARSET;
++}
++
++sub get_upload_dir {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    my $arch = $package->get_arch();
++    return
++        $self->{_upload_root} .
++        "/$self->{_queue}/$target/" .
++        _get_section($self, $package, $target, $user_context, $app_context) .
++	'/' . 
++	($user_context->{prefix} ? '' : get_group_id($user_context->{user}))
++}
++
++sub get_install_path {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    return $self->_get_path($package, $target, $user_context, $app_context);
++}
++
++
++sub get_distribution_paths {
++    my ($self, $package, $target) = @_;
++
++    return $self->_get_distribution_paths($package, $target);
++}
++
++sub get_archive_path {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    return $self->_get_path($package, $target, $user_context, $app_context);
++}
++
++sub get_reject_path {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    return $self->{_rejected};
++}
++
++
++sub _get_path {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    my $section = $self->_get_section($package, $target, $user_context, $app_context);
++    my $arch = $app_context->{arch} || $package->get_arch();
++    $arch = $translate_arch{$arch} || $arch;
++    if ($arch eq 'noarch') {
++	$arch = $self->{_noarch} 
++    } elsif ($arch eq 'src') {
++	return "$target/SRPMS/$section"
++    }
++    "$target/$arch/media/$section"
++}
++
++sub _get_distribution_paths {
++    my ($self, $package, $target) = @_;
++
++    my $arch = $package->get_arch();
++    $arch = $translate_arch{$arch} || $arch;
++    if ($arch eq 'noarch') {
++	map { "$target/$_" } $self->get_extra_arches;
++    } elsif ($arch eq 'src') {
++	die "no way to get distribution path using a $arch package";
++    } else {
++	"$target/$arch";
++    }
++}
++
++sub get_arch {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    my $arch = $package->get_arch();
++    $arch = $translate_arch{$arch} || $arch;
++    if ($arch eq 'noarch') {
++	$arch = $self->{_noarch} 
++    }
++    $arch
++}
++
++sub get_version_path {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    my $section = $self->_get_section($package, $target, $user_context, $app_context);
++
++    return "$self->{_module}/$section";
++}
++
++=head2 get_replaced_packages($package, $target, $user_context, $app_context)
++
++Overrides parent method to add libified packages.
++
++=cut
++
++sub get_replaced_packages {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my @replaced_packages = 
++        $self->SUPER::get_replaced_packages($package, $target, $user_context, $app_context);
++
++    # mandriva lib policy:
++    # library package names change with revision, making mandatory to
++    # duplicate older revisions search with a custom pattern
++    my $name = $package->get_name();
++    if ($name =~ /^(lib\w+[a-zA-Z_])[\d_\.]+([-\w]*)$/) {
++        push(@replaced_packages,
++            grep { $package->compare($_) > 0 }
++            map { PACKAGE_CLASS->new(file => $_) }
++            $self->get_files(
++                $self->{_install_root},
++                $self->get_install_path($package, $target, $user_context, $app_context),
++                PACKAGE_CLASS->get_pattern(
++                    $1 . '[\d_\.]+' . $2, # custom name pattern
++                    undef,
++                    undef,
++                    $package->get_arch()
++                ),
++            )
++        );
++    }
++
++    # kernel packages have the version in the name
++    # binary dkms built for old kernels have to be removed too
++    if ($name =~ /^kernel-([^\d]*-)?([\d.]*)-(.*)$/) { # "desktop", "2.6.28", "2mnb"
++        push(@replaced_packages,
++            map { PACKAGE_CLASS->new(file => $_) }
++            $self->get_files(
++                $self->{_install_root},
++                $self->get_install_path($package, $target, $user_context, $app_context),
++                PACKAGE_CLASS->get_pattern(
++                    '(kernel-' . $1 . '\d.*|.*-kernel-[\d.]*-' . $1 . '\d.*)',
++                    undef,
++                    undef,
++                    $package->get_arch()
++                ),
++            )
++        );
++    }
++
++    return @replaced_packages;
++       
++}
++
++sub _get_main_section {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    my $section = $self->_get_section($package, $target, $user_context, $app_context);
++    my ($main_section) = $section =~ m,^([^/]+),;
++    $main_section
++}
++
++sub _get_section {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++
++    my $name = $package->get_name();
++    my $cname = $package->get_canonical_name();
++    my $version = $package->get_version();
++    my $release = $package->get_release();
++    my $section = $user_context->{section};
++    my $media = $self->_get_media_config($target);
++    my $arch = $package->get_arch();
++    my $file = $package->as_file();
++    $file =~ s,/+,/,g; # unneeded?
++    # FIXME: use $self->get_arch()
++    $arch = $self->{_noarch} if $arch eq 'noarch';
++    $arch = $translate_arch{$arch} || $arch;
++
++    if (!$section) {
++        $section = $self->{packages}{$file}{section};
++        print "Section undefined, repository says it is '$section' for '$file'\n" if $self->{_verbose};
++    }
++    if ($section && $section !~ /debug_/ && $package->is_debug()) {
++	$section = "debug_$section"
++    }
++
++    # if have section already, check if it exists, and may return immediately
++    if ($section) {
++	print "Using requested section $section\n";
++	if ($media->{$arch}{$section}) { 
++	    return $section
++	} else {
++	    die "FATAL youri: unknown section $section for target $target for arch $arch\n"
++	}
++    }
++    # else, try to find section automatically
++
++    # pattern for search of src package with specific version-release,
++    # should be searched first, because we prefer to find the precise
++    # section a package is already in
++    my $specific_source_pattern = PACKAGE_CLASS->get_pattern(
++        $cname,
++        $version,
++        $release,
++        'src'
++    );
++
++    my $source_pattern = PACKAGE_CLASS->get_pattern(
++        $cname,
++        undef,
++        undef,
++        'src'
++    );
++
++    # if a media has no source media configured, or if it is a debug
++    # package, we search in binary media
++
++    # pattern for search when a binary media has no src media configured
++    my $specific_binary_pattern = PACKAGE_CLASS->get_pattern(
++          $name,
++          $version,
++          $release,
++          $arch
++    );
++
++    # last resort pattern: previous existing binary packages
++    my $binary_pattern = PACKAGE_CLASS->get_pattern(
++          $name,
++          undef,
++          undef,
++          $arch
++    );
++
++    # first try to find section for the specific version, as it is possibly already there;
++    # this is the case for when called in Youri::Submit::Action::Archive, to find the
++    # section the package got installed
++    print "Looking for package $name with version $version-$release\n";
++    foreach my $m (keys %{$media->{$arch}}) {
++        print " .. section '$m' path '".$media->{$arch}{$m}."'\n" if $self->{_verbose};
++        # - prefer source for non-debug packages, use binary if there is no source media configured
++        # - debug packages must be searched in binary medias, due to their
++        #   src section != binary section; NOTE: should/need we search in
++        #   src medias and add the 'debug_' prefix?
++        if (!$package->is_debug() && $media->{src}{$m}) {
++            next unless $self->get_files('', $media->{src}{$m}, $specific_source_pattern);
++        } else {
++            next unless $self->get_files('', $media->{$arch}{$m}, $specific_binary_pattern);
++        }
++        $section = $m;
++        last;
++    }
++
++    # if still not found, try finding any version of the package in a
++    # /release subsection (safe default: /release is default for cooker,
++    # should be locked for released distros, and we don't risk wrongly
++    # choosing /backports, /testing, or /updates);
++    # this is the case for when called at submit, to find the section where
++    # the package already resides
++    if (!$section) {
++        # debug packages should be found by previous specific version search
++        # NOTE: as above, should/need we search here and add the 'debug_' prefix?
++        # ... probably... as at least mdv-youri-submit-force will process debug packages
++        if ($package->is_debug() && $self->{_verbose}) {
++            print "Warning: debug package $name with version $version-$release not found.\n";
++        }
++
++        print "Warning: Looking for any section with a package $name of any version\n";
++        foreach my $m (keys %{$media->{$arch}}) {
++            print " .. section '$m' path '".$media->{$arch}{$m}."'\n" if $self->{_verbose};
++            # NOTE: !$package->is_debug() test is here to prevent when above FATAL error is removed
++            next if $m !~ /release/ || ($m =~ /debug/ && !$package->is_debug());
++            # - prefer source
++            if ($media->{src}{$m}) {
++                next unless $self->get_files('', $media->{src}{$m}, $source_pattern);
++            } else {
++                next unless $self->get_files('', $media->{$arch}{$m}, $binary_pattern);
++            }
++            $section = $m;
++            last;
++        }
++    }
++
++    # FIXME: doing this here is wrong; this way the caller can never know if
++    # a section was actually found or not; should return undef and let the
++    # caller set a default (Note: IIRC PLF|Zarb has this right, see there) -spuk
++    print STDERR "Warning: Can't guess destination: section missing, defaulting to contrib/release\n" unless $section;
++    $section ||= 'contrib/release';
++
++    # next time we don't need to search everything again
++    $self->{packages}{$file}{section} = $section;
++
++    print "Section is '$section'.\n";
++
++    return $section;
++}
++
++sub get_upload_newer_revisions {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    my $arch = $package->get_arch();
++    my $name = $package->get_full_name;
++    $name =~ s/^\@\d+://;
++    my $pattern = $self->get_package_class()->get_pattern($package->get_name(), undef, undef, $arch);
++    my $media = $self->_get_media_config($target);
++    my @packages;
++    foreach my $state (@{$self->{_upload_state}}) {
++	foreach my $m (keys %{$media->{$arch}}) {
++	    my $path = "$self->{_upload_root}/$state/$target/$m";
++	    print "Looking for package $package revisions for $target in $path (pattern $pattern)\n" if $self->{_verbose};
++	    find(
++		sub { 
++		    s/\d{14}\.[^.]*\.[^.]*\.\d+_//; 
++		    s/^\@\d+://;
++		    return if ! /^$pattern/; 
++		    return if /\.info$/; 
++		    print "Find $_\n"; 
++		    push @packages, $File::Find::name if $package->check_ranges_compatibility("== $name", "< $_")
++		}, $path);
++	}
++    }
++    return
++        @packages;
++}
++
++sub package_in_svn {
++    my ($self, $srpm_name) = @_;
++    my $ctx = new SVN::Client(
++	auth => [SVN::Client::get_simple_provider(),
++	SVN::Client::get_simple_prompt_provider(\&simple_prompt,2),
++	SVN::Client::get_username_provider()]
++    );
++
++    my $svn_entry = $ctx->ls("$self->{_svn}/$srpm_name", 'HEAD', 0);
++    if ($svn_entry) {
++	print "Package $srpm_name is in the SVN\n";
++	return 1
++    }
++}
++
++sub get_svn_url {
++    my ($self) = @_;
++    $self->{_svn}
++}
++
++sub get_revisions {
++    my ($self, $package, $target, $user_context, $app_context, $filter) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package revisions for $target\n" if $self->{_verbose} > 0;
++
++    my $arch = $app_context->{arch} || $user_context->{arch} || $package->get_arch();
++    my $media_arch = $arch eq 'noarch' ? $self->{_noarch} : $arch;
++    my $path = $arch eq 'src' ? "$target/SRPMS/" : "$target/$media_arch/media";
++    my $media = $self->_get_section($package, $target, $user_context, $app_context);
++    my $name = $package->get_name();
++    my @packages = map { $self->get_package_class()->new(file => $_) }
++	$self->get_files(
++	    $self->{_install_root},
++	    "$path/$media",
++	    $self->get_package_class()->get_pattern(
++		    $name,
++		undef,
++		undef,
++		$package->get_arch(),
++	    )
++	);
++
++    @packages = grep { $filter->($_) } @packages if $filter;
++
++    return
++        sort { $b->compare($a) } # sort by revision order
++        @packages;
++}
++
++sub reject {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++
++}
++
++sub get_archive_dir {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return
++        $self->{_archive_root}
++}
++
++
++# 20060801 warly
++#
++# Upload steps
++# SRPMS are uploaded in /home/mandrake/uploads/todo/$target/$media/group_id
++#
++# 
++#
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload_pre.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload_pre.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Repository/Mandriva_upload_pre.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,274 @@
++# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume  $
++package Youri::Repository::Mandriva_upload_pre;
++
++=head1 NAME
++
++Youri::Repository::PLF - PLF repository implementation
++
++=head1 DESCRIPTION
++
++This module implements PLF repository.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Memoize;
++use File::Find 'find';
++use base qw/Youri::Repository/;
++use SVN::Client;
++use constant {
++    PACKAGE_CLASS   => 'Youri::Package::URPM',
++    PACKAGE_CHARSET => 'utf8'
++};
++
++memoize('_get_section');
++
++sub _init {
++    my $self   = shift;
++    my %options = (
++        module => 'SPECS', # CVS module
++        noarch => 'i586', # noarch packages policy
++	svn    => '',
++	upload_root => '',
++        @_
++    );
++
++    $self->{_module} = $options{module};
++    $self->{_noarch} = $options{noarch};
++    $self->{_svn} = $options{svn};
++    $self->{_upload_root} = $options{upload_root};
++
++    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
++    $year+=1900;
++    my $hostname = `hostname`;
++    my ($host) = $hostname =~ /([^.]*)/;
++    $self->{group_dir} = sprintf "$ENV{SUDO_USER}.$host.$$.$year%02d%02d%02d%02d%02d", $mon, $mday, $hour, $min, $sec;
++}
++
++sub get_package_class {
++    return PACKAGE_CLASS;
++}
++
++sub package_in_svn {
++    my ($self, $srpm_name) = @_;
++    my $ctx = new SVN::Client(
++	auth => [SVN::Client::get_simple_provider(),
++	SVN::Client::get_simple_prompt_provider(\&simple_prompt,2),
++	SVN::Client::get_username_provider()]
++    );
++
++    my $svn_entry = $ctx->ls("$self->{_svn}/", 'HEAD', 0);
++    foreach (keys %{$svn_entry}) {
++	if ($srpm_name eq $_) {
++	    print "Package $_ is in the SVN\n";
++	    return 1
++	}
++    }
++}
++
++sub get_svn_url {
++    my ($self) = @_;
++    $self->{_svn}
++}
++
++sub get_revisions {
++    my ($self, $package, $target, $define, $filter) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package revisions for $target\n"
++        if $self->{_verbose} > 0;
++
++    my $arch = $define->{arch} || $package->get_arch;
++    if ($arch eq 'src') {
++	$arch = 'SRPMS'
++    } else {
++	$arch .= '/media'
++    }
++    my @packages;
++    foreach my $dir ('main', 'contrib') {
++	print "Looking into $self->{_install_root}/$target/$arch/$dir/release\n";
++	push @packages, 
++	map { $self->get_package_class()->new(file => $_) }
++	$self->get_files(
++	    $self->{_install_root},
++	    "$target/$arch/$dir/release" ,
++	    $self->get_package_class()->get_pattern($package->get_name(),undef, undef, $arch)
++	);
++    }
++
++    @packages = grep { $filter->($_) } @packages if $filter;
++
++    return
++        sort { $b->compare($a) } # sort by revision order
++        @packages;
++}
++
++sub get_package_charset {
++    return PACKAGE_CHARSET;
++}
++
++sub get_upload_dir {
++    my ($self, $package, $target, $define) = @_;
++    croak "Not a class method" unless ref $self;
++    my $arch = $package->get_arch();
++    my $section = $self->_get_section($package, $target, $define);
++    my $media_path = $section eq 'main' ? $target  : $target =~ /^cooker/ ? "contrib" : "$target/contrib";
++    my $arch_path = $arch eq 'src' ? 'SRPMS' : 'RPMS';
++    my $force = $target =~ /_force/ ? 'force' : '';
++    $self->{_upload_root} .  "/$media_path/$force/$arch_path/"
++}
++
++sub get_arch {
++    my ($self, $package, $target, $define) = @_;
++    my $arch = $package->get_arch();
++    if ($arch eq 'noarch') {
++	$arch = $self->{_noarch} 
++    }
++    $arch
++}
++
++sub get_install_path {
++    my ($self, $package, $target, $define) = @_;
++
++    return $self->_get_path($package, $target, $define);
++}
++
++sub get_archive_path {
++    my ($self, $package, $target, $define) = @_;
++
++    return $self->_get_path($package, $target, $define);
++}
++
++sub _get_path {
++    my ($self, $package, $target, $define) = @_;
++
++    my $arch = $package->get_arch;
++    if ($arch eq 'src') {
++	$arch = 'SRPMS'
++    } else {
++	$arch .= '/media'
++    }
++    my $section = $self->_get_section($package, $target, $define);
++
++    return "$target/$arch/$section/release/";
++}
++
++
++sub get_version_path {
++    my ($self, $package, $target, $define) = @_;
++
++    my $section = $self->_get_section($package, $target, $define);
++
++    return "$self->{_module}/$section/release/";
++}
++
++=head2 get_replaced_packages($package, $target, $define)
++
++Overrides parent method to add libified packages.
++
++=cut
++
++sub get_replaced_packages {
++    my ($self, $package, $target, $define) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my @replaced_packages = 
++        $self->SUPER::get_replaced_packages($package, $target, $define);
++
++    # mandriva lib policy:
++    # library package names change with revision, making mandatory to
++    # duplicate older revisions search with a custom pattern
++    my $name = $package->get_name();
++    if ($name =~ /^(lib\w+[a-zA-Z_])[\d_\.]+([-\w]*)$/) {
++        push(@replaced_packages,
++            grep { $package->compare($_) > 0 }
++            map { PACKAGE_CLASS->new(file => $_) }
++            $self->get_files(
++                $self->{_install_root},
++                $self->get_install_path($package, $target, $define),
++                PACKAGE_CLASS->get_pattern(
++                    $1 . '[\d_\.]+' . $2, # custom name pattern
++                    undef,
++                    undef,
++                    $package->get_arch()
++                ),
++            )
++        );
++    }
++
++    return @replaced_packages;
++       
++}
++
++sub _get_section {
++    my ($self, $package, $target, $define) = @_;
++
++    my $section;
++
++    # try to find section automatically
++    my $arch = $package->get_arch();
++    $arch = $self->{_noarch} if $arch eq 'noarch';
++
++    my $source_pattern = PACKAGE_CLASS->get_pattern(
++        $package->get_canonical_name(),
++        undef,
++        undef,
++        'src'
++    );
++
++    my $binary_pattern = PACKAGE_CLASS->get_pattern(
++        $package->get_name(),
++        undef,
++        undef,
++        $arch
++    );
++
++    # for each potential section, try to match
++    # a suitable source patten in source directory
++    # a suitable binary patten in binary directory
++    foreach my $dir (qw/main contrib/) {
++        next unless
++            $self->get_files(
++                $self->{_install_root},
++                "$target/SRPMS/$dir/release",
++                $source_pattern
++            ) || $self->get_files(
++                $self->{_install_root},
++                "$target/$arch/media/$dir/release",
++                $binary_pattern
++            );
++	print "Section is $dir\n";
++        $section = $dir;
++        last;
++    }
++
++    # use defined section if not found
++    $section = $define->{section} unless $section;
++
++    $section || 'contrib'
++}
++
++sub get_upload_newer_revisions {
++    my ($self, $package, $target, $define) = @_;
++    croak "Not a class method" unless ref $self;
++    my $arch = $package->get_arch();
++    my $pattern = $self->get_package_class()->get_pattern($package->get_name(), undef, undef, $arch);
++    print "Looking for package $package revisions for $target in $self->{_upload_root} (pattern $pattern)\n";
++    my @packages;
++    foreach my $dir ('cooker', 'contrib') {
++	find(sub { return if ! /^$pattern/; print "Find $_\n"; push @packages, $File::Find::name if $package->compare($self->get_package_class()->new(file => $File::Find::name)) <= 0 }, "$self->{_upload_root}/$dir");
++    }
++    return
++        @packages;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Repository/PLF.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Repository/PLF.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Repository/PLF.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,196 @@
++# $Id: /local/youri/soft/trunk/lib/Youri/Upload/Action/RSS.pm 857 2006-01-29T10:15:43.298856Z guillaume  $
++package Youri::Repository::PLF;
++
++=head1 NAME
++
++Youri::Repository::PLF - PLF repository implementation
++
++=head1 DESCRIPTION
++
++This module implements PLF repository.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use Memoize;
++use base qw/Youri::Repository/;
++use constant {
++    PACKAGE_CLASS   => 'Youri::Package::URPM',
++    PACKAGE_CHARSET => 'utf8'
++};
++
++memoize('_get_section');
++
++
++sub _init {
++    my $self   = shift;
++    my %options = (
++        module => 'SPECS', # CVS module
++        noarch => 'noarch', # noarch packages policy
++        @_
++    );
++
++    $self->{_module} = $options{module};
++    $self->{_noarch} = $options{noarch};
++}
++
++sub get_package_class {
++    return PACKAGE_CLASS;
++}
++
++sub get_package_charset {
++    return PACKAGE_CHARSET;
++}
++
++sub get_install_path {
++    my ($self, $package, $target, $define) = @_;
++
++    return $self->_get_path($package, $target, $define);
++}
++
++sub get_archive_path {
++    my ($self, $package, $target, $define) = @_;
++
++    return $self->_get_path($package, $target, $define);
++}
++
++sub _get_path {
++    my ($self, $package, $target, $define) = @_;
++
++    my $section = $self->_get_section($package, $target, $define);
++
++    my $subpath = $self->_get_subpath($package, $target);
++
++    return "$section/$subpath";
++}
++
++
++sub get_version_path {
++    my ($self, $package, $target, $define) = @_;
++
++    my $section = $self->_get_section($package, $target, $define);
++
++    return "$self->{_module}/$section";
++}
++
++=head2 get_replaced_packages($package, $target, $define)
++
++Overrides parent method to add libified packages.
++
++=cut
++
++sub get_replaced_packages {
++    my ($self, $package, $target, $define) = @_;
++    croak "Not a class method" unless ref $self;
++
++    my @replaced_packages = 
++        $self->SUPER::get_replaced_packages($package, $target, $define);
++
++    # mandriva lib policy:
++    # library package names change with revision, making mandatory to
++    # duplicate older revisions search with a custom pattern
++    my $name = $package->get_name();
++    if ($name =~ /^(lib\w+[a-zA-Z_])[\d_\.]+([-\w]*)$/) {
++        push(@replaced_packages,
++            grep { $package->compare($_) > 0 }
++            map { PACKAGE_CLASS->new(file => $_) }
++            $self->get_files(
++                $self->{_install_root},
++                $self->get_install_path($package, $target, $define),
++                PACKAGE_CLASS->get_pattern(
++                    $1 . '[\d_\.]+' . $2, # custom name pattern
++                    undef,
++                    undef,
++                    $package->get_arch()
++                ),
++            )
++        );
++    }
++
++    return @replaced_packages;
++       
++}
++
++sub _get_section {
++    my ($self, $package, $target, $define) = @_;
++
++    my $section;
++
++    # try to find section automatically
++    my $arch = $package->get_arch();
++
++    my $source_pattern = PACKAGE_CLASS->get_pattern(
++        $package->get_canonical_name(),
++        undef,
++        undef,
++        'src'
++    );
++
++    my $binary_pattern = PACKAGE_CLASS->get_pattern(
++        $package->get_name(),
++        undef,
++        undef,
++        $arch
++    );
++
++    my $source_subpath = $self->_get_subpath($package, $target, 'src');
++    my $binary_subpath = $self->_get_subpath($package, $target, $arch);
++
++    # for each potential section, try to match
++    # a suitable source patten in source directory
++    # a suitable binary patten in binary directory
++    foreach my $dir (qw/free non-free/) {
++        next unless
++            $self->get_files(
++                $self->{_install_root},
++                "$dir/$source_subpath",
++                $source_pattern
++            ) || $self->get_files(
++                $self->{_install_root},
++                "$dir/$binary_subpath",
++                $binary_pattern
++            );
++        $section = $dir;
++        last;
++    }
++
++    # use defined section if not found
++    $section = $define->{section} unless $section;
++
++    die "Can't guess destination: section missing" unless $section;
++
++    return $section;
++}
++
++sub _get_subpath {
++    my ($self, $package, $target, $arch) = @_;
++
++    my $subpath;
++
++    # use package arch if not specified
++    $arch = $package->get_arch() unless $arch;
++
++    if ($arch eq 'src') {
++        $subpath = 'src';
++    } else {
++        if ($arch eq 'noarch') {
++            $subpath = "$target/$self->{_noarch}";
++        } else {
++            $subpath = "$target/$arch";
++        }
++    }
++
++    return $subpath;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Repository.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Repository.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Repository.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,492 @@
++# $Id: Base.pm 631 2006-01-26 22:22:23Z guillomovitch $
++package Youri::Repository;
++
++=head1 NAME
++
++Youri::Repository - Abstract repository
++
++=head1 DESCRIPTION
++
++This abstract class defines Youri::Repository interface.
++
++=cut
++
++use warnings;
++use strict;
++use Carp;
++use File::Basename;
++use Youri::Package;
++
++=head1 CLASS METHODS
++
++
++=head2 new(%args)
++
++Creates and returns a new Youri::Repository object.
++
++No generic parameters (subclasses may define additional ones).
++
++Warning: do not call directly, call subclass constructor instead.
++
++=cut
++
++sub new {
++    my $class = shift;
++    croak "Abstract class" if $class eq __PACKAGE__;
++
++    my %options = (
++        install_root  => '', # path to top-level directory
++        archive_root  => '', # path to top-level directory
++        version_root  => '', # path to top-level directory
++        test          => 0,  # test mode
++        verbose       => 0,  # verbose mode
++        @_
++    );
++
++
++    croak "no install root" unless $options{install_root};
++    croak "invalid install root" unless -d $options{install_root};
++
++    my $self = bless {
++        _install_root  => $options{install_root},
++        _archive_root  => $options{archive_root},
++        _version_root  => $options{version_root},
++        _test          => $options{test},
++        _verbose       => $options{verbose},
++    }, $class;
++
++    $self->_init(%options);
++
++    return $self;
++}
++
++sub _init {
++    # do nothing
++}
++
++=head1 INSTANCE METHODS
++
++=head2 get_package_class()
++
++Return package class for this repository.
++
++=cut
++
++sub get_package_class {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++    return $self->{_package_class};
++}
++
++=head2 get_package_charset()
++
++Return package charset for this repository.
++
++=cut
++
++sub get_package_charset {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++    return $self->{_package_charset};
++}
++
++=head2 get_extra_arches()
++
++Return the list of additional archictectures to handle when dealing with noarch
++packages.
++
++=cut
++
++sub get_extra_arches {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++    return @{$self->{_extra_arches}};
++}
++
++
++=head2 get_older_revisions($package, $target, $user_context, $app_context)
++
++Get all older revisions from a package found in its installation directory, as a
++list of L<Youri::Package> objects.
++
++=cut
++
++sub get_older_revisions {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package older revisions for $target\n"
++        if $self->{_verbose} > 0;
++
++    return $self->get_revisions(
++        $package,
++        $target,
++        $user_context,
++        $app_context,
++        sub { return $package->compare($_[0]) > 0 }
++    );
++}
++
++=head2 get_last_older_revision($package, $target, $user_context, $app_context)
++
++Get last older revision from a package found in its installation directory, as a
++single L<Youri::Package> object.
++
++=cut
++
++sub get_last_older_revision {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package last older revision for $target\n"
++        if $self->{_verbose} > 0;
++
++    return (
++        $self->get_older_revisions(
++            $package,
++            $target,
++            $user_context,
++            $app_context
++        )
++    )[0];
++}
++
++=head2 get_newer_revisions($package, $target, $user_context, $app_context)
++
++Get all newer revisions from a package found in its installation directory, as
++a list of L<Youri::Package> objects.
++
++=cut
++
++sub get_newer_revisions {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package newer revisions for $target\n"
++        if $self->{_verbose} > 0;
++
++    return $self->get_revisions(
++        $package,
++        $target,
++        $user_context,
++        $app_context,
++        sub { return $_[0]->compare($package) > 0 }
++    );
++}
++
++
++=head2 get_revisions($package, $target, $user_context, $app_context, $filter)
++
++Get all revisions from a package found in its installation directory, using an
++optional filter, as a list of L<Youri::Package> objects.
++
++=cut
++
++sub get_revisions {
++    my ($self, $package, $target, $user_context, $app_context, $filter) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for package $package revisions for $target\n"
++        if $self->{_verbose} > 0;
++
++    my @packages = 
++        map { $self->get_package_class()->new(file => $_) }
++        $self->get_files(
++            $self->{_install_root},
++            $self->get_install_path(
++                $package,
++                $target,
++                $user_context,
++                $app_context
++            ),
++            $self->get_package_class()->get_pattern(
++                $package->get_name(),
++                undef,
++                undef,
++                $package->get_arch(),
++            )
++        );
++    @packages = grep { $filter->($_) } @packages if $filter;
++
++    return
++        sort { $b->compare($a) } # sort by revision order
++        @packages;
++}
++
++=head2 get_obsoleted_packages($package, $target, $user_context, $app_context)
++
++Get all packages obsoleted by given one, as a list of L<Youri::Package>
++objects.
++
++=cut
++
++sub get_obsoleted_packages {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for packages obsoleted by $package for $target\n"
++        if $self->{_verbose} > 0;
++
++    my @packages;
++    foreach my $obsolete ($package->get_obsoletes()) {
++        my $pattern = $self->get_package_class()->get_pattern($obsolete->[Youri::Package::DEPENDENCY_NAME]);
++        my $range = $obsolete->[Youri::Package::DEPENDENCY_RANGE];
++        push(@packages,
++            grep { $range ? $_->satisfy_range($range) : 1 } 
++            map { $self->get_package_class()->new(file => $_) }
++            $self->get_files(
++                $self->{_install_root},
++                $self->get_install_path(
++                    $package, $target,
++                    $user_context,
++                    $app_context
++                ),
++                $pattern
++            )
++        );
++    }
++
++    return @packages;
++}
++
++=head2 get_replaced_packages($package, $target, $user_context, $app_context)
++
++Get all packages replaced by given one, as a list of L<Youri::Package>
++objects.
++
++=cut
++
++sub get_replaced_packages {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++    print "Looking for packages replaced by $package for $target\n"
++        if $self->{_verbose} > 0;
++
++    my @list;
++
++    # collect all older revisions
++    push(@list, $self->get_older_revisions(
++        $package,
++        $target,
++        $user_context,
++        $app_context
++    ));
++
++    # noarch packages are potentially linked from other directories
++    if ($package->get_arch() eq 'noarch') {
++        foreach my $arch ($self->get_extra_arches()) {
++            push(@list, $self->get_older_revisions(
++                $package,
++                $target,
++                $user_context,
++                { arch => $arch }
++            ));
++        }
++    }
++
++    # collect all obsoleted packages
++    push(@list, $self->get_obsoleted_packages(
++        $package,
++        $target,
++        $user_context,
++        $app_context
++    ));
++
++    return @list;
++}
++
++=head2 get_files($path, $pattern)
++
++Get all files found in a directory, using an optional filtering pattern
++(applied to the whole file name), as a list of files.
++
++=cut
++
++sub get_files {
++    my ($self, $root, $path, $pattern) = @_;
++    croak "Not a class method" unless ref $self;
++    # debugging for bug 34999
++    print "Looking for files matching $pattern in $root/$path\n";
++#        if $self->{_verbose} > 1;
++
++    my $grep = "";
++    $grep = "-regextype posix-egrep -regex '.*\/$pattern'" if ($pattern);
++    # XXX: run find in a directory the user is guaranteed to have read
++    # permissions! find simply exits with error if the user doesn't have
++    # read permission on the *current* dir; as this code is run thru many
++    # sudo invocations, sometimes the user calling it has $HOME chmoded to
++    # 0700, making find fail when run as mandrake
++    # debugging for bug 34999
++    print ".. running command: find -L $root/$path $grep -type f\n";
++    my @files = map { chop; $_; } `cd && find -L $root/$path $grep -type f`;
++    die "FATAL: get_files(): find failed!" if ($?);
++
++    return @files;
++}
++
++=head2 get_install_root()
++
++Returns installation root
++
++=cut
++
++sub get_install_root {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_install_root};
++}
++
++
++=head2 get_distribution_roots()
++
++Returns distribution roots (ie install_root + target + arch)
++(it returns a list in case of noarch)
++
++=cut
++
++sub get_distribution_roots {
++    my ($self, $package, $target) = @_;
++    croak "Not a class method" unless ref $self;
++
++    map { 
++	$self->_get_dir($self->{_install_root}, $_);
++    } $self->get_distribution_paths($package, $target);
++}
++
++=head2 get_install_dir($package, $target, $user_context, $app_context)
++
++Returns install destination directory for given L<Youri::Package> object
++and given target.
++
++=cut
++
++sub get_install_dir {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->_get_dir(
++        $self->{_install_root},
++        $self->get_install_path($package, $target, $user_context, $app_context)
++    );
++}
++
++=head2 get_archive_root()
++
++Returns archiving root
++
++=cut
++
++sub get_archive_root {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_archive_root};
++}
++
++=head2 get_archive_dir($package, $target, $user_context, $app_context)
++
++Returns archiving destination directory for given L<Youri::Package> object
++and given target.
++
++=cut
++
++sub get_archive_dir {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->_get_dir(
++        $self->{_archive_root},
++        $self->get_archive_path($package, $target, $user_context, $app_context)
++    );
++}
++
++
++=head2 get_version_root()
++
++Returns versionning root
++
++=cut
++
++sub get_version_root {
++    my ($self) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->{_version_root};
++}
++
++=head2 get_version_dir($package, $target, $user_context, $app_context)
++
++Returns versioning destination directory for given L<Youri::Package>
++object and given target.
++
++=cut
++
++sub get_version_dir {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return $self->_get_dir(
++        $self->{_version_root},
++        $self->get_version_path($package, $target, $user_context, $app_context)
++    );
++}
++
++sub _get_dir {
++    my ($self, $root, $path) = @_;
++
++    return substr($path, 0, 1) eq '/' ?
++        $path :
++        $root . '/' . $path;
++}
++
++=head2 get_install_file($package, $target, $user_context, $app_context)
++
++Returns install destination file for given L<Youri::Package> object and
++given target.
++
++=cut
++
++sub get_install_file {
++    my ($self, $package, $target, $user_context, $app_context) = @_;
++    croak "Not a class method" unless ref $self;
++
++    return 
++        $self->get_install_dir($package, $target, $user_context, $app_context) .
++        '/' .
++        $package->get_file_name();
++}
++
++=head2 get_install_path($package, $target, $user_context, $app_context)
++
++Returns installation destination path (relative to repository root) for given
++L<Youri::Package> object and given target.
++
++=head2 get_archive_path($package, $target, $user_context, $app_context)
++
++Returns archiving destination path (relative to repository root) for given
++L<Youri::Package> object and given target.
++
++=head2 get_version_path($package, $target, $user_context, $app_context)
++
++Returns versioning destination path (relative to repository root) for given
++L<Youri::Package> object and given target.
++
++=head1 SUBCLASSING
++
++The following methods have to be implemented:
++
++=over
++
++=item get_install_path
++
++=item get_archive_path
++
++=item get_version_path
++
++=back
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/lib/Youri/Utils.pm
+===================================================================
+--- build_system/mdv-youri-core/trunk/lib/Youri/Utils.pm	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/lib/Youri/Utils.pm	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,98 @@
++# $Id: Utils.pm 1713 2006-10-16 16:39:53Z warly $
++package Youri::Utils;
++
++=head1 NAME
++
++Youri::Utils - Youri shared functions
++
++=head1 DESCRIPTION
++
++This module implement some helper functions for all youri applications.
++
++=cut
++
++use base qw(Exporter);
++use Carp;
++use strict;
++use warnings;
++
++our @EXPORT = qw(
++    create_instance
++    load_class
++    add2hash
++    add2hash_
++);
++
++=head2 create_instance($class, $config, $options)
++
++Create an instance from a plugin implementing given interface, using given
++configuration and local options.
++Returns a plugin instance, or undef if something went wrong.
++
++=cut
++
++sub create_instance {
++    my ($interface, $config, $options) = @_;
++
++    croak 'No interface given' unless $interface;
++    croak 'No config given' unless $config;
++
++    my $class = $config->{class};
++    if (!$class) {
++        carp "No class given, can't load plugin";
++        return;
++    }
++
++    # ensure loaded
++    load_class($class);
++
++    # check interface
++    if (!$class->isa($interface)) {
++        carp "$class is not a $interface";
++        return;
++    }
++
++    # instantiate
++    no strict 'refs';
++
++    return $class->new(
++        $config->{options} ? %{$config->{options}} : (),
++        $options ? %{$options} : (),
++    );
++}
++
++sub load_class {
++    my ($class) = @_;
++
++    $class .= '.pm';
++    $class =~ s/::/\//g;
++    require $class;
++}
++
++# structure helpers
++
++sub add2hash  {
++    my ($a, $b) = @_;
++    while (my ($k, $v) = each %{$b || {}}) {
++        $a->{$k} ||= $v;
++    }
++    return $a;
++}
++
++sub add2hash_ {
++    my ($a, $b) = @_;
++    while (my ($k, $v) = each %{$b || {}}) {
++        exists $a->{$k} or $a->{$k} = $v;
++    }
++    return $a;
++}
++
++=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;
+
+Added: build_system/mdv-youri-core/trunk/t/00distribution.t
+===================================================================
+--- build_system/mdv-youri-core/trunk/t/00distribution.t	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/t/00distribution.t	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,15 @@
++#!/usr/bin/perl
++# $Id: 00distribution.t 1179 2006-08-05 08:30:57Z warly $
++
++use Test::More;
++
++BEGIN {
++    eval {
++        require Test::Distribution;
++    };
++    if($@) {
++        plan skip_all => 'Test::Distribution not installed';
++    } else {
++        import Test::Distribution only => [ qw/use pod description/ ];
++    }
++}
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/00distribution.t
+___________________________________________________________________
+Added: svn:executable
+   + *
+
+Added: build_system/mdv-youri-core/trunk/t/cowsay-3.03-11mdv2007.0.noarch.rpm
+===================================================================
+(Binary files differ)
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/cowsay-3.03-11mdv2007.0.noarch.rpm
+___________________________________________________________________
+Added: svn:mime-type
+   + application/octet-stream
+
+Added: build_system/mdv-youri-core/trunk/t/gpghome/pubring.gpg
+===================================================================
+(Binary files differ)
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/gpghome/pubring.gpg
+___________________________________________________________________
+Added: svn:mime-type
+   + application/octet-stream
+
+Added: build_system/mdv-youri-core/trunk/t/gpghome/secring.gpg
+===================================================================
+(Binary files differ)
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/gpghome/secring.gpg
+___________________________________________________________________
+Added: svn:mime-type
+   + application/octet-stream
+
+Added: build_system/mdv-youri-core/trunk/t/gpghome/trustdb.gpg
+===================================================================
+(Binary files differ)
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/gpghome/trustdb.gpg
+___________________________________________________________________
+Added: svn:mime-type
+   + application/octet-stream
+
+Added: build_system/mdv-youri-core/trunk/t/package.t
+===================================================================
+--- build_system/mdv-youri-core/trunk/t/package.t	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/t/package.t	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,482 @@
++#!/usr/bin/perl
++# $Id: /local/youri/soft/trunk/t/version.t 2257 2006-07-05T09:22:47.088572Z guillaume  $
++
++use Test::More;
++use Test::Exception;
++use Youri::Utils;
++use File::Temp qw/tempdir/;
++use File::Basename;
++use strict;
++
++my @classes = qw/
++    Youri::Package::URPM
++    Youri::Package::RPM4
++/;
++my $dir      = dirname($0);
++my $rpm      = 'cowsay-3.03-11mdv2007.0.noarch.rpm';
++my $fake_rpm = 'foobar.rpm';
++plan(tests => 37 * scalar @classes);
++
++foreach my $class (@classes) {
++    load_class($class);
++
++    my $temp_dir  = tempdir(CLEANUP => 1);
++    my $file      = "$dir/$rpm";
++    my $fake_file = "$temp_dir/$fake_rpm";
++
++    # instanciation errors
++    dies_ok { $class->new(file => undef) } 'undefined file';
++    dies_ok { $class->new(file => $fake_file) } 'non-existant file';
++    system('touch', $fake_file);
++    chmod 0000, $fake_file;
++    dies_ok { $class->new(file => $fake_file) } 'non-readable file';
++    chmod 0644, $fake_file;
++    dies_ok { $class->new(file => $fake_file) } 'non-rpm file';
++
++    my $package = $class->new(file => $file);
++    isa_ok($package, $class);
++
++    # tag value access
++    is($package->get_name(), 'cowsay', 'get name directly');
++    is($package->get_tag('name'), 'cowsay', 'get name indirectly');
++    is($package->get_version(), '3.03', 'get version directly');
++    is($package->get_tag('version'), '3.03', 'get version indirectly');
++    is($package->get_release(), '11mdv2007.0', 'get release directly');
++    is($package->get_tag('release'), '11mdv2007.0', 'get release indirectly');
++    is($package->get_arch(), 'noarch', 'get arch directly');
++    is($package->get_tag('arch'), 'noarch', 'get arch indirectly');
++    is($package->get_summary(), 'Configurable talking cow', 'get summary directly');
++    is($package->get_tag('summary'), 'Configurable talking cow', 'get summary indirectly');
++    is($package->get_url(), 'http://www.nog.net/~tony/warez/cowsay.shtml', 'get url directly');
++    is($package->get_tag('url'), 'http://www.nog.net/~tony/warez/cowsay.shtml', 'get url indirectly');
++    is($package->get_packager(), 'Guillaume Rousse <guillomovitch at mandriva.org>', 'get packager directly');
++    is($package->get_tag('packager'), 'Guillaume Rousse <guillomovitch at mandriva.org>', 'get packager indirectly');
++    is($package->get_file_name(), 'cowsay-3.03-11mdv2007.0.noarch.rpm', 'file name');
++    is($package->get_revision(), '3.03-11mdv2007.0', 'revision');
++
++    # name formating
++    is($package->as_formated_string('%{name}-%{version}-%{release}'), 'cowsay-3.03-11mdv2007.0', 'formated string name');
++    is($package->as_string(), 'cowsay-3.03-11mdv2007.0.noarch', 'default string');
++    is($package, 'cowsay-3.03-11mdv2007.0.noarch', 'stringification');
++
++    # type
++    ok(!$package->is_source(), 'not a source package');
++    ok($package->is_binary(), 'a binary package');
++    is($package->get_type(), 'binary', 'a binary package');
++
++    # gpg key
++    is($package->get_gpg_key(), '26752624', 'get gpg key');
++
++    # dependencies
++    is_deeply(
++        [ $package->get_requires() ],
++        [
++            [ 'perl-base', undef ], 
++            [ 'perl(Cwd)', undef ],
++            [ 'perl(File::Basename)', undef ],
++            [ 'perl(Getopt::Std)', undef ],
++            [ 'perl(Text::Tabs)', undef ],
++            [ 'perl(Text::Wrap)', undef ]
++        ],
++        'requires'
++    );
++    is_deeply(
++        [ $package->get_provides() ],
++        [
++            [ 'cowsay', '== 3.03-11mdv2007.0']
++        ],
++        'provides'
++    );
++    is_deeply(
++        [ $package->get_obsoletes() ],
++        [ ],
++        'obsoletes'
++    );
++    is_deeply(
++        [ $package->get_conflicts() ],
++        [ ],
++        'conflicts'
++    );
++
++    # files
++    is_deeply(
++        [ $package->get_files() ],
++        [
++            [
++                '/etc/bash_completion.d/cowsay',
++                33188,
++                '6048be1dd827011c15cab0c3db1f438d'
++            ],
++            [
++                '/usr/bin/cowsay',
++                33261,
++                'b405026c6040eeb4781ca5c523129fe4'
++            ],
++            [
++                '/usr/bin/cowthink',
++                41471,
++                ''
++            ],
++            [
++                '/usr/share/cows',
++                16877,
++                ''
++            ],
++            [
++                '/usr/share/cows/beavis.zen.cow',
++                33188,
++                '582b2ddb72122d3aa078730abd0456b3'
++            ],
++            [
++                '/usr/share/cows/bong.cow',
++                33188,
++                '045f9bf39c027dded9a7145f619bac02'
++            ],
++            [
++                '/usr/share/cows/bud-frogs.cow',
++                33188,
++                '5c61632eb06305d613061882e1955cd2'
++            ],
++            [
++                '/usr/share/cows/bunny.cow',
++                33188,
++                '05eb914d3b96aea903542cb29f5c42c7'
++            ],
++            [
++                '/usr/share/cows/cheese.cow',
++                33188,
++                'f3618110a22d8e9ecde888c1f5e38b61'
++            ],
++            [
++                '/usr/share/cows/cower.cow',
++                33188,
++                'd73ea60eec692555a34a9f3eec981578'
++            ],
++            [
++                '/usr/share/cows/daemon.cow',
++                33188,
++                'a7dd7588ee0386a0f29e88e4881885ee'
++            ],
++            [
++                '/usr/share/cows/default.cow',
++                33188,
++                'f1206515a0f27e9d5cf09c188e46bc82'
++            ],
++            [
++                '/usr/share/cows/dragon-and-cow.cow',
++                33188,
++                '0ca99b8edd1a9d14fd231a88d9746b39'
++            ],
++            [
++                '/usr/share/cows/dragon.cow',
++                33188,
++                '448f736bf56dccafa2635e71e7485345'
++            ],
++            [
++                '/usr/share/cows/duck.cow',
++                33188,
++                'd8ffcd64667d2e3697a3e8b65e8bea9d'
++            ],
++            [
++                '/usr/share/cows/elephant-in-snake.cow',
++                33188,
++                'c5a9f406277e0e8a674bd3ffb503738f'
++            ],
++            [
++                '/usr/share/cows/elephant.cow',
++                33188,
++                'e355c72e893787376c047805d4a1fe9d'
++            ],
++            [
++                '/usr/share/cows/eyes.cow',
++                33188,
++                'b2eb5b612fae17877895aa6edafa0a5f'
++            ],
++            [
++                '/usr/share/cows/flaming-sheep.cow',
++                33188,
++                '3213cfa04a069f42d71115ca623a2f95'
++            ],
++            [
++                '/usr/share/cows/ghostbusters.cow',
++                33188,
++                'df294e6278bcb275aecb0fbd6b2546ba'
++            ],
++            [
++                '/usr/share/cows/girafe.cow',
++                33188,
++                '6d2e142313109b6a5a0a45dba0f11351'
++            ],
++            [
++                '/usr/share/cows/head-in.cow',
++                33188,
++                '365287a5d1f34a53f8716285e79c28df'
++            ],
++            [
++                '/usr/share/cows/hellokitty.cow',
++                33188,
++                'e0bbea69c4cbcfb3d799740ccc8a0b0e'
++            ],
++            [
++                '/usr/share/cows/kenny.cow',
++                33188,
++                '16ce8c334a7547197ac4c9e8a1d6ae90'
++            ],
++            [
++                '/usr/share/cows/kiss.cow',
++                33188,
++                '2a7bdd4a20741b7769af463bf09e64e8'
++            ],
++            [
++                '/usr/share/cows/kitty.cow',
++                33188,
++                '76d65a3ebfbacb16a654c1aa1af6ed27'
++            ],
++            [
++                '/usr/share/cows/koala.cow',
++                33188,
++                'cc524706707f32253dd06fc548334f11'
++            ],
++            [
++                '/usr/share/cows/kosh.cow',
++                33188,
++                'e4e28e0f472bd524fd1b44c67ae357c2'
++            ],
++            [
++                '/usr/share/cows/luke-koala.cow',
++                33188,
++                '63bbc35da73cd22b8cf25f86dcf9f870'
++            ],
++            [
++                '/usr/share/cows/mech-and-cow',
++                33188,
++                '12c0320b33704d8564dd97278d056204'
++            ],
++            [
++                '/usr/share/cows/meow.cow',
++                33188,
++                'a6092008647ed37cfe1663d10e388cbb'
++            ],
++            [
++                '/usr/share/cows/milk.cow',
++                33188,
++                'd26ac36e13e77dabb408e104fc8e0167'
++            ],
++            [
++                '/usr/share/cows/moofasa.cow',
++                33188,
++                '5fcdd4a9f3bf521c337af0a066b14512'
++            ],
++            [
++                '/usr/share/cows/moose.cow',
++                33188,
++                'dcfa09df7d2b9afa112dab374bf06e99'
++            ],
++            [
++                '/usr/share/cows/mutilated.cow',
++                33188,
++                '24cdaef0a29fb44dc673abf19a8ba631'
++            ],
++            [
++                '/usr/share/cows/phaco.cow',
++                33188,
++                'f277c1bf92ce2a3f6058955ba93758aa'
++            ],
++            [
++                '/usr/share/cows/pumpkin.cow',
++                33188,
++                'c661ea78714c1ce31559f77d73694473'
++            ],
++            [
++                '/usr/share/cows/ren.cow',
++                33188,
++                '3d7941d454779e000adc1c91e5f0b20b'
++            ],
++            [
++                '/usr/share/cows/satanic.cow',
++                33188,
++                'a69ca42a31486757ddcb322a1e68f886'
++            ],
++            [
++                '/usr/share/cows/shark.cow',
++                33188,
++                'd8950ec63abb00bbd9d96ec63637c1ac'
++            ],
++            [
++                '/usr/share/cows/sheep.cow',
++                33188,
++                '543b75f295cbd51326f5a40f111469f1'
++            ],
++            [
++                '/usr/share/cows/skeleton.cow',
++                33188,
++                '64f6ec1a0c170508e72269d533492e57'
++            ],
++            [
++                '/usr/share/cows/small.cow',
++                33188,
++                '50cb1c55628c439fc81f96db9d855252'
++            ],
++            [
++                '/usr/share/cows/sodomized.cow',
++                33188,
++                'b4888afcca51629cc3138b283608b837'
++            ],
++            [
++                '/usr/share/cows/stegosaurus.cow',
++                33188,
++                'fb0e45d101a3ecba9cf6e112facbbc7e'
++            ],
++            [
++                '/usr/share/cows/stimpy.cow',
++                33188,
++                '9b4ec6e0750ba0eeaaa432d8d3413559'
++            ],
++            [
++                '/usr/share/cows/supermilker.cow',
++                33188,
++                '316573fb585e4a6b375373c85be025b1'
++            ],
++            [
++                '/usr/share/cows/surgery.cow',
++                33188,
++                '7f25005083c1fde19d4e548c005ef000'
++            ],
++            [
++                '/usr/share/cows/telebears.cow',
++                33188,
++                '15f00abb070d9018ce6ef3441e936ef4'
++            ],
++            [
++                '/usr/share/cows/three-eyes.cow',
++                33188,
++                'c85faef9496f4a5b111bd92bfd7e7528'
++            ],
++            [
++                '/usr/share/cows/turkey.cow',
++                33188,
++                '484b5bc69c09d420d7fd5586d8570f04'
++            ],
++            [
++                '/usr/share/cows/turtle.cow',
++                33188,
++                '87eed5a00e88860b78dbec04efcdede3'
++            ],
++            [
++                '/usr/share/cows/tux.cow',
++                33188,
++                'dc1db4eac66c99179ef6adb15dd75bda'
++            ],
++            [
++                '/usr/share/cows/udder.cow',
++                33188,
++                'd97f78887c3b218a54876edc51f2963b'
++            ],
++            [
++                '/usr/share/cows/vader-koala.cow',
++                33188,
++                '7b5dd51278f0fa217a70a9b499f97a07'
++            ],
++            [
++                '/usr/share/cows/vader.cow',
++                33188,
++                '97b4ef9fc4c26082f253e9f0f35c4590'
++            ],
++            [
++                '/usr/share/cows/www.cow',
++                33188,
++                'ef4c0bc8330f329666e1705f97f283cc'
++            ],
++            [
++                '/usr/share/doc/cowsay-3.03',
++                16877,
++                ''
++            ],
++            [
++                '/usr/share/doc/cowsay-3.03/INSTALL',
++                33188,
++                '3333fd2865107626d5dffc0dbfb7e244'
++            ],
++            [
++                '/usr/share/doc/cowsay-3.03/LICENSE',
++                33188,
++                'f879dda90a5a9928253a63ecd76406e6'
++            ],
++            [
++                '/usr/share/doc/cowsay-3.03/README',
++                33188,
++                'a5c1c61e4920c278a735cdaaca62453e'
++            ],
++            [
++                '/usr/share/man/man1/cowsay.1.bz2',
++                33188,
++                '01fdd49d0b477f20099aae384fe8c1b2'
++            ],
++            [
++                '/usr/share/man/man1/cowthink.1.bz2',
++                41471,
++                ''
++            ]
++        ],
++        'files'
++    );
++
++    # changelog
++    is_deeply(
++        [ $package->get_changes() ],
++        [
++            [
++                'Guillaume Rousse <guillomovitch at mandriva.org> 3.03-11mdv2007.0',
++                1149847200,
++		'- %mkrel' . "\n" .
++		'- rpmbuildupdate aware',
++            ],
++            [
++                'Guillaume Rousse <guillomovitch at mandriva.org> 3.03-10mdk ',
++                1117879200,
++		'- fix man page (fix #16291)',
++            ],
++            [
++                'Guillaume Rousse <guillomovitch at mandrake.org> 3.03-9mdk ',
++                1090058400,
++		'- hurry businesman compliant (aka two new wonderful cows)',
++            ],
++            [
++                'Guillaume Rousse <guillomovitch at mandrake.org> 3.03-8mdk ',
++                1089540000,
++		'- apologies to the girafes (with one only f)',
++            ],
++            [
++                'Guillaume Rousse <guillomovitch at mandrake.org> 3.03-7mdk ',
++                  1086429600,
++		'- #mandrakefr compliant (aka four new additional cows)',
++            ],
++            [
++                'Guillaume Rousse <guillomovitch at linux-mandrake.com> 3.03-6mdk',
++                1061460000,
++		'- save.the.world patch',
++            ]
++        ],
++        'changelog'
++    );
++    is_deeply(
++        $package->get_last_change(),
++        [
++            'Guillaume Rousse <guillomovitch at mandriva.org> 3.03-11mdv2007.0',
++            1149847200,
++	    '- %mkrel' . "\n" .
++	    '- rpmbuildupdate aware',
++        ],
++        'last change'
++    );
++    is($package->compare($package), 0, 'compare');
++
++    # signature test
++    system('cp', $file, $temp_dir);
++    $package = $class->new(file => "$temp_dir/$rpm");
++
++    $package->sign('Youri', 't/gpghome', 'Youri rulez');
++
++    $package = $class->new(file => "$temp_dir/$rpm");
++    is($package->get_gpg_key(), '2333e817', 'get gpg key');
++}
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/package.t
+___________________________________________________________________
+Added: svn:executable
+   + *
+
+Added: build_system/mdv-youri-core/trunk/t/version.t
+===================================================================
+--- build_system/mdv-youri-core/trunk/t/version.t	                        (rev 0)
++++ build_system/mdv-youri-core/trunk/t/version.t	2011-01-05 13:23:45 UTC (rev 210)
+@@ -0,0 +1,71 @@
++#!/usr/bin/perl
++# $Id: version.t 1179 2006-08-05 08:30:57Z warly $
++
++use Test::More;
++use Youri::Check::Input::Updates;
++use strict;
++
++my @differents = (
++    [ '3.0.0', '1.0.0' ],
++    [ '3.0.0', '1.99.9' ],
++    [ '3.0.1', '3.0' ],
++    [ '3.0pl1', '3.0' ],
++    [ '3.0', '3.0beta1' ],
++    [ '3.0', '3.0beta' ],
++    [ '3.0', '3.0alpha1' ],
++    [ '3.0', '3.0alpha' ],
++    [ '3.0', '3.0pre1' ],
++    [ '3.0', '3.0pre' ],
++    [ '3.0pre', '3.0beta' ],
++    [ '3.0beta', '3.0alpha' ],
++    [ '1.0.0-p1', '1.0.0RC1' ],
++    [ '0.9.7f', '0.9.7e' ],
++    [ '10', '9' ],
++);
++
++my @equals = (
++    [ '1.0.0', '1.0.0' ],
++    [ '0.9Beta1', '0.9beta1' ],
++    [ '0.9beta1', '0.9 beta 1' ],
++    [ '0.3-alpha', '0.3_alpha' ],
++    [ '0.02', '.02' ],
++    [ '2.0.11', '15aug2000' ],
++    [ '2.0.11', '20060401' ],
++    [ '20', '20060401' ],
++);
++
++plan tests => 2 * @differents + 2 * @equals;
++
++foreach my $different (@differents) {
++    ok(
++        Youri::Check::Input::Updates::is_newer(
++	    $different->[0],
++	    $different->[1]
++	),
++        "$different->[0] is newer as $different->[1]"
++    );
++    ok(
++        !Youri::Check::Input::Updates::is_newer(
++	    $different->[1],
++	    $different->[0]
++	),
++        "$different->[1] is older as $different->[0]"
++    );
++}
++
++foreach my $equal (@equals) {
++    ok(
++        !Youri::Check::Input::Updates::is_newer(
++	    $equal->[0],
++	    $equal->[1]
++	),
++        "$equal->[0] is equal as $equal->[1]"
++    );
++    ok(
++        !Youri::Check::Input::Updates::is_newer(
++	    $equal->[1],
++	    $equal->[0]
++	),
++        "$equal->[1] is equal as $equal->[0]"
++    );
++}
+
+
+Property changes on: build_system/mdv-youri-core/trunk/t/version.t
+___________________________________________________________________
+Added: svn:executable
+   + *
+-------------- next part --------------
+An HTML attachment was scrubbed...
+URL: </pipermail/mageia-sysadm/attachments/20110105/797a51f6/attachment-0001.html>
+