Perl 代码示例

本节提供用于访问 exacct 文件的 perl 代码示例。

示例 4–1 使用伪代码原型

在典型的使用中，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

示例 4–2 递归转储 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);

        }

}

示例 4–3 创建新的组记录并写入文件

# 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);

示例 4–4 转储 exacct 文件

#!/usr/perl5/5.6.1/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);