本节提供用于访问 exacct 文件的 perl 代码示例。
在典型的使用中,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
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); } }
# 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);
#!/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);