Xenできる人がXenXenいない（いやマジで）

おじさんが転職した先でLinuxのCLIをいじれる人がマジでいなくてビビっている。サーバ管理でスクリプトなんで作っていいかとビビっているんだけれども、サーバに潜ると過去の遺産的なシェルスクリプトとかも残っていて、そのスクリプトを作った専門家がいないならいないなりで何となく修正しているみたいだから、たとえPerlで書いたとしてもPerl特有の省略記法さえやめればメンテナンスできるってことだよね、と考え、平易な記述を心がけて書くなり。

XenServerのホストから子サーバを制御するxeコマンドっていうやつがあるんだけれども、それの出力がシェルスクリプトで扱いにくいので、簡易パーサを作りました。

Filename: xenserver-snapshot-list-parser.pl

#!/usr/bin/perl

# Citrix XenServer 5.6/6.02用の xe snapshot-list の簡易パーサ
#
# XenServerじゃないXenのばあい、xeコマンドではなくxmコマンド
# なのでテストしていないけれども、＿＿DATA＿＿以降の書式が
# 同じなら使えると思います。

use 5.8.8; # XenServer 5.6/6.2のDom-0に入るSystem Perlは 5.8.8
use strict;
use warnings;
use Data::Dumper;

my $res = [];
my $tmp = {};
my $mkey = '';

while (<DATA>) { # _DATA_ 行以降をファイルとして読み込み
  # Whileによって、$_ に1行ごと読み込まれる。
  # Perl読めない人向けに明示的に$_を書く

  $_ =~ tr/\x0D\x0A//d; # 改行コードを念のために除去（chompよりも確実に）
  $_ = trim( $_ );

  if ( $_ =~ m/^$/ ) { # 改行が区切り
    if ( $mkey ne '' ) {
      push @$res, $tmp;
      $tmp  = {};
      $mkey = '';
    }
  }
  else { # 区切りじゃない場合
    my ($key, $value) = split ':', $_, 2;
    my $type;
    ($key, $type) = split '\(', $key, 2;
    $type  =~ s/\)//;
    $type  = trim( $type );
    $key   = trim( $key );
    $value = trim( $value );
    if ( $mkey eq '' ) {
      $mkey = $value;
    }
    # ( R*):通常のパラメータ (SR*):setパラメータ (MR*):mapパラメータ で分岐
    if ( $type =~ m/S/i ) { # typeがS（setパラメータ）の場合
      my $tmp = [];
      foreach my $item ( split ';', $value ) {
        push @$tmp, trim($item);
      }
      $value = $tmp;
    }
    elsif ($type =~ m/M/i ){ # typeかM（mapパラメータ）の場合
      my $tmp = {};
      foreach my $item ( split ';', $value ) {
        my ( $key, $value ) = split ':', $item, 2;
        $tmp->{ trim( $key ) } = trim( $value );
      }
      $value = $tmp;
    }
    $tmp->{$key} = $value;
  }
}
# ファイル読み込みループ終わり
if ( $mkey ne '' ) { # まだ格納していないアイテムがある場合
  push @$res, $tmp;
} # つまり最後の行の改行があるかないか、ていう問題

print Dumper $res;
exit;

# use String::Util qw(trim); が使えない環境での代替trim()
sub trim {
  my $val = shift;
  $val =~ s/^\s*(.*?)\s*$/$1/;
  return $val;
}

__DATA__
uuid ( RO)                     : abcdef01-2345-6789-abcd-ef0123456789
               name-label ( RW): snapshot-001-20130414
         name-description ( RW):
    is-snapshot-from-vmpp ( RO): false


uuid ( RO)                     : bcdef012-3456-789a-bcde-f0123456789a
               name-label ( RW): snapshot-20130414
         name-description ( RW):
    is-snapshot-from-vmpp ( RO): false


uuid ( RO)                     : cdef0123-4567-89ab-cdef-0123456789ab
               name-label ( RW): snapshot-001
         name-description ( RW):
    is-snapshot-from-vmpp ( RO): false

出力：

$ perl xenserver-snapshot-list-parser.pl
$VAR1 = [
          {
            'name-description' => '',
            'name-label' => 'snapshot-001-20130414',
            'is-snapshot-from-vmpp' => 'false',
            'uuid' => 'abcdef01-2345-6789-abcd-ef0123456789'
          },
          {
            'name-description' => '',
            'name-label' => 'snapshot-20130414',
            'is-snapshot-from-vmpp' => 'false',
            'uuid' => 'bcdef012-3456-789a-bcde-f0123456789a'
          },
          {
            'name-description' => '',
            'name-label' => 'snapshot-001',
            'is-snapshot-from-vmpp' => 'false',
            'uuid' => 'cdef0123-4567-89ab-cdef-0123456789ab'
          }
        ];
$

データ構造体になってくれたらあとはgrepで絞り込んだりしていろいろ出来るよね。おじさんとしては、サーバのスナップショットの世代管理をしたいと思っています。