File Coverage

blib/lib/OpenVZ/BC.pm
Criterion Covered Total %
statement 0 30 0.0
branch 0 6 0.0
condition 0 6 0.0
subroutine 0 2 0.0
pod 2 2 100.0
total 2 46 4.3


line stmt bran cond sub pod time code
1             package OpenVZ::BC;
2              
3             our $VERSION = '0.02';
4             our $default_bc_file = '/proc/bc/resources';
5              
6             =pod
7              
8             =head1 NAME
9              
10             OpenVZ::BC - Perl access to OpenVZ Beancounter Data
11              
12             =head1 SYNOPSIS
13              
14             use OpenVZ::BC;
15             my $bc = OpenVZ::BC->new;
16             my $resources = $bc->hash;
17              
18             =head1 DESCRIPTION
19              
20             Gives Perl access to OpenVZ beancounter data. This data is typically stored
21             in /proc/user_beancounters or /proc/bc/resources. By default, we use
22             /proc/bc/resources, but this can be overridden as described below.
23              
24             =head1 INTERFACE
25              
26             =head2 new
27              
28             my $bc = OpenVZ::BC->new;
29            
30             my $bc = OpenVZ::BC->new(
31             bc_file => '/proc/user_beancounters',
32             );
33              
34             Creates the new OpenVZ::BC object.
35              
36             =over 4
37              
38             =item bc_file [optional]
39              
40             If you specify bc_file here, it will override the default location. Currently
41             that default location is /proc/bc/resources. Specified here, it will define
42             the default location of this file for any methods used below.
43              
44             =back
45              
46             =cut
47              
48             sub new
49             {
50 0     0 1   my $class = shift;
51 0           my %args = @_;
52 0           my $self = {};
53 0   0       $self->{bc_file} = $args{bc_file} || $default_bc_file;
54 0           bless($self, $class);
55 0           return $self;
56             }
57              
58             =pod
59              
60             =head2 hash
61              
62             my $resources = $bc->hash;
63            
64             my $resources = $bc->hash(
65             bc_file => '/proc/user_beancounters',
66             );
67            
68             my $resources = OpenVZ::BC->hash;
69            
70             my $resources = OpenVZ::BC->hash(
71             bc_file => '/proc/user_beancounters',
72             );
73              
74             This returns a hashref containing the beancounter data from the default or
75             specified file. If accessed via the $bc object, it will use the default
76             specified in that object. If you use it via the class directly, it will use
77             the class default.
78              
79             =over 4
80              
81             =item bc_file [optional]
82              
83             If you specify bc_file here, it will override the default location of either
84             the $bc object and/or the class.
85              
86             =back
87              
88             =cut
89              
90             sub hash
91             {
92 0     0 1   my $self = shift;
93 0           my %args = @_;
94 0   0       my $bc_file = $args{bc_file} || $self->{bc_file} || $default_bc_file;
95 0           my $bc = {};
96              
97 0 0         if (open(BC, "<$bc_file"))
98             {
99 0           my $vpsid;
100 0           ; # skip the version
101 0           my $columns = ; # grab the columns
102 0           my @columns = split(/\s+/, $columns);
103 0           shift(@columns); # skip the blank column
104 0           shift(@columns); # skip the uid column
105 0           shift(@columns); # skip the resource column
106 0           while (my $line = )
107             {
108 0 0         if ($line =~ s/^\s+(\d+)://)
109             {
110 0           $vpsid = $1;
111             }
112 0 0         next if ($vpsid eq '');
113 0           my @data = split(/\s+/, $line);
114 0           shift(@data); # skip the blank column
115 0           my $resource = shift(@data);
116 0           foreach my $column (@columns)
117             {
118 0           $bc->{$vpsid}->{$resource}->{$column} = shift(@data);
119             }
120             }
121 0           close(BC);
122             }
123             else
124             {
125 0           die(qq(Unable to open $bc_file for read: $!\n));
126             }
127              
128 0           return $bc;
129             }
130              
131             =pod
132              
133             =head1 TODO
134              
135             Provide access to the /proc/bc//resources files to access a single
136             VPS beancounters instead of reading the full server's beancounters. This
137             would involve adding new methods. Patches are welcome.
138              
139             =head1 AUTHOR
140              
141             Dusty Wilson
142             Megagram Managed Technical Services
143             http://www.megagram.com/
144              
145             =head1 COPYRIGHT
146              
147             This program is free software; you can redistribute
148             it and/or modify it under the same terms as Perl itself.
149              
150             The full text of the license can be found in the
151             LICENSE file included with this module.
152              
153             =cut
154              
155             1;