#!/usr/bin/perl # IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # bos720 src/bos/usr/sbin/install/suma/lib/SUMA/Util.pm 1.3 # # Licensed Materials - Property of IBM # # Restricted Materials of IBM # # COPYRIGHT International Business Machines Corp. 2004 # All Rights Reserved # # US Government Users Restricted Rights - Use, duplication or # disclosure restricted by GSA ADP Schedule Contract with IBM Corp. # # IBM_PROLOG_END_TAG package SUMA::Util; our $VERSION = '1.00'; # code starts after '=cut' =head1 NAME SUMA::Util - Private utilities for SUMA code. =head1 SYNOPSIS # # ckPrivate, MEGABYTE and RE_PATH # use SUMA::Util qw/ckPrivate MEGABYTE RE_PATH RE_POLICY_ID DL_RC_SUCCESS/; use SUMA::Util qw/:sub/; use SUMA::Util qw/:re/; use SUMA::Util qw/:const/; use SUMA::Util qw/:dl_const/; use SUMA::Util qw/:all/; sub _my_private_sub { return undef unless ckPrivate(); # ... } sub _my_restricted_sub { return undef unless ckPrivate( qw/MyPackage SomePackage/ ); # ... } $str =~ RE_PATH or die("$str is not a valid path"); $str =~ RE_POLICY_ID or die("$str is not a valid task ID"); $bytes = $megs * MEGABYTE; # # writeXml # use SUMA::Util qw/writeXml/; my $child_arrayRef=[]; $child_tagArrayRef=['Child','Joe',"", 'eyes', '"blue"']; push(@{$child_arrayRef},$child_tagArrayRef); $child_tagArrayRef=['Child','Sue',"", 'eyes', '"green"']; push(@{$child_arrayRef},$child_tagArrayRef); $father_tagArrayRef=['Father','Jack',$child_arrayRef, 'eyes', '"green"']; open($writer,">",\$output); writeXml($writer,$father_tagArrayRef,0); print($output); =cut use strict; use lib qw( /usr/suma/lib ); use SUMA::GConfig; require Exporter; our @ISA = qw(Exporter); my @subs = qw/ ckPrivate writeXml /; my @re_consts = qw/ RE_PATH RE_POLICY_ID /; my @dl_consts = qw/ DL_RC_FAIL DL_RC_SUCCESS DL_RC_SKIP DL_RC_PREVIEW_OK /; my @consts = ( @dl_consts, @re_consts, qw/ MEGABYTE / ); our @EXPORT_OK = ( @consts, @subs ); our %EXPORT_TAGS = ( all => [@EXPORT_OK], sub => [@subs], re => [@re_consts], dl_const => [@dl_consts], const => [@consts], ); =head1 METHODS =over 4 =item ckPrivate =item ckPrivate LIST Ensures the calling subroutine was itself called by one of a restricted set of calling packages. The set of callers may be specified in the C parameter. The caller's package is always implicitly included in the list. So with no parameters, C ensures that the calling subroutine was called from within its own package. =cut sub ckPrivate { my @cklist = @_; my $callee = caller(0); push @cklist, $callee; my $caller = caller(1); for(@cklist) { return 1 if(($caller eq $_) || $caller->isa($_)); } require SUMA::Messenger; SUMA::Messenger->import(qw/MSG_RESTRICTED_FUNCTION/); mesg(LVL_ERROR, MSG_RESTRICTED_FUNCTION(), (caller(1))[3], join("\n\t", @cklist)); return 0; } # ckPrivate =item writeXml FILEHANDLE TAG_ARRAY_REF TAG_DEPTH Writes xml tags minus the xml header: "[0]"; # Print tag for (my $field=3; $field < $numFields; $field=$field+2) { print $writer " $tagArrayRef->[$field]=$tagArrayRef->[$field+1]"; } print $writer ">"; if (defined($tagArrayRef->[1])) { print $writer "$tagArrayRef->[1]"; } # Print Children tags if ($tagArrayRef->[2] ne "") { print $writer "\n"; foreach my $child_tagArrayRef (@{$tagArrayRef->[2]}) { writeXml($writer,$child_tagArrayRef,$tag_depth+1); } for (my $x=0 ; $x<$tag_depth; $x++) {print $writer " ";} } # Print end tag print $writer "[0],">\n"; }# end writeXml =back =head1 CONSTANTS =over 4 =item RE_PATH A precompiled regular expression validating a path. $1 is set to the entire path, if valid, for untainting purposes. For example: ($path) = $path =~ RE_PATH; =cut use constant RE_PATH => qr!^([]/\w"#$%'+,-.:@[\\^{}~]+)$!o; =item RE_POLICY_ID A precompiled regular expression validating a Task ID. $1 is set to the entire ID, if valid, for untainting purposes. For example: ($taskID) = $taskID =~ RE_POLICY_ID; =cut use constant RE_POLICY_ID => qr/^(\d+)$/o; =item MEGABYTE The number of bytes in a megabyte: 1024 * 1024 = 1048576 =cut use constant MEGABYTE => 1024 * 1024; =item DL_RC_* Download return code constants: =over 4 =item DL_RC_FAIL =item DL_RC_SUCCESS =item DL_RC_SKIP =item DL_RC_PREVIEW_OK =back =cut use constant DL_RC_FAIL => 0; use constant DL_RC_SUCCESS => 1; use constant DL_RC_SKIP => 2; use constant DL_RC_PREVIEW_OK => 3; =back =cut 1;