get_context_id_by_dir: add function1.4

1 files changed, 25 insertions, 1 deletions

diff --git a/lib/VServer.pm b/lib/VServer.pm
index c0ba688..b586a9e 100644
--- a/lib/VServer.pm
+++ b/lib/VServer.pm
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -T
 
 package VServer;
-our $VERSION = '1.3';
+our $VERSION = '1.4';
 
 use strict;
 use warnings;
@@ -29,6 +29,22 @@ sub get_context_id_by_name($) {
     return $cid;
 }
 
+sub get_context_id_by_dir($) {
+    my $dir = shift;
+    my $id = undef;
+
+    open(my $info, "<", "$dir/info") || return undef;
+    while (<$info>) {
+        if ($_ =~ m/^ID:\s*([0-9.]+)$/) {
+            $id = $1;
+            last;
+        }
+    }
+    close($info);
+
+    return $id;
+}
+
 sub get_proc_dir($) {
     my $context = shift;
     my $dir = "/proc/virtual/$context/";
@@ -93,6 +109,14 @@ Returns the context id for a vserver given by its name. If an
 invalid name is supplied or any other error occurs, B<undef>
 is returned.
 
+=item B<get_context_id_by_dir($proc_dir)>
+
+Returns the context id for a vserver given by the path in the
+I</proc/virtual/> tree. This could be done by parsing the path,
+but the function uses the I<info> file and parsing the C<ID:> line.
+If the I<info> file is not found or does not contain a line starting
+with C<ID:>, B<undef> is returned.
+
 =item B<get_proc_dir($context)>
 
 Build the directory in C</proc/virtual/> for the given context id.