Linux-IO_Prio-0.03/0002755000175000000500000000000011671404723012333 5ustar marksrcLinux-IO_Prio-0.03/Changes0000644000175000000500000000072411671404650013626 0ustar marksrcRevision history for Perl extension Linux::IO_Prio. 0.01 Mon Nov 7 18:15:36 2011 - original version; created by h2xs 1.23 with options -b5.10.0 -AX Linux::IO_Prio --skip-autoloader 0.02 Mon Dec 5 10:22:12 2011 - fix t/implemented.t to cope with missing syscall.ph - try to load sys/syscall.ph as well - only run t/implemented.t on Linux 0.03 Mon Dec 12 13:59:12 2011 - fix syscall arguments on non-Linux OS - rework tests: most combined into t/api.t Linux-IO_Prio-0.03/lib/0002755000175000000500000000000011671404723013101 5ustar marksrcLinux-IO_Prio-0.03/lib/Linux/0002755000175000000500000000000011671404723014200 5ustar marksrcLinux-IO_Prio-0.03/lib/Linux/IO_Prio.pm0000644000175000000500000001207311671403711016033 0ustar marksrcpackage Linux::IO_Prio; use strict; use warnings; require Exporter; use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION); use POSIX qw(ENOSYS); use Carp; $VERSION = '0.03'; @ISA = qw(Exporter); %EXPORT_TAGS = (ionice => [qw(&ionice &ionice_class &ionice_data)], c_api => [qw(&ioprio_set &ioprio_get)], macros => [qw(IOPRIO_PRIO_VALUE IOPRIO_PRIO_CLASS IOPRIO_PRIO_DATA)], who => [qw(IOPRIO_WHO_PROCESS IOPRIO_WHO_PGRP IOPRIO_WHO_USE)], class => [qw(IOPRIO_CLASS_NONE IOPRIO_CLASS_RT IOPRIO_CLASS_BE IOPRIO_CLASS_IDLE)] ); # The tag lists are exclusive at the moment, so don't worry about duplicates. push @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; Exporter::export_ok_tags($_) foreach keys %EXPORT_TAGS; use constant IOPRIO_CLASS_SHIFT => 13; use constant IOPRIO_PRIO_MASK => ((1 << IOPRIO_CLASS_SHIFT) - 1); use constant { IOPRIO_WHO_PROCESS => 1, IOPRIO_WHO_PGRP => 2, IOPRIO_WHO_USER => 3 }; use constant { IOPRIO_CLASS_NONE => 0, IOPRIO_CLASS_RT => 1, IOPRIO_CLASS_BE => 2, IOPRIO_CLASS_IDLE => 3 }; if ($^O eq 'linux') { _load_syscall(); } else { warn "Linux::IO_Prio: unsupported operating system -- $^O\n"; } # Load syscall.ph sub _load_syscall { return eval{require('syscall.ph') || require('sys/syscall.ph')}; } # C API functions # int ioprio_get(int which, int who); sub ioprio_get { my ($which, $who) = @_; if (defined &SYS_ioprio_get) { return syscall(SYS_ioprio_get(), $which, $who); } else { return _not_implemented(); } } # int ioprio_set(int which, int who, int ioprio); sub ioprio_set { my ($which, $who, $ioprio) = @_; if (defined &SYS_ioprio_set) { return syscall(SYS_ioprio_set(), $which, $who, $ioprio); } else { return _not_implemented(); } } # C API Macros sub IOPRIO_PRIO_VALUE { my ($class, $data) = @_; return ($class << IOPRIO_CLASS_SHIFT) | $data; } sub IOPRIO_PRIO_CLASS { my ($mask) = @_; return ($mask >> IOPRIO_CLASS_SHIFT); } sub IOPRIO_PRIO_DATA { my ($mask) = @_; return ($mask & IOPRIO_PRIO_MASK); } # Wrapper functions sub ionice { my ($which, $who, $class, $data) = @_; carp "Data not permitted for class IOPRIO_CLASS_IDLE" if $class == IOPRIO_CLASS_IDLE && $data; return ioprio_set($which, $who, IOPRIO_PRIO_VALUE($class, $data)); } sub ionice_class { my ($which, $who) = @_; if((my $priority = ioprio_get($which, $who)) < 0) { return $priority; } else { return IOPRIO_PRIO_CLASS($priority); } } sub ionice_data { my ($which, $who) = @_; if((my $priority = ioprio_get($which, $who)) < 0) { return $priority; } else { return IOPRIO_PRIO_DATA($priority); } } # Stub for not implemented sub _not_implemented { $! = ENOSYS; return -1; } 1; __END__ =head1 NAME Linux::IO_Prio - Interface to Linux ioprio_set and ioprio_get via syscall or ionice wrapper. =head1 SYNOPSIS use Linux::IO_Prio qw(:all); my $status = ioprio_set(IOPRIO_WHO_PROCESS, $$, IOPRIO_PRIO_VALUE(IOPRIO_CLASS_IDLE, 0)); my $status = ionice(IOPRIO_WHO_PROCESS, $$, IOPRIO_CLASS_IDLE, 0); =head1 DESCRIPTION Use L and L from Perl. Only Linux is supported currently. Support for other unices will be added once the kernel capabilities are available. =head1 Exports Nothing by default. The required exports can be specified individually or by tag: =over 4 =item :ionice -- ionice ionice_data ionice_class =item :c_api -- ioprio_set ioprio_get =item :macro -- IOPRIO_PRIO_VALUE IOPRIO_PRIO_CLASS IOPRIO_PRIO_DATA =item :who -- IOPRIO_WHO_PROCESS IOPRIO_WHO_PGRP IOPRIO_WHO_USER =item :class -- IOPRIO_CLASS_NONE IOPRIO_CLASS_RT IOPRIO_CLASS_BE IOPRIO_CLASS_IDLE =item :all -- all the above =back ionice(), ionice_class() and ionice_data() are thin wrappers around the C API allowing conventient single function calls. All of the other exports have the same meaning and prototypes as the C API equivalents. See man L for further details. =head2 Functions =head3 C API =over =item $priority = ioprio_get($which, $who) =item $staus = ioprio_set($which, $who, $priority) =back =head3 Wrappers =over =item $status = ionice($which, $who, $class, $data) =item $class = ionice_class($which, $who) =item $data = ionice_data($which, $who) =back =head2 MACROS =over 4 =item $priority = IOPRIO_PRIO_VALUE($class, $data) =item $class = IOPRIO_PRIO_CLASS($mask) =item $data = IOPRIO_PRIO_DATA ($mask) =back =head2 CONSTANTS =over 4 =item IOPRIO_WHO_PROCESS =item IOPRIO_WHO_PGRP =item IOPRIO_WHO_USER =item IOPRIO_CLASS_NONE =item IOPRIO_CLASS_RT =item IOPRIO_CLASS_BE =item IOPRIO_CLASS_IDLE =back =head1 COPYRIGHT This module is Copyright (c) 2011 Mark Hindley All rights reserved. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. If you need more liberal licensing terms, please contact the maintainer. =head1 WARRANTY This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND. =head1 AUTHOR Mark Hindley Linux-IO_Prio-0.03/README0000644000175000000500000000176411665154752013230 0ustar marksrcLinux-IO_Prio version 0.01 ======================== Linux-IO_Prio is a perl module which provides access to the Linux functions ioprio_get(2) and ioprio_set(2). There are also ionice functions and which provide slightly more convenient perlish interface than the C API. Currently there is Linux support. Other operating systems are not supported due to kernel limitations. However support will be added as the kernel capability becomes available. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires only core modules. However it does require a valid syscall.ph file which is more dependent on the vendor distribution. COPYRIGHT AND LICENCE All rights reserved. Copyright (C) 2011 by Mark Hindley This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. Linux-IO_Prio-0.03/META.yml0000644000175000000500000000110611671404723013600 0ustar marksrc--- #YAML:1.0 name: Linux-IO_Prio version: 0.03 abstract: Interface to Linux ioprio_set and ioprio_get via syscall or ionice wrapper. author: - Mark Hindley license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Linux-IO_Prio-0.03/MANIFEST0000644000175000000500000000026011671404723013460 0ustar marksrcChanges lib/Linux/IO_Prio.pm Makefile.PL MANIFEST This list of files README t/0_load.t t/api.t META.yml Module meta-data (added by MakeMaker) Linux-IO_Prio-0.03/Makefile.PL0000644000175000000500000000111611665154752014311 0ustar marksrcuse 5.010000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Linux::IO_Prio', VERSION_FROM => 'lib/Linux/IO_Prio.pm', # finds $VERSION PREREQ_PM => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Linux/IO_Prio.pm', # retrieve abstract from module LICENSE => 'perl', AUTHOR => 'Mark Hindley ') : ()), ); Linux-IO_Prio-0.03/t/0002755000175000000500000000000011671404723012576 5ustar marksrcLinux-IO_Prio-0.03/t/0_load.t0000644000175000000500000000016511671111404014110 0ustar marksrc######################### use Test::More tests => 1; BEGIN { use_ok('Linux::IO_Prio') }; ######################### Linux-IO_Prio-0.03/t/api.t0000644000175000000500000000165411671403052013532 0ustar marksrcuse Test::More; use Linux::IO_Prio qw(:all); use POSIX qw(ENOSYS); if( $^O eq 'linux' && Linux::IO_Prio::_load_syscall()) { plan tests => 5; ok(ioprio_set(IOPRIO_WHO_PROCESS, $$, IOPRIO_PRIO_VALUE(IOPRIO_CLASS_IDLE, 0)) == 0); ok(ioprio_get(IOPRIO_WHO_PROCESS, $$) >= 0); ok(ionice(IOPRIO_WHO_PROCESS, $$, IOPRIO_CLASS_IDLE, 0) == 0); ok(ionice_class(IOPRIO_WHO_PROCESS, $$) == IOPRIO_CLASS_IDLE); ok(ionice_data(IOPRIO_WHO_PROCESS, $$) == 0); } else { plan tests => 10; ok(ioprio_set(IOPRIO_WHO_PROCESS, $$, IOPRIO_PRIO_VALUE(IOPRIO_CLASS_IDLE, 0)) == -1); ok($! == ENOSYS); ok(ioprio_get(IOPRIO_WHO_PROCESS, $$) == -1); ok($! == ENOSYS); ok(ionice(IOPRIO_WHO_PROCESS, $$, IOPRIO_CLASS_IDLE, 0) == -1); ok($! == ENOSYS); ok(ionice_class(IOPRIO_WHO_PROCESS, $$) == -1); ok($! == ENOSYS); ok(ionice_data(IOPRIO_WHO_PROCESS, $$) == -1); ok($! == ENOSYS); };