Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

global symbol...explict package name

by rightfield (Sexton)
on Mar 13, 2008 at 00:51 UTC ( [id://673863]=perlquestion: print w/replies, xml ) Need Help??

rightfield has asked for the wisdom of the Perl Monks concerning the following question:

Hi experts, I am stuck trying to figure out how to satisfy a global symbol requires explicit package name error. My beginning Perl program specifies 'use Cos::rxi;' and then calls a subroutine in the rxi.pm package called 'generate_rxi' using eval {} as follows: 
sub send_order_rxi {
my($aOrder) = @_;
my($order) = $aOrder->{orders_pending_id};
 
eval {
        ### here's where I call the subroutine
        ### located in the rxi.pm package
    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";
}
}

[download]
There is a big 'if' statement in the subroutine generate_rxi which I have dropped in below. I have put ### comments above the places where Perl complains about needing an explicit package name for a global symbol. Could someone help me understand this. Below the 'if' block I have dropped the small subroutine (convertPrismData) which is called from the 'if' block and below that I have dropped the beginning of the rxi.pm package file. Once you tell me what I did wrong feel free to recommend a good book on Perl basics as I apparently need it. Thank you and warm regards, 
###################################################
# this is the 'if' block where the global symbol
# complaints occur
# this 'if' block is in the subroutine 'generate_rxi'
# which is part of the package rxi.pm
####################################################
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");
      }
    }
    ### first global symbol complaint is on $ODP2Dir
    if ($ODP2Dir == "OUT" || $ODP2Dir == "DOWN") {
      ### second global symbol complaint is on $ODP2Val
      if (length($ODP2Val != 0) {$ODP2Val = '-' . $ODP2Val);}
      if ($ODP2Dir == "OUT") {
        $ODP2Dir = "IN");
      } else {
        $ODP2Dir = "UP");
      }
    }
    ### third global symbol complaint is on $OSP1Dir
    if ($OSP1Dir == "OUT" || $OSP1Dir == "DOWN") {
      ### fourth (and final) global symbol complaint is on $OSP1Val
      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) ? ("  " . $OSP2Val) : "  
+0.00");
      } else { 
        $PUP_String .= (" " . $OSP1Val);
        $PIN_String .= (length($OSP2Val) > 0) ? ("  " . $OSP2Val) : " 
+ 0.00");
      }
    } else {
      $PIN_String .= " 0.00";
      $PUP_String .= " 0.00";
    }
    print FH "PIN " . $PIN_String;
    print FH "PUP " . $PUP_String;
}

[download]
########################################################
#  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/180.
+0) * 100.0) / 100.0;
  my $horizontal_component = round($_[1]->[0] * cos($_[1]->[2] * PI/18
+0.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;
}

[download]
#############################################
# This is the beginning of the rxi.pm package
# the subroutine generate_rxi is in this
# package. I thought this may help in fixing
# the global symbol issue
#############################################
#!/usr/bin/perl -w

package Cos::rxi;

use strict;
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;

[download]

Replies are listed 'Best First'.
Re: global symbol...explict package name
by ikegami (Patriarch) on Mar 13, 2008 at 01:49 UTC
    Really? Cause when I compile your first snippet with use strict; and use warnings; added, I get: 
    >perl -c script.pl
Global symbol "$aOrder" requires explicit package name at script.pl li
+ne 11.
Global symbol "$aOrder" requires explicit package name at script.pl li
+ne 12.
syntax error at script.pl line 38, near ") {"
syntax error at script.pl line 40, near ""IN")"
syntax error at script.pl line 42, near ""UP")"
syntax error at script.pl line 48, near ") {"
syntax error at script.pl line 50, near ""IN")"
syntax error at script.pl line 52, near ""UP")"
syntax error at script.pl line 54, near "}"
script.pl had compilation errors.

    [download]

    The code you showed us and the code that gave you those errors are different. Until you reconcile this, there's no much we can do.

    Give your erroneous usage of parens, I suspect the error you are trying to fix is actually an side-effect of other errors. Fix those, and Perl will see that the my are still in scope.

[reply]
[d/l]
[select]
      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]
[reply]
[d/l]
[select]

        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]
Re: global symbol...explict package name
by almut (Canon) on Mar 13, 2008 at 02:00 UTC

    Another thing which is a little strange is your usage of qw() as in 

        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});

    [download]

    This would set up an array with the literal strings '$aOrder->{rx_OD_Prism_Diopters}' etc., which doesn't seem to be what you want, considering how those values in @array1 are being used subsequently...

[reply]
[d/l]
[select]
      Hi. You are correct, I want the value of $aOrder->{blah} to go into the array, how would I correct that part? Is it strange how the complaints start with $ODP2Dir and $ODP2Val but not several lines above with $ODP1Dir and $ODP1Val? What's with that? Thank you.
[reply]
        I want the value of $aOrder->{blah} to go into the array, how would I correct that part?

        Just get rid of the qw, and put commas between the expressions, i.e. 

        my @array1 = ( $aOrder->{rx_OD_Prism_Diopters},
               $aOrder->{rx_OD_Prism}, 
               $aOrder->{rx_OD_Prism_Angle_Val},
               $aOrder->{rx_OD_Prism2_Diopters},
               $aOrder->{rx_OD_Prism2} );

        [download]
[reply]
[d/l]
[select]
Re: global symbol...explict package name
by Pancho (Pilgrim) on Mar 13, 2008 at 01:53 UTC

    Disclaimer first - I am no expert, and this is just a hunch...
    Perl complains about needing an explicit package name for a global symbol
    I suspect the issue is with the big if and and more specifically with the scope of the variables that Perl is complaining about. You might be trying to access these variables outside of the scope (i.e. enclosing block) in which you defined them. I checked the code, trying to see if I could catch the problem with the blocks but I don't see it. You might want to explore this in the meantime as the experts reply (if your are in a crunch) Good luck!.
    Pancho
[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://673863]
Approved by Joost
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others learning in the Monastery: (2)
As of 2025-06-21 21:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?
    • erzuuli‥ Anonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.