File Coverage

blib/lib/PBS/Client.pm

Criterion	Covered	Total	%
statement	188	377	49.8
branch	97	170	57.0
condition	3	9	33.3
subroutine	20	31	64.5
pod	2	5	40.0
total	310	592	52.3

package PBS::Client;
use strict;
use vars qw($VERSION);
use Carp;
use File::Temp qw(tempfile);
$VERSION = '0.11';

#------------------------------------------------
# Submit jobs to PBS
#
# Included methods:
# - Construct PBS client object
#     $client = PBS::Client->new();
#
# - Submit jobs
#     $client->qsub($job);
#     -- $client -- client object
#     -- $job ----- job object
#
# - Generate job script without job submission
#     $client->genScript($job);
#     -- $client -- client object
#     -- $job ----- job object
#------------------------------------------------


#------------------------
# Constructor method
#
#
# $class -- client object
# %hash --- argument hash
#
#
# $self -- client object
sub new
{
    my ($class, %hash) = @_;
    my $self = \%hash;
    return bless($self, $class);
}
#------------------------


#--------------------------
# Generic attribute methods
sub AUTOLOAD
{
    my ($self, $key) = @_;
    my $attr = our $AUTOLOAD;
    $attr =~ s/.*:://;
    return if ($attr eq 'DESTROY');        # ignore destructor
    $self->{$attr} = $key if (defined $key);
    return($self->{$attr});
}
#--------------------------


#-------------------------------------------------------------------
# Submit PBS jobs by qsub command
# - called subroutines: getScript(), _numPrevJob() and _qsubDepend()
#
#
# $self -- client object
# $job --- job object
#
#
# \@pbsid -- array reference of PBS job ID
sub qsub
{
    my ($self, $job) = @_;

    #----------------------------------------------------------
    # Codes for backward compatatible with old private software
    #----------------------------------------------------------
    if (!ref($job) || ref($job) eq 'ARRAY')
    {
        $self->cmd($job);
        &qsub($self, $self);
    }

    #-----------------------------------------------
    # Dependency: count number of previous jobs
    #-----------------------------------------------
    my $on = &_numPrevJob($job);
    $job->{depend}{on} = [$on] if ($on);
    my $file = $job->{script};
    my @pbsid = ();

    #-----------------------------------------------
    # Single job
	# Thanks to Demian Ricchardi for a bug fix
    #-----------------------------------------------
    if (!ref($job->{cmd}))
    {
        my $tempFile = &genScript($self, $job);           # generate script
        my $out = &call_qsub('qsub', $tempFile);          # submit script
        my $pbsid = ($out =~ /^(\d+)/)[0];                # get pid
        rename($tempFile, "$file.$pbsid");                # rename script
        push(@pbsid, $pbsid);
        $job->pbsid($pbsid);
    }
    #-----------------------------------------------
    # Multiple (matrix of) jobs
	# Thanks to Demian Ricchardi for a bug fix
    #-----------------------------------------------
    else
    {
        my $subjob = $job->copy;
        for (my $i = 0; $i < @{$job->{cmd}}; $i++)
        {
            # Get command
            my $list = ${$job->{cmd}}[$i];
            my $cmd = (ref $list)? (join("\n", @$list)): $list;
            $subjob->{cmd} = $cmd;

            # Generate and submit job script
            my $tempFile = &genScript($self, $subjob);    # generate script
            my $out = &call_qsub('qsub', $tempFile);      # submit script
            my $pbsid = ($out =~ /^(\d+)/)[0];            # get pid
            rename($tempFile, "$file.$pbsid");            # rename script
            push(@pbsid, $pbsid);
        }
        $job->pbsid(\@pbsid);
    }

    #-----------------------------------------------
    # Dependency: submit previous and following jobs
    #-----------------------------------------------
    &_qsubDepend($self, $job, \@pbsid);

    return(\@pbsid);
}
#-------------------------------------------------------------------


#-------------------------------------------------------------------
# Thanks to Sander Hulst
sub call_qsub
{
    my @args = @_;

    # If the qsub command fails, for instance, pbs_server is not running,
    # PBS::Client's qsub should not silently ignore. Disable any reaper
    # functions so the exit code can be captured
    use Symbol qw(gensym);
    use IPC::Open3;
	my $stdout = gensym();
	my $stderr = gensym();
    {
        local $SIG{CHLD} = sub{};
        my $pid = open3(gensym, $stdout, $stderr, @args);
        waitpid($pid,0);
    }
    confess <$stderr> if ($?);
    return <$stdout>;
}
#-------------------------------------------------------------------


#-------------------------------------------------------------------
# Dispatch PBS jobs by dispatch and qsub command
# - Codes for backward compatible with old private software
# - called subroutines: getScript()
#
#
# $self -- server object
# $job --- job object
#
#
# \@pbsid -- array reference of PBS job ID
sub dispatch
{
    my ($self, $job) = @_;
    my $file = $job->{script};

    #-----------------------------------------------
    # Dependency: count number of previous jobs
    #-----------------------------------------------
    my $on = &_numPrevJob($job);
    $job->{depend}{on} = [$on] if ($on);
    my @pbsid = ();

    #---------
    # Dispatch
    #---------
    my $subjob = $job->copy;
    for (my $i = 0; $i < @{$job->{cmd}}; $i++)
    {
        #--------------
        # Dispatch jobs
        #--------------
        my $list = ${$job->{cmd}}[$i];
        my $djob = (ref $list)? (join("\n", @$list)): $list;
        $djob =~ s/\\/\\\\/g;
        $djob =~ s/"/\\\"/g;

        #-----------------
        # Dispatch command
        #-----------------
        my $cmd = 'echo "'."\n$djob\n".'" | dispatch';
        $subjob->{cmd} = $cmd;

        #-------------------------------
        # Generate and submit job script
        #-------------------------------
        my $numJob = (ref $list)? (scalar(@$list)): 1;
        $subjob->nodes($numJob) if (!defined $subjob->{nodes});
        my $tempFile = &genScript($self, $subjob);    # generate script
        my $out = `qsub $tempFile`;                   # submit script
        my $pbsid = ($out =~ /^(\d+)/)[0];            # grab pid
        rename($tempFile, "$file.$pbsid");            # rename script
        push(@pbsid, $pbsid);
    }
    $job->pbsid(\@pbsid);

    #-------------------------------------------------
    # Dependency: dispatch previous and following jobs
    #-------------------------------------------------
    &_dphDepend($self, $job, \@pbsid);

    return(\@pbsid);
}
#-------------------------------------------------------------------


#-----------------------------------------------------------------
# Generate shell script from command string array
# - called subroutines: _trace(), _nodes(), _stage() and _depend()
# - called by qsub()
#
#
# $self -- client object
# $job --- job object
#
#
# $file -- filename of job script
sub genScript
{
    my ($self, $job) = @_;

    #-------------------------
    # Process the queue string
    #-------------------------
    my $queue = '';
    $queue .= $job->{queue} if (defined $job->{queue});
    $queue .= '@'.$self->{server} if (defined $self->{server});

    #-------------------------------
    # Process the mail option string
    #-------------------------------
    my $mailOpt;
    if (defined $job->{mailopt})
    {
        $mailOpt = $job->{mailopt};
        $mailOpt =~ s/\s*,\s*//;
    }

    #---------------------
    # Generate node string
    #---------------------
    my $nodes = &_nodes($job);

    #------------------------------------
    # Set internal variable:
    # - temporary file for the job script
    #------------------------------------
    my (undef, $file) = tempfile(DIR => $job->{wd});
    $job->_tempScript($file);

    #------------------------
    # PBS request option list
    #------------------------
    open(SH, ">$file") || confess "Can't write $file";
    print SH "#!$job->{shell}\n\n";
    print SH "#PBS -N $job->{name}\n";
    print SH "#PBS -d $job->{wd}\n";
    print SH "#PBS -e $job->{efile}\n" if (defined $job->{efile});
    print SH "#PBS -o $job->{ofile}\n" if (defined $job->{ofile});
    print SH "#PBS -q $queue\n" if ($queue);
    print SH "#PBS -W x=PARTITION:$job->{partition}\n" if
        (defined $job->{partition});
    print SH "#PBS -W stagein=".&_stage('in', $job->{stagein})."\n" if
        (defined $job->{stagein});
    print SH "#PBS -W stageout=".&_stage('out', $job->{stageout})."\n" if
        (defined $job->{stageout});
    print SH "#PBS -M ".&_mailList($job->{maillist})."\n" if
        (defined $job->{maillist});
    print SH "#PBS -m ".$mailOpt."\n" if (defined $mailOpt);
    print SH "#PBS -v ".&_varList($job->{vars})."\n" if (defined $job->{vars});
    print SH "#PBS -A $job->{account}\n" if (defined $job->{account});
    print SH "#PBS -p $job->{pri}\n" if (defined $job->{pri});
    print SH "#PBS -l nodes=$nodes\n";
    print SH "#PBS -l host=$job->{host}\n" if (defined $job->{host});
    print SH "#PBS -l mem=$job->{mem}\n" if (defined $job->{mem});
    print SH "#PBS -l pmem=$job->{pmem}\n" if (defined $job->{pmem});
    print SH "#PBS -l vmem=$job->{vmem}\n" if (defined $job->{vmem});
    print SH "#PBS -l pvmem=$job->{pvmem}\n" if (defined $job->{pvmem});
    print SH "#PBS -l cput=$job->{cput}\n" if (defined $job->{cput});
    print SH "#PBS -l pcput=$job->{pcput}\n" if (defined $job->{pcput});
    print SH "#PBS -l walltime=$job->{wallt}\n" if (defined $job->{wallt});
    print SH "#PBS -l nice=$job->{nice}\n" if (defined $job->{nice});
    print SH "#PBS -l prologue=$job->{prologue}\n" if
        (defined $job->{prologue});
    print SH "#PBS -l epilogue=$job->{epilogue}\n" if
        (defined $job->{epilogue});

    #---------------
    # Beginning time
    #---------------
    if (defined $job->{begint})
    {
        my $begint = $job->{begint};
        $begint =~ s/[\-\s]//g;
        my @a = ($begint =~ /([\d\.]+)/g);

        if (scalar(@a) == 3)
        {
            print SH "#PBS -a $a[0]$a[1].$a[2]\n";
        }
        else
        {
            $begint = join('', @a);
            print SH "#PBS -a $begint\n";
        }
    }

    #----------------------
    # Job dependency option
    #----------------------
    if (defined $job->{depend})
    {
        my $depend = &_depend($job->{depend});
        print SH "#PBS -W depend=$depend\n";
    }
    print SH "\n";

    #--------------
    # Trace the job
    #--------------
    my $cmd = $job->{cmd};
    my $tracer = $job->{tracer};
    if ($tracer && $tracer ne 'off')
    {
        my $server;
        if (defined $self->{server})
        {
            $server = $self->{server};
        }
        else
        {
            $server = `qstat -Bf|head -1`;
            $server = substr($server, 8);
        }

        my ($tfile) = (defined $job->{tfile})? ($job->{tfile}):
            ($job->{script}.'.t$PBS_JOBID');
        &_trace($server, $tfile, $cmd);
    }
    else
    {
        #----------------
        # Execute command
        #----------------
        print SH "$cmd\n";
    }
    close(SH);

    return($file);
}
#-----------------------------------------------------------------


#------------------------------
# Count number of previous jobs
sub _numPrevJob
{
    my ($job) = @_;
    my $on = 0;
    if (defined $job->{prev})
    {
        foreach my $type (keys %{$job->{prev}})
        {
            if (ref($job->{prev}{$type}) eq 'ARRAY')
            {
                foreach my $jobTmp (@{$job->{prev}{$type}})
                {
                    my $prevcmd = $jobTmp->{cmd};
                    if (ref($prevcmd))
                    {
                        my $numCmd = scalar(@$prevcmd);
                        $on += $numCmd;
                    }
                    else
                    {
                        $on++;
                    }
                }
            }
            else
            {
                my $prevcmd = $job->{prev}{$type}{cmd};
                if (ref($prevcmd))
                {
                    my $numCmd = scalar(@$prevcmd);
                    $on += $numCmd;
                }
                else
                {
                    $on++;
                }
            }
        }
    }
    return($on);
}
#------------------------------


#----------------------
# Submit dependent jobs
# - called by qsub()
sub _qsubDepend
{
    my ($self, $job, $pbsid) = @_;

    my %type = (
        'prevstart' => 'before',
        'prevend'   => 'beforeany',
        'prevok'    => 'beforeok',
        'prevfail'  => 'beforenotok',
        'nextstart' => 'after',
        'nextend'   => 'afterany',
        'nextok'    => 'afterok',
        'nextfail'  => 'afternotok',
        );

    foreach my $order (qw(prev next))
    {
        foreach my $cond (qw(start end ok fail))
        {
            if (defined $job->{$order}{$cond})
            {
                my $type = $type{$order.$cond};
                if (ref($job->{$order}{$cond}) eq 'ARRAY')    # array of job obj
                {
                    foreach my $jobTmp (@{$job->{$order}{$cond}})
                    {
                        $$jobTmp{depend}{$type} = $pbsid;
                        &qsub($self, $jobTmp);
                    }
                }
                else
                {
                    my $jobTmp = $job->{$order}{$cond};
                    $$jobTmp{depend}{$type} = $pbsid;
                    &qsub($self, $jobTmp);
                }
            }
        }
    }
}
#----------------------


#------------------------
# Dispatch dependent jobs
# - called by dispatch()
sub _dphDepend
{
    my ($self, $job, $pbsid) = @_;

    my %type = (
        'prevstart' => 'before',
        'prevend'   => 'beforeany',
        'prevok'    => 'beforeok',
        'prevfail'  => 'beforenotok',
        'nextstart' => 'after',
        'nextend'   => 'afterany',
        'nextok'    => 'afterok',
        'nextfail'  => 'afternotok',
        );

    foreach my $order (qw(prev next))
    {
        foreach my $cond (qw(start end ok fail))
        {
            if (defined $job->{$order}{$cond})
            {
                my $type = $type{$order.$cond};
                if (ref($job->{$order}{$cond}) eq 'ARRAY')    # array of job obj
                {
                    foreach my $jobTmp (@{$job->{$order}{$cond}})
                    {
                        $$jobTmp{depend}{$type} = $pbsid;
                        &dispatch($self, $jobTmp);
                    }
                }
                else
                {
                    my $jobTmp = $job->{$order}{$cond};
                    $$jobTmp{depend}{$type} = $pbsid;
                    &dispatch($self, $jobTmp);
                }
            }
        }
    }
}
#------------------------


#-----------------------------------------------------
# Trace the job by recording the location of execution
# - called by genScript()
#
#
# $cmd -- command string
sub _trace
{
    my ($server, $tfile, $cmd) = @_;

    print SH "server=$server\n";
    print SH "tfile=$tfile\n";
    print SH 'tfile=${tfile/%.$server/}'."\n";

    # Get machine, start and finish time
    print SH 'echo MACHINES : > $tfile'."\n";
    print SH 'cat $PBS_NODEFILE >> $tfile'."\n";
    print SH 'echo "" >> $tfile'."\n";
    print SH 'start=`date +\'%F %T\'`'."\n";
    print SH 'echo "START   : $start" >> $tfile'."\n";
    print SH "\n$cmd\n\n";
    print SH 'finish=`date +\'%F %T\'`'."\n";
    print SH 'echo "FINISH  : $finish" >> $tfile'."\n";

    # Calculate the duration of the command
    print SH 'begin=`date +%s -d "$start"`'."\n";
    print SH 'end=`date +%s -d "$finish"`'."\n";
    print SH 'sec=`expr $end - $begin`'."\n";
    print SH 'if [ $sec -ge 60 ]'."\n";
    print SH 'then'."\n";
    print SH '    min=`expr $sec / 60`'."\n";
    print SH '    sec=`expr $sec % 60`'."\n\n";
    print SH '    if [ $min -ge 60 ]'."\n";
    print SH '    then'."\n";
    print SH '        hr=`expr $min / 60`'."\n";
    print SH '        min=`expr $min % 60`'."\n";
    print SH '        echo "RUNTIME : $hr hr $min min $sec sec" >> $tfile'."\n";
    print SH '    else'."\n";
    print SH '        echo "RUNTIME : $min min $sec sec" >> $tfile'."\n";
    print SH '    fi'."\n";
    print SH 'else'."\n";
    print SH '    echo "RUNTIME : $sec sec" >> $tfile'."\n";
    print SH 'fi'."\n";
}
#-----------------------------------------------------


#----------------------------------------------------------
# Construct node request string
# - called by genScript()
#
#
# $job -- job object
#
#
# $str -- node request string
sub _nodes
{
    my ($job) = @_;
    $job->nodes('1') if (!defined $job->{nodes});
    my $type = ref($job->{nodes});

    #-------------------------------------------
    # String
    # Example:
    # (1) nodes => 2, ppn => 2
    # (2) nodes => "delta01+delta02", ppn => 2
    # (3) nodes => "delta01:ppn=2+delta02:ppn=1"
    #-------------------------------------------
    if ($type eq '')
    {
        if ($job->{nodes} =~ /^\d+$/)
        {
            my $str = "$job->{nodes}";
            $str .= ":ppn=$job->{ppn}" if (defined $job->{ppn});
            return($str);
        }
        else
        {
            if (defined $job->{ppn})
            {
                my @node = split(/\s*\+\s*/, $job->{nodes});
                my $str = join(":ppn=$job->{ppn}+", @node);
                $str .= ":ppn=$job->{ppn}";
                return($str);
            }
            return($job->{nodes});
        }
    }
    #-----------------------------------------------
    # Array
    # Example:
    # (1) nodes => [qw(delta01 delta02)], ppn => 2
    # (2) nodes => [qw(delta01:ppn=2 delta02:ppn=1)]
    #-----------------------------------------------
    elsif ($type eq 'ARRAY')
    {
        if (defined $job->{ppn})
        {
            my $str = join( ":ppn=$job->{ppn}+", @{$job->{nodes}} );
            $str .= ":ppn=$job->{ppn}";
            return($str);
        }
        return( join('+', @{$job->{nodes}}) );
    }
    #------------------------------------------
    # Hash
    # Example:
    # (1) nodes => {delta01 => 2, delta02 => 1}
    #------------------------------------------
    elsif ($type eq 'HASH')
    {
        my $str = '';
        foreach my $node (keys %{$job->{nodes}})
        {
            $str .= "$node:ppn=${$job->{nodes}}{$node}+";
        }
        chop($str);
        return($str);
    }
}
#----------------------------------------------------------


#----------------------------------------------------------
# Construct string for file staging (in and out)
# - called by genScript()
sub _stage
{
    my ($act, $file) = @_;
    my $type = ref($file);

    #-------------------------------------------
    # String
    # Example:
    # stagein => "to01.file@fromMachine:from01.file,".
    #            "to02.file@fromMachine:from02.file"
    # stageout => "from01.file@toMachine:to01.file,".
    #             "from02.file@toMachine:to02.file"
    #-------------------------------------------
    return($file) if ($type eq '');

    #-------------------------------------------
    # Array
    # Example:
    # stagein => ['to01.file@fromMachine:from01.file',
    #             'to02.file@fromMachine:from02.file']
    # stageout => ['from01.file@toMachine:to01.file',
    #              'from02.file@toMachine:to02.file']
    #-------------------------------------------
    return(join(',', @$file)) if ($type eq 'ARRAY');

    #-------------------------------------------
    # Hash
    # Example:
    # stagein => {'fromMachine:from01.file' => 'to01.file',
    #             'fromMachine:from02.file' => 'to02.file'}
    # stageout => {'from01.file' => 'toMachine:to01.file',
    #              'from02.file' => 'toMachine:to02.file'}
    #-------------------------------------------
    if ($type eq 'HASH')
    {
        if ($act eq 'in')
        {
            my @stages;
            foreach my $f (keys %$file)
            {
                push(@stages, "$$file{$f}".'@'."$f");
            }
            return(join(',', @stages));
        }
        elsif ($act eq 'out')
        {
            my @stages;
            foreach my $f (keys %$file)
            {
                push(@stages, "$f".'@'."$$file{$f}");
            }
            return(join(',', @stages));
        }
    }
}
#----------------------------------------------------------


#----------------------------------------------------------
# Construct the job dependency string
# - called by genScript()
#
#
# $arg -- hash reference of job dependency
#
#
# $str -- job dependency string
sub _depend
{
    my ($arg) = @_;
    my $str = '';

    foreach my $type (keys %$arg)
    {
        $str .= ',' unless ($str eq '');
        my $joblist = join(':', @{$$arg{$type}});
        $str .= "$type:$joblist";
    }
    return($str);
}
#----------------------------------------------------------


#----------------------------------------------------------
# Construct the mail address list string
# - called by genScript()
#
#
# "[e-mail], [e-mail]" or
# [qw([e-mail] [e-mail])]
#
#
# [e-mail],[e-mail]
sub _mailList
{
    my ($arg) = @_;
    if (ref($arg) eq 'ARRAY')
    {
        return(join(',', @$arg));
    }
    else
    {
        $arg =~ s/,\s+/,/g;
        return($arg);
    }
}
#----------------------------------------------------------


#----------------------------------------------------------
# Construct the environment variable list string
# - called by genScript()
#
#
# ['A', 'B =b', {C => '', D => 'd'}],
#
#
# A,B=b,c,D=d
sub _varList
{
    my ($arg) = @_;

    if (ref($arg) eq 'ARRAY')
    {
        my $str;
        foreach my $ele (@$arg)
        {
            $str .= ',' if (defined $str);
            if (ref($ele) eq 'HASH')
            {
                $str .= &_hashVar($ele);
            }
            else
            {
                $ele =~ s/\s*=\s*/=/;    # remove possible spaces around "="
                $str .= $ele;
            }
        }
        return($str);
    }
    elsif (ref($arg) eq 'HASH')
    {
        return(&_hashVar($arg));
    }
    else
    {
        my $str = $arg;
        $str =~ s/\s*=\s*/=/g;
        $str =~ s/\s*,\s+/,/g;
        return($str);
    }

    # Construct environment variable list string from hash
    sub _hashVar
    {
        my ($h) = @_;
        my $str;
        foreach my $key (keys %$h)
        {
            $str .= ',' if (defined $str);
            $str .= "$key";
            $str .= "=$$h{$key}" if ($$h{$key} ne '');
        }
        return($str);
    }
}
#----------------------------------------------------------


#################### PBS::Client::Job ####################

package PBS::Client::Job;
use strict;

#------------------------------------------------
# Job class
#------------------------------------------------

use Cwd;
use Carp;

#-------------------------
# Constructor method
#
#
# $class -- job object
# %hash --- argument hash
#
#
# $self -- job object
sub new
{
    my ($class, %hash) = @_;

    #-------------
    # set defaults
    #-------------
    $hash{wd} = cwd if (!defined $hash{wd});
    $hash{script} = 'pbsjob.sh' if (!defined $hash{script});
    $hash{tracer} = 'off' if (!defined $hash{tracer});
    $hash{shell} = '/bin/sh' if (!defined $hash{shell});
    $hash{name} = $hash{script} if (!defined $hash{name});

    my $self = \%hash;
    return bless($self, $class);
}
#-------------------------


#--------------------------
# Generic attribute methods
sub AUTOLOAD
{
    my ($self, $key) = @_;
    my $attr = our $AUTOLOAD;
    $attr =~ s/.*:://;
    return if ($attr eq 'DESTROY');        # ignore destructor
    $self->{$attr} = $key if (defined $key);
    return($self->{$attr});
}
#--------------------------


#---------------------------------------
# Pack commands
#
#
# $self -- job object
# %args -- argument hash
#          -- numQ -- number of queues
#          -- cpq --- commands per queue
sub pack
{
    my ($self, %args) = @_;
    my $cmdlist = $self->{cmd};
    return if (ref($cmdlist) ne 'ARRAY');

    my @pack = ();
    my $jc = 0;        # job counter
    if (defined $args{numQ})
    {
        for (my $i = 0; $i < @$cmdlist; $i++)
        {
            if (ref($$cmdlist[$i]))
            {
                foreach my $cell (@{$$cmdlist[$i]})
                {
                    my $row = $jc % $args{numQ};
                    push(@{$pack[$row]}, $cell);
                    $jc++;
                }
            }
            else
            {
                my $row = $jc % $args{numQ};
                push(@{$pack[$row]}, $$cmdlist[$i]);
                $jc++;
            }
        }
    }
    elsif (defined $args{cpq})
    {
        for (my $i = 0; $i < @$cmdlist; $i++)
        {
            if (ref($$cmdlist[$i]))
            {
                foreach my $cell (@{$$cmdlist[$i]})
                {
                    my $row = int($jc / $args{cpq});
                    push(@{$pack[$row]}, $cell);
                    $jc++;
                }
            }
            else
            {
                my $row = int($jc / $args{cpq});
                push(@{$pack[$row]}, $$cmdlist[$i]);
                $jc++;
            }
        }
    }
    $self->cmd([@pack]);
}
#---------------------------------------


#-------------------------------
# Copy object using Data::Dumper
sub copy
{
    my ($self, $num) = @_;
    use Data::Dumper;
    if (!defined $num || $num == 1)
    {
        my $clone;
        eval(Data::Dumper->Dump([$self], ['clone']));
        return($clone);
    }

    my @clones = ();
    for (my $i = 0; $i < $num; $i++)
    {
        my $clone;
        eval(Data::Dumper->Dump([$self], ['clone']));
        push(@clones, $clone)
    }
    return(@clones);
}
#-------------------------------


__END__