diff options
Diffstat (limited to 'lib/Youri/Media.pm')
| -rw-r--r-- | lib/Youri/Media.pm | 311 |
1 files changed, 311 insertions, 0 deletions
diff --git a/lib/Youri/Media.pm b/lib/Youri/Media.pm new file mode 100644 index 0000000..a9d9521 --- /dev/null +++ b/lib/Youri/Media.pm @@ -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; |