in reply to Re: global symbol...explict package name
in thread global symbol...explict package name

Hi, the entire Perl program that contains the first snippet (sub send_order_rxi) is dropped below as well as the entire rxi.pm. Thank you for your help. 
#!/usr/bin/perl -w

=head1 NAME

process-orders Cos orders for transport

=head1 SYNOPIS

process-orders [options...] [orders]...

=head1 OPTIONS

=item   -x     -- turn Debugging on.

=item   -d :   -- put working rdt files in directory :

=item   -t :   -- override and use : as transport method

=item   -T :   -- use : as default transport method

=item   -m :   -- override mail address to :

=item   -M     -- Send mail (required if you want the order sent)

=head1 DESCRIPTION

This programs is used to process pending orders for transport to the
labs.  It uses the lab_info field transport to decide how to route
the order to the lab.

The default transport is to do NOTHING.  
(See transport-method for the current settings for the labs)

If no orders are specified then the database is scanned for pending or
+ders.
Otherwise only those orders specified on the command line will be proc
+essed.

=item perl-rdt - Use internal perl rdt generator.

This method creates the rdt file and if -M is specified will
mail the order to the lab.

=item java-rdt - Using external java rdt generator.

This method invokes an exteran java program.
(untested)

=item no-send - Tag the order as sent.

This transport just tags the order as sent.  No other processing will 
take place on the order.

=item re-queue - Tag the order as queued.

Tag the order as new, to be sent on next run.  The order is not
processed at this time.

=head1 EXAMPLES

=item Normal processing

 process-orders -M

=item Force order 123456 to be sent to lab

 process-order -M 123456

=item Re-direct order to a lab

 process-order -M -m lab123in@optical-online.com 123456

=item Send order 123456 via perl-rdt transport

 process-order -M -t perl-rdt 123456

=cut

sub usage {
    die <<"EOF";
Usage: $0 [options...] [orders]...
   -- generated rdt files 
Options:
   -x     -- turn Debugging on.
   -d :   -- put file in directory :
   -t :   -- override and use : as transport method
   -T :   -- use : as default transport method
   -m :   -- override to address to :
   -l :   -- override to lab to :
   -M     -- Send mail
EOF
}

use strict;
use Getopt::Std;
use DBI;
use Cos::rdt;
use Cos::rxi;
use Cos::Order;
use Cos::Dbh;
use MIME::Lite;

#=====================================================================
+=========
print "=" x 79, "\n";
print "process-orders r1.3-fixed, not in cvs: ", scalar(localtime()), 
+"\n";

my(%Opt);
&getopts('xMm:t:T:d:l:', \%Opt) || usage;

my($Force_Transport)      = $Opt{t} || '';
my($Force_Mail)      = $Opt{m} || '';
my($Default_Transport)  = $Opt{T} || '';
my($Debug)        = $Opt{x} || 0;
my($Mail)        = $Opt{M} || 0;
my($Lab)        = $Opt{l} || 0;
my($Dir)        = $Opt{d} || '';

$ENV{PATH} .= ':/home/cos/bin' unless $ENV{PATH} =~ m=/home/cos/bin=;

$Dir .= '/' if $Dir ne '' && $Dir !~ m=/$=;

my(%Transport);

if (@ARGV) {
    my($order);
    foreach $order (@ARGV) {
        process_an_order($order);
    }
} else {
    process_orders();
}

print "-" x 79, "\n";
#---------------------------------------------------------------------
+---------

sub process_orders {
    my($aOrder);
        my($sth) = Cos::Order::select_new();

    while ($aOrder = $sth->fetchrow_hashref()) {
        process_the_order($aOrder->{orders_pending_id}, $aOrder);
    }
    $sth->finish();
}

sub get_transport {
    my($lab) = @_;


    return $Force_Transport if $Force_Transport;

    return $Transport{$lab} if defined $Transport{$lab};

    my($ref) = sql("select transport from lab_info where lab_id = ?", 
+$lab);

    if ($ref->{transport} eq '') {
        $Transport{$lab} = $Default_Transport;
    } else {
        $Transport{$lab} = $ref->{transport};
    }
    return $Transport{$lab};
}

sub process_an_order {
    my($order) = @_;

    my($aOrder) = Cos::Order::fetch($order);

    process_the_order($order, $aOrder);
}

sub process_the_order {
    my($order, $aOrder) = @_;
    
    if ($Lab) {
        print "Override lab $aOrder->{lab_id} -> $Lab\n";
        $aOrder->{lab_id} = $Lab;
    }
    my($transport) = get_transport($aOrder->{lab_id});

    return if $transport eq '';

    if ($transport eq 'mail-rx') {
        my($rc) = system('rx-mail-order', '-M', $order);
#        if ($rc == 0) {
#            tag_order($order, 'C');
#        }
        return;
    }
    if ($transport eq 'perl-rx') {
#        send_order_rx($aOrder);
        return;
    }
    if ($transport eq 'perl-rdt') {
        send_order_rdt($aOrder);
        return;
    }
    if ($transport eq 'perl-rxi') {
        send_order_rxi($aOrder);
        return;
    }
    if ($transport eq 'java-rdt') {
        system("java -jar Order $order");
        return;
    }
    if ($transport eq 'no-send') {
        tag_order($order, 'C');
        return;
    }
    if ($transport eq 're-queue') {
        tag_order($order, 'N');
        return;
    }
    warn "Unknown transport: $transport, order=$order\n";
}

sub send_order_rx {
    my($aOrder) = @_;
    my($order) = $aOrder->{orders_pending_id};

    eval {
        my($base) = ''; #generate_rx($Dir, $aOrder);

        if ($Mail) {
            queue_via_mail($base, $aOrder);

            tag_order($order, 'C');

            unlink($base . 'rx');
        }
    };
    if ($@) {
        warn "rdt send $order failed: $@\n";
    }
}
sub send_order_rdt {
    my($aOrder) = @_;
    my($order) = $aOrder->{orders_pending_id};

    eval {
        my($base) = generate_rdt($Dir, $aOrder);

        if ($Mail) {
            queue_via_mail($base, $aOrder);

            tag_order($order, 'C');

            unlink($base . 'r');
            unlink($base . 'd');
            unlink($base . 't');
        }
    };
    if ($@) {
        warn "rdt send $order failed: $@\n";
    }
}

sub send_order_rxi {
    my($aOrder) = @_;
    my($order) = $aOrder->{orders_pending_id};

    eval {
        my($base) = generate_rxi($Dir, $aOrder);

        if ($Mail) {
            queue_via_mail($base, $aOrder);

            tag_order($order, 'I');

            unlink($base . '.rxi');
            unlink($base . '.oma');
        }
    };
    if ($@) {
        warn "rxi send $order failed: $@\n";
    }
}

#=====================================================================
+==========
# queue_via_mail
#=====================================================================
+==========

sub queue_via_mail {
    my($base, $aOrder) = @_;
    # no-op until we are done.

    my($msg);
    my($file) = $base;
    $file =~ s=.*:==;

    my($order) = $aOrder->{orders_pending_id};
    my($lab)   = $aOrder->{lab_id};
    
    my($user_id) = $aOrder->{user_id};
    my($to) = get_to_address($lab);

    $msg = MIME::Lite->new(
                        From    => 'problems@optical-online.com',
                        To      => $to,
                        Subject => "user $user_id order $order -> lab 
+$lab ($file)",
                        Type    => 'multipart/mixed'
                        );

#    if the order has rxi and oma files attach those not the rdt files
    $msg->attach(
        Type => 'application/octet-stream',
        Path => $base . 'r',
        Filename => "orders/${file}r",
        Disposition => 'attachment'
    );

    $msg->attach(
        Type => 'application/octet-stream',
        Path => $base . 'd',
        Filename => "orders/${file}d",
        Disposition => 'attachment'
    );

    if (-s ($base . 't')) {
        $msg->attach(
            Type => 'application/octet-stream',
            Path => $base . 't',
            Filename => "orders/${file}t",
            Disposition => 'attachment'
        );
    }
    $msg->send;
    print "Sent: $to\n";
}

#=====================================================================
+==========
# get_to_address
#=====================================================================
+==========
sub get_to_address {
    my($lab_id) = @_;
    my($ref) = sql("select mbox from lab_info where lab_id = ?", $lab_
+id);

    if ($ref->{mbox} eq 'problems') {
        die "Can't send to mailbox for lab $lab_id  mailbox == 'proble
+ms'\n";
    }
    if ($Force_Mail) {
        print "Not sending to $ref->{mbox}in\@mail.optical-online.com\
+n";
        return $Force_Mail;
    }
    return $ref->{mbox} . "ot\@mail.optical-online.com";
}

#=====================================================================
+==========
# tag_order
#=====================================================================
+==========
sub tag_order {
    my($order_id, $tag) = @_;

        my($query) = <<"EOF";
update orders_pending set status = ? where orders_pending_id = ?
EOF

    my($dbh) = Cos::Dbh::new();
    my($sth);

        $sth = $dbh->prepare ($query)  or die "Can't prepare: $query. 
+Reason: $!";
        $sth->execute($tag, $order_id) or die "Can't execute: $query. 
+Reason: $!";
}

[download]
#!/usr/bin/perl -w

=head1 NAME

 use Cos::rxi

=head1 SYNOPIS

used to generate rxi files

=head1 DESCRIPTION

=head1 AUTHOR

=head1 COPYRIGHT

=head1 SEE ALSO

=cut

package Cos::rxi;

use strict;
#use warnings;

use Getopt::Std;
use DBI;
use Cos::Constants;
use Cos::Dbh;
use Math::Trig;

BEGIN {
        use Exporter   ();
        use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

        # set the version for version checking
        $VERSION     = 1.00;
        # if using RCS/CVS, this may be preferred
        $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf
+ "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker

        @ISA         = qw(Exporter);
        @EXPORT      = qw(generate_rxi);
        %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

        # your exported package globals go here,
        # as well as any optionally exported functions
        @EXPORT_OK   = qw();
}
use vars @EXPORT_OK;


########################################################
#    create the rxi and oma files for an Innovations order
########################################################
sub generate_rxi {
    my($dir, $aOrder) = @_;

    my $orderId  = $aOrder->{orders_pending_id};
  my $userId = $aOrder->{user_id};
  my $labId  = $aOrder->{lab_id};
    
  print "Processing Order # $orderId, lab: $labId, user: $userId\n";

    my($base) = $dir.$aOrder->{field_acct_id}.'-'.$aOrder->{orders_pen
+ding_id}.'.';

    open(FH, "> $base.rxi\0") or die "Can't create $base ($!)\n";
    print FH "TRC " . $aOrder->{field_acct_id} . '-' . $aOrder->{order
+s_pending_id};
    print FH "PTN " . $aOrder->{field_client_name};
    if ($aOrder->{lens_Pair} == "1") {
        print FH "LNS  0 1";
    } elsif ($aOrder->{lens_Pair} == "2") {
        print FH "LNS  1 0";
    } else {
        print FH "LNS  1 1";
    }
    print FH "LAS " . lensAlias($aOrder->{lens_OD_MaterCode},
                                     $aOrder->{lens_OD_StyleCode},
                                     $aOrder->{lens_OD_ColorCode},
                                     $aOrder->{lens_OS_MaterCode},
                                     $aOrder->{lens_OS_StyleCode},
                                     $aOrder->{lens_OS_ColorCode});   
+ #CREATE THE LENS ALIAS
    print FH "DBL " . $aOrder->{fdDBL};
    print FH "FSC 1";                                # diameter orders
+ will send 6 and a UBS
    my $frameDesc = rtrim($aOrder->{frame_desc});
    if ($frameDesc =~ m/$\d/) {
        print FH "FTP ". substr($frameDesc, length($frameDesc)-1, leng
+th($frameDesc));
    } else{
        print FH "FTP 0";
    }
    print FH "SPH " . $aOrder->{rx_OD_Sphere} . '  ' . $aOrder->{rx_OS
+_Sphere};
    print_if(\*FH, 'CYL ', $aOrder->{rx_OD_Cylinder}, $aOrder->{rx_OS_
+Cylinder});
    print_if(\*FH, 'AXS ', $aOrder->{rx_OD_Axis}, $aOrder->{rx_OS_Axis
+});
    print_if(\*FH, 'ADD ', $aOrder->{rx_OD_Add}, $aOrder->{rx_OS_Add})
+;
    print_if(\*FH, 'FPD ', $aOrder->{rx_od_far}, $aOrder->{rx_os_far})
+;
    print_if(\*FH, 'NPD ', $aOrder->{rx_od_near}, $aOrder->{rx_os_near
+});
    print_if(\*FH, 'SHT ', $aOrder->{rx_OD_Seg_Height}, $aOrder->{rx_O
+S_Seg_Height});
    print_if(\*FH, 'OCH ', $aOrder->{rx_OD_OC_Height}, $aOrder->{rx_OS
+_OC_Height});
    print_if(\*FH, 'BCV ', $aOrder->{rx_OD_Special_Base_Curve}, $aOrde
+r->{rx_OS_Special_Base_Curve});
    if ( length($aOrder->{rx_OD_Special_Thickness}) > 0
        || length($aOrder->{rx_OS_Special_Thickness}) > 0) {
        my $temp1 = length($aOrder->{rx_OD_Special_Thickness}) > 0 
                                    ? $aOrder->{rx_OD_Special_Thicknes
+s}
                                    : '0.00';
        my $temp2 = length($aOrder->{rx_OS_Special_Thickness}) > 0 
                                    ? $aOrder->{rx_OS_Special_Thicknes
+s}
                                    : '0.00';
        if ($aOrder->{rx_OD_Thickness_Reference} == 'Edge') {
            print FH 'EDG ' . $temp1 . '  ' . $temp2;
        } else {
            print FH 'CTH ' . $temp1 . '  ' . $temp2;
        }
    }
    if (length($aOrder->{rx_OD_Prism_Diopters}) ne 0 
            || length($aOrder->{rx_OS_Prism_Diopters}) ne 0) {
        my @array1 = qw($aOrder->{rx_OD_Prism_Diopters} 
                                                            $aOrder->{
+rx_OD_Prism} 
                                                            $aOrder->{
+rx_OD_Prism_Angle_Val}
                                                            $aOrder->{
+rx_OD_Prism2_Diopters}
                                                            $aOrder->{
+rx_OD_Prism2});

        my @array2 = qw($aOrder->{rx_OS_Prism_Diopters}
                                                            $aOrder->{
+rx_OS_Prism}
                                                            $aOrder->{
+rx_OS_Prism_Angle_Val}
                                                            $aOrder->{
+rx_OS_Prism2_Diopters}
                                                            $aOrder->{
+rx_OS_Prism2});
        # if values are specified as Angles, convert them to direction
        if ($array1[1] == 'Angle') {convertPrismData(0, \@array1);}
        if ($array2[1] == 'Angle') {convertPrismData(1, \@array2);} 
        
        my $ODP1Val = $array1[0];
        my $ODP1Dir = $array1[1];
        my $ODP2Val = $array1[3];
        my $ODP2Dir = $array1[4];
        my $OSP1Val = $array2[0];
        my $OSP1Dir = $array2[1];
        my $OSP2Val = $array2[3];
        my $OSP2Dir = $array2[4];
        # Innovations only expresses prism as IN or UP
        # reverse anthing that is OUT or DOWN
        if ($ODP1Dir == "OUT" || $ODP1Dir == "DOWN") {
            if (length($ODP1Val != 0) {$ODP1Val = '-' . $ODP1Val);}
            if ($ODP1Dir == "OUT") {
                $ODP1Dir = "IN");
            } else {
                $ODP1Dir = "UP");
            }
        }
        if ($ODP2Dir == "OUT" || $ODP2Dir == "DOWN") {
            if (length($ODP2Val != 0) {$ODP2Val = '-' . $ODP2Val);}
            if ($ODP2Dir == "OUT") {
                $ODP2Dir = "IN");
            } else {
                $ODP2Dir = "UP");
            }
        }
        if ($OSP1Dir == "OUT" || $OSP1Dir == "DOWN") {
            if (length($OSP1Val != 0) {$OSP1Val = '-' . $OSP1Val);}
            if ($OSP1Dir == "OUT") {
                $OSP1Dir = "IN");
            } else {
                $OSP1Dir = "UP");
            }
        }
        if ($OSP2Dir == "OUT" || $OSP2Dir == "DOWN") {
            if (length($OSP2Val != 0) {$OSP2Val = '-' . $OSP2Val);}
            if ($OSP2Dir == "OUT") {
                $OSP2Dir = "IN");
            } else {
                $OSP2Dir = "UP");
            }
        }
        my $PIN_String;
        my $PUP_String;
        if (length($ODP1Val) > 0) {
            if ($ODP1Dir == "IN") {
                $PIN_String = $ODP1Val;
                $PUP_String = (length($ODP2Val) > 0) ? $ODP2Val : "  0
+.00");
            } else { #UP 
                $PUP_String = $ODP1Val;
                $PIN_String = (length($ODP2Val) > 0) ? $ODP2Val : "  0
+.00");
            }
        } else {
            $PIN_String = "  0.00";
            $PUP_String = "  0.00";
        }
        if (length($OSP1Val) > 0) {
            if ($OSP1Dir == "IN") {
                $PIN_String .= (" " . $OSP1Val);
                $PUP_String .= length($OSP2Val) > 0) ? ("  " . $OSP2Va
+l) : "  0.00");
            } else { 
                $PUP_String .= (" " . $OSP1Val);
                $PIN_String .= (length($OSP2Val) > 0) ? ("  " . $OSP2V
+al) : "  0.00");
            }
        } else {
            $PIN_String .= " 0.00";
            $PUP_String .= " 0.00";
        }
        print FH "PIN " . $PIN_String;
        print FH "PUP " . $PUP_String;
    }
    if (length(trim($aOrder->{tr_Tinting})) > 0 ||
        length(trim($aOrder->{tr_TintColor})) > 0 ||
        length(trim($aOrder->{tr_TintPerCent})) > 0) {
            print FH "SPT " . $aOrder->{tr_Tinting} . " " . $aOrder->{
+tr_TintColor} . " " . $aOrder->{tr_TintPerCent};
    }
    if (length(trim($aOrder->{tr_Coating})) > 0 ||
        length(trim($aOrder->{tr_AntiReflective})) > 0) {
            print FH "SPC " . $aOrder->{tr_Coating} . " " . $aOrder->{
+tr_AntiReflective};
    }
    if (length(trim($aOrder->{tr_Treatment})) > 0 ||
        length(trim($aOrder->{tr_Other1})) > 0 ||
        length(trim($aOrder->{tr_Other2})) > 0 ||
        length(trim($aOrder->{tr_Other3})) > 0 ||
        length(trim($aOrder->{tr_Other4})) > 0) {
            print FH "SPX " . $aOrder->{tr_Treatment} . " " . $aOrder-
+>{tr_Other1}
                                 . " " . $aOrder->{tr_Other2} . " " . 
+$aOrder->{tr_Other3}
                                 . " " . $aOrder->{tr_Other4};
    }
    print FH "$$$";
    close(FH);

    t_write($base.'oma', $aOrder);

    return $base;
}


########################################################
#    create the lens alias value
########################################################
sub lensAlias {
    my($mcodeL, $scodeL, $ccodeL, $mcodeR, $scodeR, $ccodeR) = @_;
    return lpad($mcodeL,3).lpad($scodeL,5).lpad($ccodeL,5).lpad($mcode
+R,3).lpad($scodeR,5).lpad($ccodeR,5).
            ', ' . lpad($mcodeL,3).lpad($scodeL,5).lpad($ccodeL,5).lpa
+d($mcodeR,3).lpad($scodeR,5).lpad($ccodeR,5);
}


########################################################
#    print if there are values
########################################################
sub print_if {
    my($FH, $orderKey, $odVal, $osVal) = @_;
    if ($odVal == null) {$odVal = '0';}
    if ($osVal == null) {$osVal = '0';}
    if ($odVal > 0 || $osVal > 0) {
        print $FH $orderKey . '  ' . $odVal . '  ' . $osVal;
    }
} 


########################################################
#    convert prism angle to its vertical and horizontal components
########################################################
sub convertPrismData {
    my($lr) = $_[0];
    my($q2q3,$q1q4);
    
    if ($lr == 0) {    # OD setup
        $q2q3 = "OUT";
        $q1q4 = "IN";
    } else {            # OS setup
        $q2q3 = "IN";
        $q1q4 = "OUT";
    }
    my $vertical_component = round($_[1]->[0] * sin($_[1]->[2] * PI/18
+0.0) * 100.0) / 100.0;
    my $horizontal_component = round($_[1]->[0] * cos($_[1]->[2] * PI/
+180.0) * 100.0) / 100.0;
    $_[1]->[0] = abs($vertical_component);
    $_[1]->[1] = (($vertical_component < 0)  ? "DOWN" : "UP");
    $_[1]->[3] = abs($horizontal_component);
    $_[1]->[4] = (($horizontal_component < 0) ? $q2q3 : $q1q4);
    return;
}


########################################################
#    pad value with leading zeros
########################################################
sub lpad {
    my($v, $pad) = @_;

    return sprintf("%0${pad}d", $v);
}


########################################################
#    write the trace into a file
########################################################
sub t_write {
    my($file, $aOrder) = @_;
    my($trace) = $aOrder->{trace_file_data};

    if (!defined($trace) || length($trace) == 0) {
        print "No trace file.\n";
        return;
    }
    open(F, "> $file\0") or die "Can't create trace-file $file ($!)\n"
+;
    print F $trace;
    close(F);
    print "Trace file: $file\n";
}


########################################################

[download]

Replies are listed 'Best First'.
Re^3: global symbol...explict package name
by ikegami (Patriarch) on Mar 13, 2008 at 02:17 UTC

    That doesn't change anything. Like I already said, the "requires explicit package name" errors should go away after you fix the earlier errors: 

    >perl -c -e"use Cos::rxi"
syntax error at Cos/rxi.pm line 141, near ") {"
syntax error at Cos/rxi.pm line 143, near ""IN")"
syntax error at Cos/rxi.pm line 145, near ""UP")"
syntax error at Cos/rxi.pm line 149, near ") {"
syntax error at Cos/rxi.pm line 151, near ""IN")"
syntax error at Cos/rxi.pm line 153, near ""UP")"
Global symbol "$OSP1Dir" requires explicit package name at Cos/rxi.pm 
+line 156.
Global symbol "$OSP1Dir" requires explicit package name at Cos/rxi.pm 
+line 156.
Global symbol "$OSP1Val" requires explicit package name at Cos/rxi.pm 
+line 157.
syntax error at Cos/rxi.pm line 157, near ") {"
Cos/rxi.pm has too many errors.
Compilation failed in require at -e line 1.
BEGIN failed--compilation aborted at -e line 1.

    [download]

    Let's explain this in the context of you trying to communicate a program to perl. Due to the earlier errors, you and perl are on different pages (as the saying goes). You think you're communicating one thing, perl thinks you're communicating another, and you end up with new problems that correct themselves when the earlier communication problem is resolved.

    Note: I had to comment out use Cos::Constants; and use Cos::Dbh;, but having them is not going to affect the result. Please don't post these too.

[reply]
[d/l]
[select]
      Hi, I executed the same command you did  perl -c -e "use Cos::rxi" and the only errors I get are the global symbol errors. My first belief is that I am not correctly putting the $aOrder hash values in to the array for the convertPrismData subroutine... but I obviously don't know. None-the-less I don't get the syntax errors. Thank you for helping.
[reply]
[d/l]

        Either something is very broken your perl or something you said isn't true since the following *IS* a syntax error: 

              if (length($ODP1Val != 0) {$ODP1Val = '-' . $ODP1Val);}
      if ($ODP1Dir == "OUT") {
        $ODP1Dir = "IN");
      } else {
        $ODP1Dir = "UP");
      }

        [download]
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom