overload.pm

SinFP是一种新的识别对方计算机操作系统类型的工具

    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _exclusive_or
{
    my($object,$argument,$flag) = @_;
    my($name) = '^';
    my($operand);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        if (defined $flag)
        {
            $operand->ExclusiveOr($object,$operand);
        }
        else
        {
            $object->ExclusiveOr($object,$operand);
            $operand = $object;
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _add
{
    my($object,$argument,$flag) = @_;
    my($name) = '+';
    my($operand);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if (defined $flag)
            {
                $operand->add($object,$operand,0);
            }
            else
            {
                $object->add($object,$operand,0);
                $operand = $object;
            }
        }
        else
        {
            $operand = &_union_($object,$operand,$flag);
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _sub
{
    my($object,$argument,$flag) = @_;
    my($name) = '-';
    my($operand);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if (defined $flag)
            {
                if ($flag) { $operand->subtract($operand,$object,0); }
                else       { $operand->subtract($object,$operand,0); }
            }
            else
            {
                $object->subtract($object,$operand,0);
                $operand = $object;
            }
        }
        else
        {
            if (defined $flag)
            {
                if ($flag) { $operand->Difference($operand,$object); }
                else       { $operand->Difference($object,$operand); }
            }
            else
            {
                $object->Difference($object,$operand);
                $operand = $object;
            }
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _mul
{
    my($object,$argument,$flag) = @_;
    my($name) = '*';
    my($operand);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if (defined $flag)
            {
                $operand->Multiply($object,$operand);
            }
            else
            {
                $object->Multiply($object,$operand);
                $operand = $object;
            }
        }
        else
        {
            $operand = &_intersection_($object,$operand,$flag);
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _div
{
    my($object,$argument,$flag) = @_;
    my($name) = '/';
    my($operand);
    my($temp);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        $temp = $object->Shadow();
        if (defined $flag)
        {
            if ($flag) { $operand->Divide($operand,$object,$temp); }
            else       { $operand->Divide($object,$operand,$temp); }
        }
        else
        {
            $object->Divide($object,$operand,$temp);
            $operand = $object;
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _mod
{
    my($object,$argument,$flag) = @_;
    my($name) = '%';
    my($operand);
    my($temp);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,1);
    eval
    {
        $temp = $object->Shadow();
        if (defined $flag)
        {
            if ($flag) { $temp->Divide($operand,$object,$operand); }
            else       { $temp->Divide($object,$operand,$operand); }
        }
        else
        {
            $temp->Divide($object,$operand,$object);
            $operand = $object;
        }
    };
    if ($@) { &_error($name,0); }
    return($operand);
}

sub _pow
{
    my($object,$argument,$flag) = @_;
    my($name) = '**';
    my($operand,$result);

    $name .= '=' unless (defined $flag);
    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if (defined $flag)
        {
            $result = $object->Shadow();
            if ($flag) { $result->Power($operand,$object); }
            else       { $result->Power($object,$operand); }
        }
        else
        {
            $object->Power($object,$operand);
            $result = $object;
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _assign_concat
{
    my($object,$argument) = @_;

    return( &_concat($object,$argument,undef) );
}

sub _assign_xerox
{
    my($object,$argument) = @_;

    return( &_xerox($object,$argument,undef) );
}

sub _assign_shift_left
{
    my($object,$argument) = @_;

    return( &_shift_left($object,$argument,undef) );
}

sub _assign_shift_right
{
    my($object,$argument) = @_;

    return( &_shift_right($object,$argument,undef) );
}

sub _assign_union
{
    my($object,$argument) = @_;

    return( &_union($object,$argument,undef) );
}

sub _assign_intersection
{
    my($object,$argument) = @_;

    return( &_intersection($object,$argument,undef) );
}

sub _assign_exclusive_or
{
    my($object,$argument) = @_;

    return( &_exclusive_or($object,$argument,undef) );
}

sub _assign_add
{
    my($object,$argument) = @_;

    return( &_add($object,$argument,undef) );
}

sub _assign_sub
{
    my($object,$argument) = @_;

    return( &_sub($object,$argument,undef) );
}

sub _assign_mul
{
    my($object,$argument) = @_;

    return( &_mul($object,$argument,undef) );
}

sub _assign_div
{
    my($object,$argument) = @_;

    return( &_div($object,$argument,undef) );
}

sub _assign_mod
{
    my($object,$argument) = @_;

    return( &_mod($object,$argument,undef) );
}

sub _assign_pow
{
    my($object,$argument) = @_;

    return( &_pow($object,$argument,undef) );
}

sub _increment
{
    my($object) = @_;
    my($name) = '++';
    my($result);

    eval
    {
        $result = $object->increment();
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _decrement
{
    my($object) = @_;
    my($name) = '--';
    my($result);

    eval
    {
        $result = $object->decrement();
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _lexicompare
{
    my($object,$argument,$flag) = @_;
    my($name) = 'cmp';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ((defined $flag) && $flag)
        {
            $result = $operand->Lexicompare($object);
        }
        else
        {
            $result = $object->Lexicompare($operand);
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _compare
{
    my($object,$argument,$flag) = @_;
    my($name) = '<=>';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ((defined $flag) && $flag)
        {
            $result = $operand->Compare($object);
        }
        else
        {
            $result = $object->Compare($operand);
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _equal
{
    my($object,$argument,$flag) = @_;
    my($name) = '==';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        $result = $object->equal($operand);
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _not_equal
{
    my($object,$argument,$flag) = @_;
    my($name) = '!=';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        $result = $object->equal($operand);
    };
    if ($@) { &_error($name,0); }
    return(! $result);
}

sub _less_than
{
    my($object,$argument,$flag) = @_;
    my($name) = '<';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if ((defined $flag) && $flag)
            {
                $result = ($operand->Compare($object) < 0);
            }
            else
            {
                $result = ($object->Compare($operand) < 0);
            }
        }
        else
        {
            if ((defined $flag) && $flag)
            {
                $result = ((!$operand->equal($object)) &&
                            ($operand->subset($object)));
            }
            else
            {
                $result = ((!$object->equal($operand)) &&
                            ($object->subset($operand)));
            }
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _less_equal
{
    my($object,$argument,$flag) = @_;
    my($name) = '<=';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if ((defined $flag) && $flag)
            {
                $result = ($operand->Compare($object) <= 0);
            }
            else
            {
                $result = ($object->Compare($operand) <= 0);
            }
        }
        else
        {
            if ((defined $flag) && $flag)
            {
                $result = $operand->subset($object);
            }
            else
            {
                $result = $object->subset($operand);
            }
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _greater_than
{
    my($object,$argument,$flag) = @_;
    my($name) = '>';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if ((defined $flag) && $flag)
            {
                $result = ($operand->Compare($object) > 0);
            }
            else
            {
                $result = ($object->Compare($operand) > 0);
            }
        }
        else
        {
            if ((defined $flag) && $flag)
            {
                $result = ((!$object->equal($operand)) &&
                            ($object->subset($operand)));
            }
            else
            {
                $result = ((!$operand->equal($object)) &&
                            ($operand->subset($object)));
            }
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _greater_equal
{
    my($object,$argument,$flag) = @_;
    my($name) = '>=';
    my($operand);
    my($result);

    $operand = &_fetch_operand($object,$argument,$flag,$name,0);
    eval
    {
        if ($CONFIG[1] == 1)
        {
            if ((defined $flag) && $flag)
            {
                $result = ($operand->Compare($object) >= 0);
            }
            else
            {
                $result = ($object->Compare($operand) >= 0);
            }
        }
        else
        {
            if ((defined $flag) && $flag)
            {
                $result = $object->subset($operand);
            }
            else
            {
                $result = $operand->subset($object);
            }
        }
    };
    if ($@) { &_error($name,0); }
    return($result);
}

sub _clone
{
    my($object) = @_;
    my($name) = 'automatic duplication';
    my($result);

    eval
    {
        $result = $object->Clone();
    };
    if ($@) { &_error($name,0); }
    return($result);
}

1;

__END__