diff options
Diffstat (limited to 'zarb-ml/mageia-sysadm/2011-January/001513.html')
| -rw-r--r-- | zarb-ml/mageia-sysadm/2011-January/001513.html | 11447 |
1 files changed, 11447 insertions, 0 deletions
diff --git a/zarb-ml/mageia-sysadm/2011-January/001513.html b/zarb-ml/mageia-sysadm/2011-January/001513.html new file mode 100644 index 000000000..46a37a5b0 --- /dev/null +++ b/zarb-ml/mageia-sysadm/2011-January/001513.html @@ -0,0 +1,11447 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> +<HTML> + <HEAD> + <TITLE> [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 + </TITLE> + <LINK REL="Index" HREF="index.html" > + <LINK REL="made" HREF="mailto:mageia-sysadm%40mageia.org?Subject=Re%3A%20%5BMageia-sysadm%5D%20%5B210%5D%20add%20mandriva%20version%20of%20youri-core%2C%0A%20downloaded%20from%20http%3A//svn.%0A%20mandriva.com/svn/soft/build_system/youri/core/trunk/%20at%20revision%20271600&In-Reply-To=%3C20110105132345.9727D41942%40valstar.mageia.org%3E"> + <META NAME="robots" CONTENT="index,nofollow"> + <META http-equiv="Content-Type" content="text/html; charset=us-ascii"> + <LINK REL="Previous" HREF="001512.html"> + <LINK REL="Next" HREF="001514.html"> + </HEAD> + <BODY BGCOLOR="#ffffff"> + <H1>[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</H1> + <B>root at mageia.org</B> + <A HREF="mailto:mageia-sysadm%40mageia.org?Subject=Re%3A%20%5BMageia-sysadm%5D%20%5B210%5D%20add%20mandriva%20version%20of%20youri-core%2C%0A%20downloaded%20from%20http%3A//svn.%0A%20mandriva.com/svn/soft/build_system/youri/core/trunk/%20at%20revision%20271600&In-Reply-To=%3C20110105132345.9727D41942%40valstar.mageia.org%3E" + TITLE="[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">root at mageia.org + </A><BR> + <I>Wed Jan 5 14:23:45 CET 2011</I> + <P><UL> + <LI>Previous message: <A HREF="001512.html">[Mageia-sysadm] [209] add mandriva version of youri-submit, downloaded from http://svn. mandriva.com/svn/soft/build_system/youri/submit/trunk at revision 271600 +</A></li> + <LI>Next message: <A HREF="001514.html">[Mageia-sysadm] [654] Add ssh key for pterjan. +</A></li> + <LI> <B>Messages sorted by:</B> + <a href="date.html#1513">[ date ]</a> + <a href="thread.html#1513">[ thread ]</a> + <a href="subject.html#1513">[ subject ]</a> + <a href="author.html#1513">[ author ]</a> + </LI> + </UL> + <HR> +<!--beginarticle--> +<PRE>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 <A HREF="http://svn.mandriva.com/svn/soft/build_system/youri/core/trunk/">http://svn.mandriva.com/svn/soft/build_system/youri/core/trunk/</A> 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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at zarb.org</A>> 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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">youri at zarb.org</A>>', ++ 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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at zarb.org</A>>, ++Pascal Terjan <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">pterjan at zarb.org</A>> ++Damien Krotkine <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">dams at zarb.org</A>> ++Olivier Thauvin <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">nanardon at zarb.org</A>> ++Ville Skytt\xE4 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">ville.skytta at iki.fi</A>> + +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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at zarb.org</A>> ++# $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 => '<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">bugmaster at zarb.org</A>', ++ 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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at zarb.org</A>>, ++ ++=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 = <A HREF="ftp://ftp.free.fr/pub/Distributions_Linux/Mandrakelinux/devel/cooker">ftp://ftp.free.fr/pub/Distributions_Linux/Mandrakelinux/devel/cooker</A> ++mirror_i586 = $mirror/i586/media ++mirror_x86_64 = $mirror/x86_64/media ++ ++# resolver definition ++[cgi] ++class = Youri::Check::Maintainer::Resolver::CGI ++url = <A HREF="http://plf.zarb.org/cgi-bin/maintainers.cgi">http://plf.zarb.org/cgi-bin/maintainers.cgi</A> ++ ++# 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: <A HREF="http://eijk.homelinux.org/build/">http://eijk.homelinux.org/build/</A> ++ 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 = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf-admin at zarb.org</A> ++from = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf at zarb.org</A> ++reply_to = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf-admin at zarb.org</A> ++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: '<\<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">w+ at zarb</A>\.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 = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf at zarb.org</A> ++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 = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf-announce at zarb.org</A> ++reply_to = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf-discuss at zarb.org</A> ++from = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf at zarb.org</A> ++prefix = RPM ++cc = <<EOF ++--- #YAML:1.0 ++hot-base: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">david at dindinx.org</A> <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">bellamy at neverland.net</A> ++dcgui: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">mathen at ketelhot.de</A> ++dclib: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">mathen at ketelhot.de</A> ++Video-DVDRip: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">dvdrip-users at exit1.org</A> ++hackVideo-DVDRip: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">dvdrip-users at exit1.org</A> ++goosnes: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">tak at bard.sytes.net</A> ++avidemux: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">fixounet at free.fr</A> ++vobcopy: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">robos at muon.de</A> ++drip: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">drip-devel at lists.sourceforge.net</A> ++libdscaler: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">vektor at dumbterm.net</A> ++xawdecode: <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">pingus77 at ifrance.com</A> ++EOF ++ ++[rss] ++class = Youri::Upload::Action::RSS ++file = ${HOME}/www/changelog.rss ++title = PLF packages updates ++link = <A HREF="http://plf.zarb.org/">http://plf.zarb.org/</A> ++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 = <A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">plf at zarb.org</A> + +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: ++<A HREF="http://qa.mandriva.com/build/iurt/cooker">http://qa.mandriva.com/build/iurt/cooker</A>) ++ ++=back ++ ++=cut ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://qa.mandriva.com/build/iurt/cooker">http://qa.mandriva.com/build/iurt/cooker</A>', ++ @_ ++ ); ++ ++ $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: <A HREF="http://eijk.homelinux.org/build">http://eijk.homelinux.org/build</A>) ++ ++=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 => '<A HREF="http://eijk.homelinux.org/build">http://eijk.homelinux.org/build</A>', ++ 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: ++<A HREF="http://www.cpan.org/modules/01modules.index.html">http://www.cpan.org/modules/01modules.index.html</A>) ++ ++=back ++ ++=cut ++ ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://www.cpan.org/modules/01modules.index.html">http://www.cpan.org/modules/01modules.index.html</A>', ++ @_ ++ ); ++ ++ 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 "<A HREF="http://search.cpan.org/dist/$name">http://search.cpan.org/dist/$name</A>"; ++} ++ ++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: <A HREF="http://ftp.debian.org/ls-lR.gz">http://ftp.debian.org/ls-lR.gz</A>) ++ ++=back ++ ++=cut ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://ftp.debian.org/ls-lR.gz">http://ftp.debian.org/ls-lR.gz</A>', ++ @_ ++ ); ++ ++ 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 "<A HREF="http://packages.debian.org/$name">http://packages.debian.org/$name</A>"; ++} ++ ++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: ++<A HREF="http://fr.rpmfind.net/linux/fedora/core/development/SRPMS">http://fr.rpmfind.net/linux/fedora/core/development/SRPMS</A>) ++ ++=back ++ ++=cut ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://fr.rpmfind.net/linux/fedora/core/development/SRPMS">http://fr.rpmfind.net/linux/fedora/core/development/SRPMS</A>', ++ @_ ++ ); ++ ++ 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 = '<A HREF="http://download.freshmeat.net/backend/fm-projects.rdf.bz2">http://download.freshmeat.net/backend/fm-projects.rdf.bz2</A>'; ++ ++ 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 = "<A HREF="http://freshmeat.net/projects-xml/$name">http://freshmeat.net/projects-xml/$name</A>"; ++ ++ 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 "<A HREF="http://freshmeat.net/projects/$name">http://freshmeat.net/projects/$name</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/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: ++<A HREF="http://fr2.rpmfind.net/linux/gnome.org/sources">http://fr2.rpmfind.net/linux/gnome.org/sources</A>) ++ ++=back ++ ++=cut ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://fr2.rpmfind.net/linux/gnome.org/sources/">http://fr2.rpmfind.net/linux/gnome.org/sources/</A>', # 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: ++<A HREF="http://gentoo.mirror.sdv.fr/snapshots">http://gentoo.mirror.sdv.fr/snapshots</A>) ++ ++=back ++ ++=cut ++ ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://gentoo.mirror.sdv.fr/snapshots">http://gentoo.mirror.sdv.fr/snapshots</A>', # 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 "<A HREF="http://packages.gentoo.org/search/?sstring=$name">http://packages.gentoo.org/search/?sstring=$name</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/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: ++<A HREF="http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4">http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4</A>) ++ ++=back ++ ++=cut ++ ++sub _init { ++ my $self = shift; ++ my %options = ( ++ url => '<A HREF="http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4/">http://www.ruby-lang.org/xmlns/soap/interface/RAA/0.0.4/</A>', ++ @_ ++ ); ++ ++ 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 "<A HREF="http://raa.ruby-lang.org/project/$name/">http://raa.ruby-lang.org/project/$name/</A>"; ++} ++ ++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 "<A HREF="http://prdownloads.sourceforge.net/$name/">http://prdownloads.sourceforge.net/$name/</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/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(''<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">, at v1</A>) eq (join ''<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">, at v2</A>)) { ++ # 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(), '<A HREF="http://www.nog.net/~tony/warez/cowsay.shtml">http://www.nog.net/~tony/warez/cowsay.shtml</A>', 'get url directly'); ++ is($package->get_tag('url'), '<A HREF="http://www.nog.net/~tony/warez/cowsay.shtml">http://www.nog.net/~tony/warez/cowsay.shtml</A>', 'get url indirectly'); ++ is($package->get_packager(), 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandriva.org</A>>', 'get packager directly'); ++ is($package->get_tag('packager'), 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandriva.org</A>>', '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 <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandriva.org</A>> 3.03-11mdv2007.0', ++ 1149847200, ++ '- %mkrel' . "\n" . ++ '- rpmbuildupdate aware', ++ ], ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandriva.org</A>> 3.03-10mdk ', ++ 1117879200, ++ '- fix man page (fix #16291)', ++ ], ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandrake.org</A>> 3.03-9mdk ', ++ 1090058400, ++ '- hurry businesman compliant (aka two new wonderful cows)', ++ ], ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandrake.org</A>> 3.03-8mdk ', ++ 1089540000, ++ '- apologies to the girafes (with one only f)', ++ ], ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandrake.org</A>> 3.03-7mdk ', ++ 1086429600, ++ '- #mandrakefr compliant (aka four new additional cows)', ++ ], ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at linux-mandrake.com</A>> 3.03-6mdk', ++ 1061460000, ++ '- save.the.world patch', ++ ] ++ ], ++ 'changelog' ++ ); ++ is_deeply( ++ $package->get_last_change(), ++ [ ++ 'Guillaume Rousse <<A HREF="https://www.mageia.org/mailman/listinfo/mageia-sysadm">guillomovitch at mandriva.org</A>> 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> +</PRE> + + + + + + + + + +<!--endarticle--> + <HR> + <P><UL> + <!--threads--> + <LI>Previous message: <A HREF="001512.html">[Mageia-sysadm] [209] add mandriva version of youri-submit, downloaded from http://svn. mandriva.com/svn/soft/build_system/youri/submit/trunk at revision 271600 +</A></li> + <LI>Next message: <A HREF="001514.html">[Mageia-sysadm] [654] Add ssh key for pterjan. +</A></li> + <LI> <B>Messages sorted by:</B> + <a href="date.html#1513">[ date ]</a> + <a href="thread.html#1513">[ thread ]</a> + <a href="subject.html#1513">[ subject ]</a> + <a href="author.html#1513">[ author ]</a> + </LI> + </UL> + +<hr> +<a href="https://www.mageia.org/mailman/listinfo/mageia-sysadm">More information about the Mageia-sysadm +mailing list</a><br> +</body></html> |