Perl コードの例

このセクションでは、exacct ファイルにアクセスするための Perl コードの例を示します。

使用例 6  疑似コードのプロトタイプの使用

Perl exacct ライブラリの一般的な使用では、既存の exacct ファイルを読み取ります。擬似コードを使用して、さまざまな Perl exacct クラスの関係を示します。exacct ファイルを開くプロセスとスキャンするプロセス、および対象のオブジェクトを処理するプロセスを擬似コードで示します。次の擬似コードでは、わかりやすくするために「簡易」関数を使用しています。

-- Open the exacct file ($f is a Sun::Solaris::Exacct::File)
my $f = ea_new_file(...)

-- While not EOF ($o is a Sun::Solaris::Exacct::Object)
while (my $o = $f->get())

        -- Check to see if object is of interest
        if ($o->type() == &EO_ITEM)
             ...

        -- Retrieve the catalog ($c is a Sun::Solaris::Exacct::Catalog)
        $c = $o->catalog()

        -- Retrieve the value
        $v = $o->value();

        -- $v is a reference to a Sun::Solaris::Exacct::Group for a Group
        if (ref($v))
              ....

        -- $v is perl scalar for Items
        else

使用例 7  exacct オブジェクトを再帰的にダンプ

sub dump_object
{
    my ($obj, $indent) = @_;
    my $istr = '  ' x $indent;

    #
    # Retrieve the catalog tag.  Because we are doing this in an array
    # context, the catalog tag will be returned as a (type, catalog, id) 
    # triplet, where each member of the triplet will behave as an integer
    # or a string, depending on context.  If instead this next line provided
    # a scalar context, e.g.
    #    my $cat  = $obj->catalog()->value();
    # then $cat would be set to the integer value of the catalog tag.
    #
    my @cat = $obj->catalog()->value();

    #
    # If the object is a plain item
    #
    if ($obj->type() == &EO_ITEM) {
          #
          # Note:  The '%s' formats provide s string context, so the
          # components of the catalog tag will be displayed as the
          # symbolic values.  If we changed the '%s' formats to '%d',
          # the numeric value of the components would be displayed.
          #
          printf("%sITEM\n%s  Catalog = %s|%s|%s\n", 
              $istr, $istr, @cat);
          $indent++;

          #
          # Retrieve the value of the item.  If the item contains in 
          # turn a nested exacct object (i.e. a item or group), then 
          # the value method will return a reference to the appropriate 
          # sort of perl object (Exacct::Object::Item or 
          # Exacct::Object::Group). We could of course figure out that 
          # the item contained a nested item or group by examining 
          # the catalog tag in @cat and looking for a type of 
          # EXT_EXACCT_OBJECT or EXT_GROUP.
          my $val = $obj->value();
          if (ref($val)) {
             # If it is a nested object, recurse to dump it.
             dump_object($val, $indent);
          } else {
             # Otherwise it is just a 'plain' value, so display it.
             printf("%s  Value = %s\n", $istr, $val);
          }

        #
        # Otherwise we know we are dealing with a group.  Groups represent
        # contents as a perl list or array (depending on context), so we 
        # can process the contents of the group with a 'foreach' loop, which
        # provides a list context.  In a list context the value method 
        # returns the content of the group as a perl list, which is the 
        # quickest mechanism, but doesn't allow the group to be modified. 
        # If we wanted to modify the contents of the group we could do so 
        # like this:
        #    my $grp = $obj->value();   # Returns an array reference
        #    $grp->[0] = $newitem;
        # but accessing the group elements this way is much slower.
        #
        } else {
                printf("%sGROUP\n%s  Catalog = %s|%s|%s\n",
                    $istr, $istr, @cat);
                $indent++;
                # 'foreach' provides a list context.
                foreach my $val ($obj->value()) {
                        dump_object($val, $indent);
                }
                printf("%sENDGROUP\n", $istr);
        }
}

使用例 8  新規グループレコードの作成とファイルへの書き込み

# Prototype list of catalog tags and values.
my @items = (
   [ &EXT_STRING | &EXC_DEFAULT | &EXD_CREATOR      => "me"         ],
   [ &EXT_UINT32 | &EXC_DEFAULT | &EXD_PROC_PID     => $$           ],
   [ &EXT_UINT32 | &EXC_DEFAULT | &EXD_PROC_UID     => $<           ],
   [ &EXT_UINT32 | &EXC_DEFAULT | &EXD_PROC_GID     => $(           ],
   [ &EXT_STRING | &EXC_DEFAULT | &EXD_PROC_COMMAND => "/bin/stuff" ],
);

# Create a new group catalog object.
my $cat = new_catalog(&EXT_GROUP | &EXC_DEFAULT | &EXD_NONE);

# Create a new Group object and retrieve its data array.
my $group = new_group($cat);
my $ary = $group->value();

# Push the new Items onto the Group array.
foreach my $v (@items) {
        push(@$ary, new_item(new_catalog($v->[0]), $v->[1]));
}

# Nest the group within itself (performs a deep copy).
push(@$ary, $group);

# Dump out the group.
dump_object($group);

使用例 9  exacct ファイルのダンプ

#!/usr/bin/perl

use strict;
use warnings;
use blib;
use Sun::Solaris::Exacct qw(:EXACCT_ALL);

die("Usage is dumpexacct 

# Open the exact file and display the header information.
my $ef = ea_new_file($ARGV[0], &O_RDONLY) || die(error_str());
printf("Creator:  %s\n", $ef->creator());
printf("Hostname: %s\n\n", $ef->hostname());

# Dump the file contents
while (my $obj = $ef->get()) {
        ea_dump_object($obj);
}

# Report any errors
if (ea_error() != EXR_OK && ea_error() != EXR_EOF)  {
       printf("\nERROR: %s\n", ea_error_str());
       exit(1);
}
exit(0);