First steps to writing a module?

[deadpool42]

I've decided to write a simple perl module as an interface to forum software written in php. Basically, I just want to be give the script access to a few functions through an object-oriented interface. Here's what I've gathered so far from the perl documentation:

BEGIN {
     use Exporter ();
     our (@ISA, @EXPORT, @EXPORT_OK);
     @ISA = qw(Exporter);
     @EXPORT = qw(new);
     @EXPORT_OK = qw();
}

sub new {
        my $this = shift;
        my $class = ref($this) || $this;
        my $self = {};
        bless $self, $class;
        return $self;
}

Is anything missing? Also, won't using new as the name of the constructor subroutine cause conflicts with other modules?

 

[deadpool42]

Can anyone at least point me to a more comprehensive tutorial than the one that comes with perl?

 

[Leland123]

Hi,

Here is a class I'm using in a shopping cart development project. Although the script is lengthy, when examined you fine the properties and method are really simple. To see a demo of the app to which this class belongs, click on the below link:

http://www.smvfp.com/demo/kart_index.pl

#-------------------------------------------------

# Class Smglobal
package Smglobal;

use Sm_session;
use Sm_css;
use Sm_error_hand;
use Sm_reports;

@ISA = qw( Sm_session Sm_css Sm_error_hand Sm_reports );

##################################################
## the object constructor (simplistic version) ##
##################################################
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {
};

my $self = Sm_css->new();

########### Company Name #########
$self->{THE_COMPANY} = "Software - Master (TM)";
$self->{THE_VERSION} = "0.5";

############ Paths ################
$self->{MAIN_PATH} = "/cgi-bin/Smorders";
$self->{PICTURE_PATH} = "/images";

############ generic user ################
$self->{THE_SEQ_HERE} = "smgeneric";
$self->{THE_WAIT_GET} = "generic";

############ adm user ################
$self->{ADM_SEQ_HERE} = "the_admin";
$self->{ADM_WAIT_GET} = "admin_pw";

############ The Database ##################
#self->{THE_SERVER} = "postgres";
$self->{THE_HOST} = "localhost";
$self->{THE_DBI} = "Pg:dbname";
$self->{THE_DB} = "smvfp";
$self->{THE_PORT} = 5432;
$self->{THE_AUTOCOMMIT} = 1;

############# exec SQL ##################
$self->{DBH} = undef;
$self->{STH} = undef;

############# phrase_offset ##############
$self->{FIRST_PAGE} = undef;
$self->{THESEARCH} = undef;
$self->{THE_OFFSET} = undef;

############### email #################
$self->{MAIL_FROM} = "smvfp\@mail.smvfp.com";

############## others ###################
$self->{THE_DATE} = undef;
$self->{FORMATED_NO} = undef;
$self->{DO_ICONS} = undef;
$self->{THE_VALUE} = undef;
$self->{THE_CORD} = undef;
$self->{SQL_SUBSTITUTE} = "#";
$self->{THUMBNAIL_HEIGTH} = 150;
$self->{THUMBNAIL_WIDTH} = 150;
$self->{CONFIRM_UPDATES} = "yes";
$self->{CONFIRM_DELETES} = "yes";
$self->{IS_DEMO} = "no";

############ linkpoint ##################
$self->{DO_LINKPOINT} = "yes";
$self->{HOST_NAME} = "secure.linkpt.net";
$self->{PORT} = "xxxx";
$self->{STORE_NUMBER} = "123456789";
$self->{KEY_FILE} = "/var/

http://www/cgi-bin/somefile.pem";

$self->{ORDERTYPE} = "GOOD"; ## For a test, set ORDERTYPE to GOOD, DECLINE, or DUPLICATE. To process real transactions set ORDERTYPE TO LIVE.

############# pay method ############

$self->{ACCEPT_VISA} = "yes";
$self->{ACCEPT_MASTERCARD} = "yes";
$self->{ACCEPT_AMEX} = "no";
$self->{ACCEPT_DISCOVER} = "no";
$self->{ACCEPT_CHECK} = "yes";

bless ($self, $class);
return $self;
}

##############################################
## methods to access per-object data ##
## ##
## With args, they set the value. Without ##
## any, they only retrieve it/them. ##
##############################################

##################################################
################## sql_dbh #####################
##################################################
sub sql_dbh
{

my $self = shift;

my ($userlogged) = @_;

if ($userlogged eq "t")
{
eval
{

$self->{DBH} = DBI->connect("DBI:$self->{THE_DBI}=$self->{THE_DB};host=$self->{THE_HOST};port=$self->{THE_PORT}", $self->{ADM_SEQ_HERE}, $self->{ADM_WAIT_GET}); ## Get connected

$self->{DBH}->{RaiseError} = 1; ## Turn on Errrors

$self->{DBH}->{autocommit} = $self->{THE_AUTOCOMMIT}; ## set [THE_AUTOCOMMIT] to 0 to turn transactions on.

};

}
else
{

eval
{
$self->{DBH} = DBI->connect("DBI:$self->{THE_DBI}=$self->{THE_DB};host=$self->{THE_HOST};port=$self->{THE_PORT}", $self->{THE_SEQ_HERE}, $self->{THE_WAIT_GET}); ## Get connected

$self->{DBH}->{RaiseError} = 1; ## Turn on Errrors

$self->{DBH}->{autocommit} = $self->{THE_AUTOCOMMIT}; ## set [THE_AUTOCOMMIT] to 0 to turn transactions on.

};

}

if ($@)
{

$the_error = "I was unable to connect to the database because $@";

$self->error_form($the_error);

if( defined($self->{DBH}) )
{
$self->{DBH}->disconnect();
}

exit;

}
else
{
return $self->{DBH};
}

}

##################################################
################### sql_exec ###################
##################################################
sub sql_exec
{

my $self = shift;

my ($the_sql) = @_;

###### print "<b><font color='red'><b>This is the SQL:</font><font color='blue'> $the_sql</font><br><br>";


$self->{DBH}->quote($the_sql);


if ( $self->{THE_AUTOCOMMIT} == 0 )
{
$self->{DBH}->BEGIN; ## begin transaction
}

eval
{
$self->{STH} = $self->{DBH}->prepare($the_sql);
$self->{STH}->execute;

if ( $self->{THE_AUTOCOMMIT} == 0 )
{
$self->{DBH} ->commit() ## begin transaction
}
};

if ($@)
{
my $the_error = "The database server returned the following message:<br><br>$@";

$the_error = $the_error . "<br><br>The SQL pass to the database Server was:<br><br>$the_sql";

$self->error_form($the_error);

if ( $self->{THE_AUTOCOMMIT} == 0 )
{
eval
{
$self->{DBH}->rollback() ## in case rollback() fails
};
}

if( defined($self->{DBH}) )
{
$self->{DBH}->disconnect();
}
exit;
}
else
{
return $self->{STH};
}
}

####################################################
################ phrase_offset ###################
####################################################

sub phrase_offset
{

my $self = shift;

my ( $thesearch, $rows_per_page, $count_rows, $goto_offset, $first_page, $prefix_name ) = @_;

$the_temp1 = $count_rows/$rows_per_page;
$the_temp2 = int($count_rows/$rows_per_page);

if ( $the_temp1 == $the_temp2 )
{
$number_of_pages = $the_temp1;
}
else
{
$number_of_pages = ($the_temp2 + 1);
}

$last_page = $number_of_pages;

if ( !$first_page )
{
$first_page = 1;
$goto_offset = 1;
}

if ( $goto_offset eq "First" )
{
$first_page = 1;
$goto_offset = 1;
}
elsif ( $goto_offset eq "Last" )
{
$first_page = $last_page;
$first_page = ( int( $number_of_pages/7 )*7 );
if ( $first_page < $number_of_pages )
{
$first_page += 1;
}
$goto_offset = $first_page;
}
elsif ( $goto_offset eq "Next" )
{
$first_page = $first_page + 7;
$goto_offset = $first_page;
}
elsif ( $goto_offset eq "Prev" )
{
$first_page = $first_page - 7;
if ( $first_page < 1 )
{
$first_page = 1;
}
$goto_offset = $first_page;
}


$the_offset = ( $rows_per_page * ($goto_offset -1) );

$thesearch = $thesearch . " LIMIT $rows_per_page OFFSET $the_offset";

$self->{THESEARCH} = $thesearch;

$the_First = $prefix_name . "_goto_offset-First-";
$the_Prev = $prefix_name . "_goto_offset-Prev-";

if ( $first_page > 1 )
{
if ( $self->{DO_ICONS} eq "true" )
{
$self->menuheadstyle("1","<input type='image' src='$self->{PICTURE_PATH}/WZTOP.BMP' height='22' width='22' title='First' alt='First' name='$the_First' value='First'>","center");
$self->menuheadstyle("1","<input type='image' src='$self->{PICTURE_PATH}/WZBACK.BMP' height='22' width='22' title='Previous' alt='Previous' name='$the_Prev' value='Prev'>","center");
}
else
{
$self->menuheadstyle("1","<input type='Submit' name='$the_First' value='First'>","center");
$self->menuheadstyle("1","<input type='Submit' name='$the_Prev' value='Prev'>","center");
}

}

if ( $last_page <= $number_of_pages )
{
$i = $first_page;
while ( ( $i <= $number_of_pages ) and ( $i < ( $first_page + 7 ) ) )
{
$name_value = "$prefix_name" . "_goto_offset-" . $i . "-.x";
$the_html = "<input type='Submit' name='$name_value' value='$i'>";

$self->menuheadstyle("1",$the_html,"center");

$i += 1;
}
}

$last_on_screen_page = $i-1;

$the_Next = $prefix_name . "_goto_offset-Next-";
$the_Last = $prefix_name . "_goto_offset-Last-";

if ( $last_on_screen_page < $last_page )
{
if ( $self->{DO_ICONS} eq "true" )
{
$self->menuheadstyle("1","<input type='image' src='$self->{PICTURE_PATH}/WZNEXT.BMP' height='22' width='22' title='Next' alt='Next' name='$the_Next' value='Next'>","center");
$self->menuheadstyle("1","<input type='image' src='$self->{PICTURE_PATH}/WZEND.BMP' height='22' width='22' title='Last' alt='Last' name='$the_Last' value='Last'>","center");
}
else
{
$self->menuheadstyle("1","<input type='Submit' name='$the_Next' value='Next'>","center");
$self->menuheadstyle("1","<input type='Submit' name='$the_Last' value='Last'>","center");
}

}

###### Uncomment for debugging
###### print "smglobal the search $thesearch<br>";
###### print "smglobal rows per page $rows_per_page<br>";
###### print "smglobal count rows $count_rows<br>";
###### print "smglobal go to offset $goto_offset<br>";
###### print "smglobal first page $first_page<br>";
###### print "smglobal prefix name $prefix_name<br>";

$self->{GOTO_OFFSET} = $goto_offset;
$self->{FIRST_PAGE} = $first_page;
if ( $the_offset <= 0 )
{
$self->{THE_OFFSET} = 0;
}
else
{
$self->{THE_OFFSET} = $the_offset;
}
return;
}

####################################################
############## go_back ###########################
####################################################
sub go_back
{
my $self = shift;
print "<a href='#' onclick='history.back()'><img SRC='$self->{PICTURE_PATH}/backarow.gif' border='0' title='Back to Previous Page' alt='Back to Previous Page'</a>";
}

############################################
############## split_name ################
############################################
sub split_name
{
my $self = shift;

my ( $name_value_pair ) = @_;

$self->{THE_CORD} = shift;
$self->{THE_VALUE} = shift;

@name_value_cord = split( /-/ , $name_value_pair );

if ( $self->{DO_ICONS} eq "true" )
{
if ( $name_value_cord[2] eq "\.x" )
{
$self->{THE_CORD} = 'true';
$self->{THE_VALUE} = $name_value_cord[1];
}
else
{
$self->{THE_CORD} = 'false';
}
}
else
{
$self->{THE_CORD} = 'true';
$self->{THE_VALUE} = $name_value_cord[1];
}
return ( $self->{THE_CORD}, $self->{THE_VALUE} );
}

#################################################
############# get_browser #####################
#################################################
sub get_browser
{
my $self = shift;

my ($browser_string ) = @_;

$self->{DO_ICONS} = shift;

my $http_user_agent = $browser_string;

if ( $browser_string =~ m/Firebird/ )
{
$self->{DO_ICONS} = "true";
}
if ( $browser_string =~ m/Firefox/ )
{
$self->{DO_ICONS} = "true";
}
elsif ( $browser_string =~ m/Konqueror/ )
{
$self->{DO_ICONS} = "false";
}
elsif ( $browser_string =~ m/Netscape/ )
{
$self->{DO_ICONS} = "true";
}
elsif ( $browser_string =~ m/Opera/ )
{
$self->{DO_ICONS} = "false";
}
elsif ( $browser_string =~ m/Gecko/ )
{
$self->{DO_ICONS} = "true";
}
else
{
$self->{DO_ICONS} = "false";
}
return ( $self->{DO_ICONS} );
}

####################################################
############## check_browser #####################
####################################################
sub check_browser
{
my $self = shift;

if ( @_ )
{
$self->{DO_ICONS} = shift;
$self->{DO_iCONS} = @_;
}
}


####################################################
################# number_format_return ###########
####################################################
sub format_number_return
{
my $self = shift;

if ( @_ )
{
$self->{FORMATED_NO} = shift;
$self->{FORMATED_NO} = sprintf ( "%.2f" , $self->{FORMATED_NO} );
$self->{FORMATED_NO} = reverse $self->{FORMATED_NO};
$self->{FORMATED_NO} =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
$self->{FORMATED_NO} = "\$" . scalar reverse $self->{FORMATED_NO};
}
return $self->{FORMATED_NO};
}

####################################################
########## clear_accounts ########################
####################################################
sub clear_accounts
{
my $self = shift;

my ( $userlogged, $the_choice, $accountno ) = @_;

my $dbh = $self->sql_dbh($userlogged);

###### Uncomment for debugging
###### print "user logged is $userlogged<br>";
###### print "The choice is $the_choice<br>";
###### print "Account number is $accountno<br>";

if ( $the_choice eq "SELECTED" )
{
$thesearch="UPDATE smorders SET cleared = NULL WHERE clientno ILIKE $accountno";
}
else
{
$thesearch="UPDATE smorders SET cleared = NULL";
}

my $sth = $self->sql_exec($thesearch);

if ( $the_choice eq "SELECTED" )
{
$thesearch = "SELECT sale_accountno, sale_total from sales WHERE sale_accountno ILIKE $accountno order by sale_accountno, saleno";
}
else
{
$thesearch = "SELECT sale_accountno, sale_total from sales order by sale_accountno, saleno";
}

$sth = $self->sql_exec("$thesearch");

my $first_loop = 't';

my $hold_accountno = "";

my $total_account = 0;

my $check_account = 0;

my $is_cleared = "";

$query_empty = "true";
$array_ref = $sth->fetchall_arrayref();
foreach $row (@$array_ref)
{
$query_empty = "fales";
@clear_array = @$row;

if ( $first_loop eq 't' )
{
$hold_accountno = $clear_array[0];
###### print "First Account is $hold_accountno<br>"; ## Uncomment for debugging
$first_loop = 'f';
}

if ( $hold_accountno eq $clear_array[0])
{
$total_account += $clear_array[1];

}
###### Uncomment for debugging
###### print "Account $clear_array[0] is $clear_array[1]<br>"; ####
###### $is_cleared = $clear_array[2];
###### print "is cleared is $is_cleared<br>"; ####

if ( $hold_accountno ne $clear_array[0] )
{
###### Uncomment for debugging
###### $total_account = sprintf("%.2f",$total_account);
###### print "Total for Account $hold_accountno is $total_account<br>"; ####

if ( $total_account == 0 )
{
###### Uncomment for debugging
###### print "Here we are account cleared<br>"; ####
###### print "Cleared is $is_cleared<br>"; ####
$thesearch="UPDATE smorders SET cleared = '1' WHERE clientno = $hold_accountno";
$sth = $self->sql_exec($thesearch);
}
else
{
###### Uncomment for debugging
###### print "Here we are account not cleared<br>"; ####
###### print "Cleared is $is_cleared<br>"; ####
$thesearch="UPDATE smorders SET cleared = '0' WHERE clientno = $hold_accountno";
$sth = $self->sql_exec($thesearch);
}

if ( $clear_array[0] )
{
$hold_accountno = $clear_array[0];
$total_account = $clear_array[1];
###### Uncomment for debugging
###### print "Account $clear_array[0] is $clear_array[1]<br>"; ####
}
}
}

if ( $query_empty eq "true" )
{
$the_error = " No transactions found for account $accountno";
$self->error_form($the_error);
}
else
{
if ( $total_account == 0 )
{
###### Uncomment for debugging
###### print "Here we are account cleared<br>"; ####
###### print "Cleared is $is_cleared<br>"; ####
$thesearch="UPDATE smorders SET cleared = '1' WHERE clientno = $hold_accountno";
$sth = $self->sql_exec($thesearch);
}
else
{
###### Uncomment for debugging
###### print "Here we are account not cleared<br>"; ####
###### print "Cleared is $is_cleared<br>"; ####

$thesearch="UPDATE smorders SET cleared = '0' WHERE clientno = $hold_accountno";
$sth = $self->sql_exec($thesearch);

}
}
}

###################################################
########## clear_invoice ########################
###################################################
### Remember Depreciated and never called. Working with
### cursors in postgresql is slow and propreitary.
### Also, working with cursors requires DBD Pgpp.
### However, save for possible future use.

sub clear_invoice
{

my $self = shift;

my ($userlogged) = @_;

my $dbh = $self->sql_dbh($userlogged);

my $sth = $self->sql_exec("BEGIN");

$sth = $self->sql_exec( " DECLARE clear_cursor CURSOR FOR SELECT sale_invoiceno, sale_total from sales order by sale_invoiceno, saleno " );

$sth = $self->sql_exec( " fetch forward next in clear_cursor " );

@clear_array = $sth->fetchrow();

###### print "Invoice is $clear_array[0] and amount is $clear_array[1]<br>"; uncomment for debugging

my $hold_invoiceno=0;
my $keep_going = 1;

OUTER: while ( $keep_going )
{

###### print "<br>Invoice $hold_invoiceno total is $invoice_total<br><br>"; uncomment for debugging

if ( $invoice_total == 0 )
{
$thesearch="UPDATE sales SET sale_cleared = '1' WHERE sale_invoiceno = $hold_invoiceno";
$sth = $self->sql_exec( " $thesearch " );

}
else
{

$thesearch="UPDATE sales SET sale_cleared = '0' WHERE sale_invoiceno = $hold_invoiceno";
$sth = $self->sql_exec( " $thesearch " );
}
$invoice_total = 0;

$hold_invoiceno = $clear_array[0];
$key_invoice = $clear_array[0];

INNER: while ( $key_invoice )
{

$invoice_total += $clear_array[1];

$invoice_total = sprintf ("%.2f" , $invoice_total);

$sth = $self->sql_exec( " fetch forward next in clear_cursor " );

@clear_array = $sth->fetchrow();

###### print "Invoice $clear_array[0] is $clear_array[1]<br>";

next OUTER unless $hold_invoiceno eq $clear_array[0];
}
$keep_going=$clear_array[0];
}

$sth = $self->sql_exec("COMMIT" );

$sth = $self->sql_exec("CLOSE clear_cursor");

if(defined($dbh) )
{
$dbh->disconnect();
}

return;
}

#########################################################
################# get_type ############################
#########################################################
sub get_type
{
print "<option VALUE='IV'>IV &nbsp;&nbsp;Invoice</option>";
print "<option VALUE='PY'>PY &nbsp;&nbsp;Payment</option>";
print "<option VALUE='RD'>RD &nbsp;&nbsp;Discount</option>";
print "<option VALUE='CC'>CC &nbsp;&nbsp;Credit Card Fee</option>";
print "<option VALUE='IN'>IN &nbsp;&nbsp;Interest</option>";
print "<option VALUE='SH'>SH &nbsp;&nbsp;Shipping</option>";
print "<option VALUE='TX'>TX &nbsp;&nbsp;Internet Tax</option>";
print "<option VALUE='BD'>BD &nbsp;&nbsp;Bad Debt</option>";
print "<option VALUE='DM'>DM &nbsp;&nbsp;Debit Memo</option>";
print "<option VALUE='CM'>CM &nbsp;&nbsp;Credit Memo</option>";
}

###################################################
################### get_state ###################
###################################################
sub get_state
{
print "<option VALUE='NA'>Outside US</option>";
print "<option VALUE='AL'>Alabama</option>";
print "<option VALUE='AK'>Alaska</option>";
print "<option VALUE='AZ'>Arizona</option>";
print "<option VALUE='AR'>Arkansas</option>";
print "<option VALUE='CA'>California</option>";
print "<option VALUE='CO'>Colorado</option>";
print "<option VALUE='CT'>Connecticut</option>";
print "<option VALUE='DE'>Delaware</option>";
print "<option VALUE='DC'>District of Columbia</option>";

print "<option VALUE='FL'>Florida</option>";
print "<option VALUE='GA'>Georgia</option>";
print "<option VALUE='GU'>Buam</option>";
print "<option VALUE='HI'>Hawaii</option>";
print "<option VALUE='ID'>Idaho</option>";
print "<option VALUE='IL'>Illinois</option>";
print "<option VALUE='IN'>Indiana</option>";
print "<option VALUE='IA'>Iowa</option>";
print "<option VALUE='KS'>Kansas</option>";
print "<option VALUE='KY'>Kentucky</option>";

print "<option VALUE='LA'>Louisiana</option>";
print "<option VALUE='ME'>Maine</option>";
print "<option VALUE='MD'>Maryland</option>";
print "<option VALUE='MA'>Massachusetts</option>";
print "<option VALUE='MI'>Michigan</option>";
print "<option VALUE='MN'>Minnesota</option>";
print "<option VALUE='MS'>Mississippi</option>";
print "<option VALUE='MO'>Missouri</option>";
print "<option VALUE='MT'>Montana</option>";
print "<option VALUE='NE'>Nebraska</option>";

print "<option VALUE='NV'>Nevada</option>";
print "<option VALUE='NH'>New Hampshire</option>";
print "<option VALUE='NJ'>New Jersey</option>";
print "<option VALUE='NM'>New Mexico</option>";
print "<option VALUE='NY'>New York</option>";
print "<option VALUE='NC'>North Carolina</option>";
print "<option VALUE='ND'>North Dakota</option>";
print "<option VALUE='OH'>Ohio</option>";
print "<option VALUE='OK'>Oklahoma</option>";
print "<option VALUE='OR'>Oregon</option>";

print "<option VALUE='PA'>Pennsylvania</option>";
print "<option VALUE='PR'>Puerto Rico</option>";
print "<option VALUE='RI'>Rhode Island</option>";
print "<option VALUE='SC'>South Carolina</option>";
print "<option VALUE='SD'>South Dakota</option>";
print "<option VALUE='TN'>Tennessee</option>";
print "<option VALUE='TX'>Texas</option>";
print "<option VALUE='UT'>Utah</option>";
print "<option VALUE='VT'>Vermont</option>";
print "<option VALUE='VA'>Virgin Islands</option>";

print "<option VALUE='VI'>Virginia</option>";
print "<option VALUE='WA'>Washington</option>";
print "<option VALUE='WV'>West Virginia</option>";
print "<option VALUE='WI'>Wisconsin</option>";
print "<option VALUE='WY'>Wyoming</option>";

print "<option VALUE='AA'>Armed Forces America</option>";
print "<option VALUE='AE'>Overseas Europe (AE)</option>";
print "<option VALUE='AP'>Overseas Pacific (AP)</option>";
print "<option VALUE='54'>ALBERTA</option>";
print "<option VALUE='55'>BRITISH COLUMBIA</option>";
print "<option VALUE='56'>MANITOBA</option>";
print "<option VALUE='57'>NEW BRUNSWICK</option>";
print "<option VALUE='58'>NEWFOUNDLAND</option>";
print "<option VALUE='59'>NOVA SCOTIA</option>";
print "<option VALUE='60'>NORTHWEST TERRITORY</option>";

print "<option VALUE='61'>ONTARIO</option>";
print "<option VALUE='62'>PRINCE EDWARD ISLAND</option>";
print "<option VALUE='63'>QUEBEC</option>";
print "<option VALUE='64'>SASKATCHEWAN</option>";
print "<option VALUE='65'>YUKON TERRITORY</option>";

print "</select><FONT FACE='Arial,Helvetica,Swiss' COLOR='#000000' SIZE='-1'></td>";
print "</tr>";

}

####################################################
################## get_country ####################
####################################################
sub get_country
{

print "here we are";

print "<option VALUE='United States'>United States</option>";
print "<option VALUE='Antiqua'>Antigua</option>";
print "<option VALUE='Argentina'>Argentina</option>";
print "<option VALUE='Armenia'>Armenia</option>";
print "<option VALUE='Australia'>Australia</option>";
print "<option VALUE='Austria'>Austria</option>";
print "<option VALUE='Bahamas'>Bahamas</option>";
print "<option VALUE='Bahrain'>Bahrain</option>";
print "<option VALUE='Barbados'>Barbados</option>";
print "<option VALUE='Belgium'>Belgium</option>";
print "<option VALUE='Bermuda'>Bermuda</option>";

print "<option VALUE='Bolivia'>Bolivia</option>";
print "<option VALUE='Bosnia'>Bosnia</option>";
print "<option VALUE='Brazil'>Brazil</option>";
print "<option VALUE='Brunel'>Brunei</option>";
print "<option VALUE='Bulgaria'>Bulgaria</option>";
print "<option VALUE='CNMI'>CNMI</option>";
print "<option VALUE='Cameroon'>Cameroon</option>";
print "<option VALUE='Canada'>Canada</option>";
print "<option VALUE='Cape Verde'>Cape Verde</option>";
print "<option VALUE='Cayman Islands'>Cayman Islands</option>";

print "<option VALUE='Chile'>Chile</option>";
print "<option VALUE='China'>China</option>";
print "<option VALUE='Colombia'>Colombia</option>";
print "<option VALUE='Costa Rica'>Costa Rica</option>";
print "<option VALUE='Croatia'>Croatia</option>";
print "<option VALUE='Cyprus'>Cyprus</option>";
print "<option VALUE='Czech Republic'>Czech Republic</option>";
print "<option VALUE='Denmark'>Denmark</option>";
print "<option VALUE='Dominican Rep.'>Dominican Rep.</option>";
print "<option VALUE='Ecuador'>Ecuador</option>";
print "<option VALUE='Egypt'>Egypt</option>";

print "<option VALUE='El Salvador'>El Salvador</option>";
print "<option VALUE='Estonia'>Estonia</option>";
print "<option VALUE='Ethiopia'>Ethiopia</option>";
print "<option VALUE='Finland'>Finland</option>";
print "<option VALUE='France'>France</option>";
print "<option VALUE='Georgia'>Georgia</option>";
print "<option VALUE='Germany'>Germany</option>";
print "<option VALUE='Ghana'>Ghana</option>";
print "<option VALUE='Greece'>Greece</option>";
print "<option VALUE='Grenada'>Grenada</option>";
print "<option VALUE='Guatemala'>Guatemala</option>";

print "<option VALUE='Guernsey'>Guernsey</option>";
print "<option VALUE='Honduras'>Honduras</option>";
print "<option VALUE='Hong Kong'>Hong Kong</option>";
print "<option VALUE='Hungary'>Hungary</option>";
print "<option VALUE='Iceland'>Iceland</option>";
print "<option VALUE='India'>India</option>";
print "<option VALUE='Indonesia'>Indonesia</option>";
print "<option VALUE='Ireland'>Ireland</option>";
print "<option VALUE='Isle of Man'>Isle of Man</option>";
print "<option VALUE='Israel'>Israel</option>";

print "<option VALUE='Italy'>Italy</option>";
print "<option VALUE='Jamaica'>Jamaica</option>";
print "<option VALUE='Japan'>Japan</option>";
print "<option VALUE='Jordan'>Jordan</option>";
print "<option VALUE='Kenya'>Kenya</option>";
print "<option VALUE='Korea'>Korea</option>";
print "<option VALUE='Kuwait'>Kuwait</option>";
print "<option VALUE='Latvia'>Latvia</option>";
print "<option VALUE='Lebanon'>Lebanon</option>";
print "<option VALUE='Lithuania'>Lithuania</option>";

print "<option VALUE='Luxembourg'>Luxembourg</option>";
print "<option VALUE='Macau'>Macau</option>";
print "<option VALUE='Macedonia'>Macedonia</option>";
print "<option VALUE='Malaysia'>Malaysia</option>";
print "<option VALUE='Maldives'>Maldives</option>";
print "<option VALUE='Malta'>Malta</option>";
print "<option VALUE='Marshall Islands'>Marshall Islands</option>";
print "<option VALUE='Mauritania'>Mauritania</option>";
print "<option VALUE='Mauritius'>Mauritius</option>";
print "<option VALUE='Mexico'>Mexico</option>";

print "<option VALUE='Nepal'>Nepal</option>";
print "<option VALUE='Netherlands'>Netherlands</option>";
print "<option VALUE='Netherlands Antilles'>Netherlands Antilles</option>";
print "<option VALUE='New Zealand'>New Zealand</option>";
print "<option VALUE='Nicaragua'>Nicaragua</option>";
print "<option VALUE='Nigeria'>Nigeria</option>";
print "<option VALUE='Norway'>Norway</option>";
print "<option VALUE='Oman'>Oman</option>";
print "<option VALUE='Pakistan'>Pakistan</option>";
print "<option VALUE='Panama'>Panama</option>";
print "<option VALUE='Paraguay'>Paraguay</option>";

print "<option VALUE='Peru'>Peru</option>";
print "<option VALUE='Philippines'>Philippines</option>";
print "<option VALUE='Poland'>Poland</option>";
print "<option VALUE='Portugal'>Portugal</option>";
print "<option VALUE='Puerto Rico'>Puerto Rico</option>";
print "<option VALUE='Qatar'>Qatar</option>";
print "<option VALUE='Romania'>Romania</option>";
print "<option VALUE='Lebanon'>Lebanon</option>";
print "<option VALUE='Russia'>Russia</option>";
print "<option VALUE='Saudi Arabia'>Saudi Arabia</option>";
print "<option VALUE='Singapore'>Singapore</option>";

print "<option VALUE='Slovakia'>Slovakia</option>";
print "<option VALUE='Slovenia'>Slovenia</option>";
print "<option VALUE='South Africa'>South Africa</option>";
print "<option VALUE='Spain'>Spain</option>";
print "<option VALUE='Sri Banka'>Sri Lanka</option>";
print "<option VALUE='Sweden'>Sweden</option>";
print "<option VALUE='Switzerland'>Switzerland</option>";
print "<option VALUE='Taiwan'>Taiwan</option>";
print "<option VALUE='Thailand'>Thailand</option>";
print "<option VALUE='Trinidad'>Trinidad</option>";
print "<option VALUE='Turkey'>Turkey</option>";

print "<option VALUE='Uganda'>Uganda</option>";
print "<option VALUE='Ukraine'>Ukraine</option>";
print "<option VALUE='United Arab Em.'>United Arab Em.</option>";
print "<option VALUE='United Kingdom'>United Kingdom</option>";
print "<option VALUE='Uruguay'>Uruguay</option>";
print "<option VALUE='Venezuela'>Venezuela</option>";
print "<option VALUE='Vietnam'>Vietnam</option>";
print "<option VALUE='Yugoslavia'>Yugoslavia</option>";
print "<option VALUE='Zambia'>Zambia</option>";

}

####################################################
################# number_format ##################
####################################################
sub number_format
{
my $self = shift;

my ($the_number) = @_;

$the_number = sprintf ("%.2f" , $the_number);
$the_number = reverse $the_number;
$the_number =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
$the_number = scalar reverse $the_number;
print "\$$the_number";
return;
}

####################################################
################# rptnumber_format ###############
####################################################
sub rptnumber_format
{
my $self = shift;

my ($the_number) = @_;

$the_number = sprintf ("%.2f" , $the_number);
$the_number = reverse $the_number;
$the_number =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
$the_number = scalar reverse $the_number;
$the_number = "\$" . $the_number;
return $the_number;
}

###################################################
######## credit_cards_accepted ##################
###################################################
sub credit_cards_accepted
{
my $self = shift;

my ( $the_cardtype, $callprg ) = @_;

print "<TR>";

if ( $callprg eq "kart_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'>Payment Method</TD>";
}
elsif ( $callprg eq "kart_check_out.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}
elsif ( $callprg eq "kart_ship_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}
elsif ( $callprg eq "kart_sales_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}

print "<TD>";
if ( $self->{ACCEPT_VISA} eq "yes" )
{
if ( $the_cardtype eq 'visa' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='visa' CHECKED>Visa&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='visa'>Visa&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_MASTERCARD} eq "yes" )
{
if ( $the_cardtype eq 'mastercard' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='mastercard' CHECKED>Mastercard&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='mastercard'>Mastercard&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_AMEX} eq "yes" )
{
if ( $the_cardtype eq 'amex' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='amex' CHECKED>Amex&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='amex'>Amex&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_DISCOVER} eq "yes" )
{
if ( $the_cardtype eq 'novus' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='novus' CHECKED>Discover";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='novus'>Discover";
}
}

if ( $self->{ACCEPT_CHECK} eq "yes" )
{
if ( $the_cardtype eq 'check' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='check' CHECKED>Check";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='check'>Check";
}
}

print "</TD>";
print "</TR>";
}

###################################################
######## add_credit_cards_accepted ##############
###################################################
sub add_credit_cards_accepted
{
my $self = shift;

my ( $callprg ) = @_;

print "<TR>";

if ( $callprg eq "kart_ship_main.pl" )
{
print "<TD align='right'><font face='Arial size='2'><b>Payment Method<b></TD>";
}

if ( $callprg eq "kart_main.pl" )
{
print "<TD align='right'><font face='Arial size='2'>Payment Method</TD>";
}

print "<TD>";
if ( $self->{ACCEPT_VISA} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='visa'>Visa&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_MASTERCARD} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='mastercard'>Mastercard&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_AMEX} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='amex'>Amex&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_DISCOVER} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='novus'>Discover&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_CHECK} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='check'>Check&nbsp;&nbsp;";
}

print "</TD>";

print "</TR>"
}

1;

#################################################
#################################################
#################################################
=head1 NAME

Smglobal - class to implement Software - Master (TM)
Shopping Kart Application. It inherrits all
methods and properties of the following classes:

Sm_session.pm - implements session cookies to maintain session ID
Sm_css.pm - implements cascading style sheets for html prasing
Sm_error_hand.pm - implements error messages and checking
Sm_reports.pm - implements emailing of reports, invoices, etc.

=head1 SYNOPSIS

#----------------------------------
Here is how to create a reference to the Smglobal class:
#-----------------------------------

use Smglobal;
$oMy = Smglobal->new();

#-----------------------------------
Now $oMy can be used to access methods in Smglobal.pm.
In the below example the 123456.78 is passed to the
rptnumber_format method. The rptnumber_format method
formats the number and returns $123,456.78 to $return_number
#-------------------------------------

$return_number = $oMy->rptnumber_format("123456.78")
print $return_number
$123,456.78

#--------------------------------------
Also, $oMy can be used to grab a global variable. For example,
if $self->{CONFIRM_DELETES} above is set to "yes", this can be
accessed from any perl script like:
#--------------------------------------

$confirm_del = $oMy->{CONFRIM_DELETES};
print $confirm_del;
yes

=head1 DESCRIPTION

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

Regards,

LelandJ


Leland F. Jackson, CPA
Software - Master (TM)

http://www.smvfp.com

Nothing Runs Like the Fox

 

[Leland123]

Hi,

Oops, the script was truncated. Here is the rest of the class. Also the link above to the demo shopping cart should be:

http://www.smvfp.com/cgi-bin/demo/kart_index.pl

#-------------------------------------------------

print "<option VALUE='Kenya'>Kenya</option>";
print "<option VALUE='Korea'>Korea</option>";
print "<option VALUE='Kuwait'>Kuwait</option>";
print "<option VALUE='Latvia'>Latvia</option>";
print "<option VALUE='Lebanon'>Lebanon</option>";
print "<option VALUE='Lithuania'>Lithuania</option>";

print "<option VALUE='Luxembourg'>Luxembourg</option>";
print "<option VALUE='Macau'>Macau</option>";
print "<option VALUE='Macedonia'>Macedonia</option>";
print "<option VALUE='Malaysia'>Malaysia</option>";
print "<option VALUE='Maldives'>Maldives</option>";
print "<option VALUE='Malta'>Malta</option>";
print "<option VALUE='Marshall Islands'>Marshall Islands</option>";
print "<option VALUE='Mauritania'>Mauritania</option>";
print "<option VALUE='Mauritius'>Mauritius</option>";
print "<option VALUE='Mexico'>Mexico</option>";

print "<option VALUE='Nepal'>Nepal</option>";
print "<option VALUE='Netherlands'>Netherlands</option>";
print "<option VALUE='Netherlands Antilles'>Netherlands Antilles</option>";
print "<option VALUE='New Zealand'>New Zealand</option>";
print "<option VALUE='Nicaragua'>Nicaragua</option>";
print "<option VALUE='Nigeria'>Nigeria</option>";
print "<option VALUE='Norway'>Norway</option>";
print "<option VALUE='Oman'>Oman</option>";
print "<option VALUE='Pakistan'>Pakistan</option>";
print "<option VALUE='Panama'>Panama</option>";
print "<option VALUE='Paraguay'>Paraguay</option>";

print "<option VALUE='Peru'>Peru</option>";
print "<option VALUE='Philippines'>Philippines</option>";
print "<option VALUE='Poland'>Poland</option>";
print "<option VALUE='Portugal'>Portugal</option>";
print "<option VALUE='Puerto Rico'>Puerto Rico</option>";
print "<option VALUE='Qatar'>Qatar</option>";
print "<option VALUE='Romania'>Romania</option>";
print "<option VALUE='Lebanon'>Lebanon</option>";
print "<option VALUE='Russia'>Russia</option>";
print "<option VALUE='Saudi Arabia'>Saudi Arabia</option>";
print "<option VALUE='Singapore'>Singapore</option>";

print "<option VALUE='Slovakia'>Slovakia</option>";
print "<option VALUE='Slovenia'>Slovenia</option>";
print "<option VALUE='South Africa'>South Africa</option>";
print "<option VALUE='Spain'>Spain</option>";
print "<option VALUE='Sri Banka'>Sri Lanka</option>";
print "<option VALUE='Sweden'>Sweden</option>";
print "<option VALUE='Switzerland'>Switzerland</option>";
print "<option VALUE='Taiwan'>Taiwan</option>";
print "<option VALUE='Thailand'>Thailand</option>";
print "<option VALUE='Trinidad'>Trinidad</option>";
print "<option VALUE='Turkey'>Turkey</option>";

print "<option VALUE='Uganda'>Uganda</option>";
print "<option VALUE='Ukraine'>Ukraine</option>";
print "<option VALUE='United Arab Em.'>United Arab Em.</option>";
print "<option VALUE='United Kingdom'>United Kingdom</option>";
print "<option VALUE='Uruguay'>Uruguay</option>";
print "<option VALUE='Venezuela'>Venezuela</option>";
print "<option VALUE='Vietnam'>Vietnam</option>";
print "<option VALUE='Yugoslavia'>Yugoslavia</option>";
print "<option VALUE='Zambia'>Zambia</option>";

}

####################################################
################# number_format ##################
####################################################
sub number_format
{
my $self = shift;

my ($the_number) = @_;

$the_number = sprintf ("%.2f" , $the_number);
$the_number = reverse $the_number;
$the_number =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
$the_number = scalar reverse $the_number;
print "\$$the_number";
return;
}

####################################################
################# rptnumber_format ###############
####################################################
sub rptnumber_format
{
my $self = shift;

my ($the_number) = @_;

$the_number = sprintf ("%.2f" , $the_number);
$the_number = reverse $the_number;
$the_number =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
$the_number = scalar reverse $the_number;
$the_number = "\$" . $the_number;
return $the_number;
}

###################################################
######## credit_cards_accepted ##################
###################################################
sub credit_cards_accepted
{
my $self = shift;

my ( $the_cardtype, $callprg ) = @_;

print "<TR>";

if ( $callprg eq "kart_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'>Payment Method</TD>";
}
elsif ( $callprg eq "kart_check_out.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}
elsif ( $callprg eq "kart_ship_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}
elsif ( $callprg eq "kart_sales_main.pl" )
{
print "<TD align='right'><font face='Arial' size='2'><b>Payment Method</b></TD>";
}

print "<TD>";
if ( $self->{ACCEPT_VISA} eq "yes" )
{
if ( $the_cardtype eq 'visa' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='visa' CHECKED>Visa&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='visa'>Visa&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_MASTERCARD} eq "yes" )
{
if ( $the_cardtype eq 'mastercard' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='mastercard' CHECKED>Mastercard&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='mastercard'>Mastercard&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_AMEX} eq "yes" )
{
if ( $the_cardtype eq 'amex' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='amex' CHECKED>Amex&nbsp;&nbsp;";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='amex'>Amex&nbsp;&nbsp;";
}
}

if ( $self->{ACCEPT_DISCOVER} eq "yes" )
{
if ( $the_cardtype eq 'novus' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='novus' CHECKED>Discover";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='novus'>Discover";
}
}

if ( $self->{ACCEPT_CHECK} eq "yes" )
{
if ( $the_cardtype eq 'check' )
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='check' CHECKED>Check";
}
else
{
print "<INPUT TYPE=RADIO NAME='edit_cardtype' VALUE='check'>Check";
}
}

print "</TD>";
print "</TR>";
}

###################################################
######## add_credit_cards_accepted ##############
###################################################
sub add_credit_cards_accepted
{
my $self = shift;

my ( $callprg ) = @_;

print "<TR>";

if ( $callprg eq "kart_ship_main.pl" )
{
print "<TD align='right'><font face='Arial size='2'><b>Payment Method<b></TD>";
}

if ( $callprg eq "kart_main.pl" )
{
print "<TD align='right'><font face='Arial size='2'>Payment Method</TD>";
}

print "<TD>";
if ( $self->{ACCEPT_VISA} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='visa'>Visa&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_MASTERCARD} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='mastercard'>Mastercard&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_AMEX} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='amex'>Amex&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_DISCOVER} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='novus'>Discover&nbsp;&nbsp;";
}

if ( $self->{ACCEPT_CHECK} eq "yes" )
{
print "<INPUT TYPE=RADIO NAME='add_cardtype' VALUE='check'>Check&nbsp;&nbsp;";
}

print "</TD>";

print "</TR>"
}

1;

#################################################
#################################################
#################################################
=head1 NAME

Smglobal - class to implement Software - Master (TM)
Shopping Kart Application. It inherrits all
methods and properties of the following classes:

Sm_session.pm - implements session cookies to maintain session ID
Sm_css.pm - implements cascading style sheets for html prasing
Sm_error_hand.pm - implements error messages and checking
Sm_reports.pm - implements emailing of reports, invoices, etc.

=head1 SYNOPSIS

#----------------------------------
Here is how to create a reference to the Smglobal class:
#-----------------------------------

use Smglobal;
$oMy = Smglobal->new();

#-----------------------------------
Now $oMy can be used to access methods in Smglobal.pm.
In the below example the 123456.78 is passed to the
rptnumber_format method. The rptnumber_format method
formats the number and returns $123,456.78 to $return_number
#-------------------------------------

$return_number = $oMy->rptnumber_format("123456.78")
print $return_number
$123,456.78

#--------------------------------------
Also, $oMy can be used to grab a global variable. For example,
if $self->{CONFIRM_DELETES} above is set to "yes", this can be
accessed from any perl script like:
#--------------------------------------

$confirm_del = $oMy->{CONFRIM_DELETES};
print $confirm_del;
yes

=head1 DESCRIPTION

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

Regards,

LelandJ


Leland F. Jackson, CPA
Software - Master (TM)

http://www.smvfp.com

Nothing Runs Like the Fox