Solved

Perl and HTML::Template - variable not passing

Posted on 2007-04-09
5
241 Views
Last Modified: 2010-04-06
I cannot seem to get a variable to pass in perl / HTML::Template
The code in the template is fine - for instance if I use  an existing variable and it is true, what i want to show in my TMPL_IF NAME= displays properly. However I cannot seem to get it to pass a new variable.

The variable I want to create is the hash key for $output{tuxedo} and set it to true. I'm a PHPer so this is frustrating me. I can't find a reference to the hash outside of the perl package. Here is a code sample of Detail.pm - Many ####### WILL HELP SHOW WHERE I'M TRYIN TO ADD THE VARIABLE #######
The code is not complete and some things have been erased for security - although very little. There is the main program and the only sub that refers to the ouput hash. If you can figure this one out I will owe you forever, I'm losing my mind trying..................but I could just be an perl idiot and overlooking something.






package E::Details;

use Apache2::Const qw(:common);
use Apache2::Cookie ();
use strict;
use HTML::Template;
use HTML::Entities;
use DBI;
use E::DB;
use CGI;

sub new {
  my ( $class ) = @_;
  my ( $self ) = {};
  bless ($self, $class);
  $self->{'default'} = 'detail.tem';
  return $self;
}

sub handler {
  my $r    = shift;
  my $self = new E::Details;
  my $cgi  = new CGI;
  my $log  = $r->log();

  # copy values to object, just in case

  $self->{'r'}   = $r;
  $self->{'log'} = $log;
  $self->{'cgi'} = $cgi;

  # set path/location of template files

  my $docroot = $r->document_root();
  $self->{template}   = $docroot . '/templates/details.tmpl';

  #these locations are generally static

  $self->{'picdir'} = '/home/httpd';
  $self->{'picurl'} = 'http:/pix/';
  $self->{'thumburl'} = 'http:/bnail/';
  $self->{'agturl'} = '/a/';
  $self->{'limit'}  = 450;
  $self->{'x_limit'}  = 400;
  $self->{'ylimit'} = 500;
  $self->{'minimum_ratio'} = 0.9;

  # errors generate more info if debug mode = 1
  # they are stored in debug
 
  $self->{debugmode} = 0;
  $self->{debug} = '';
 
  # database connection stuff

  my $dbn  = new E::DB;
  my $conn = DBI->connect( $dbn->{dsn}, $dbn->{user}, $dbn->{pass} );

  unless ($conn) {
    $self->problem("Error: Couldn\'t connect to database.");
    return OK;
  }
  $self->{'db'} = $conn;     # copy db handle to the object

  # the propidx is extracted from the URI

  my $loc = $r->uri;
  my ( $dir, $propidx, $ext ) = ( $loc =~ /(\w+?)\/(-?\d+)(.*)$/i );

  unless ($propidx) {
    my ( $dir, $old_propidx, $ext ) = ( $loc =~ /(\w+?)\/(L\d+)(.*)$/i );
    $propidx = $self->get_propidx($old_propidx);
  }

  unless ($propidx) {
    $log->error( __PACKAGE__ . " -- propidx not found: $loc" );
    return NOT_FOUND;
  }

  if ($ext =~ /gif|jpe?g|png/i) {
    $log->error( __PACKAGE__ . " -- IMAGE WAS REQ\'D: $loc" );
    return NOT_FOUND;
  }

  $propidx = uc($propidx);
  $self->{'idx'} = $propidx;

  my $site = $r->get_server_name();
  if ($site =~ /e/i) {
    $self->{site} = 'e';
    $self->{etsite} = 'Y';
    $self->{'picurl'} = 'http://wwngpix/';
    $self->{'thumburl'} = 'http://wwwnail/';
  }

  my $home = $self->get_details($conn, $propidx);

  unless ($home) {
    $log->error( __PACKAGE__ . " -- property unmatched: $propidx " . $self->{debug} );
    return NOT_FOUND;
  }

  my %mainpage = $self->format_details($home, $propidx);
  $conn->disconnect;

  my $jar = Apache2::Cookie::Jar->new($r);
  my $c = $jar->cookies('referer');
  if ($c) {
    $mainpage{'referer'} = $c->value;
  }

 

  my $tem = HTML::Template->new(filename => $self->{'template'},
                                die_on_bad_params => 0);
  $tem->param(\%mainpage);
  my $doc = $tem->output;

  $r->content_type('text/html');
  $r->print( $doc );
  return OK;
}


#######################Here's the only reference to %output ###############################
## AND I WANT TO CREATE A VARIABLE NAMED $output{tuxedo} and set it true if a rule applies #####



sub format_details {
# prepare details for display on the page
  my ($self, $info, $idx) = @_;
  my %output;

  # copy direct transfer fields here
  # use the array to avoid clutter from other DB fields

  my @simple = qw(agent agent_url
    city descr dist email ext fence found
    address
    lot lp mapcord messph ofcidx offcity offname
    offstreet offzip pool proptype romance roof
    stories subdiv webarea offphone
    yrblt zip);

  foreach my $k (@simple) {
    $output{$k} = $info->{$k} || '';
  }

  my %rooms = (liv1 => 'living_1_desc',
               liv2 => 'living_2_desc',
               liv3 => 'living_3_desc',
               br1 => 'bedroom_1_desc',
               br2 => 'bedroom_2_desc',
                                     );

  foreach (keys %rooms) {
    if ($info->{$rooms{$_}}) {
      $output{$_} = $info->{$_}.' '.$info->{$rooms{$_}};
    } elsif ($info->{$_} !~ '0X0') {
      $output{$_} = $info->{$_};
    }
  }
  $output{'tuxedo'}='1';
  # Garage Description
  my $feat_gar = $self->getFeatures($info->{'feat_garage'}, 'feat_garage');
  if ($info->{'garage_spaces'} > 1) {
    $output{'gar'} = $info->{'garage_spaces'} . ' spaces' . ($feat_gar?", $feat_gar":"");
  } elsif ($info->{'garage_spaces'}) {
    $output{'gar'} = $info->{'garage_spaces'} . ' space' . ($feat_gar?", $feat_gar":"");
  } else {
    $output{'gar'} = $feat_gar;
  }

  # translate certain display_codes into English
  foreach my $field (qw(proptype)) {
    my $fieldtmp = $self->display_code(lc($info->{$field}));
    ($fieldtmp) and $output{$field} = $fieldtmp;
  }
 
  my @schools;
  for (1..4) {
    push @schools, {name => $info->{"school_$_"},
                    type => $self->school_code($info->{"school_type_$_"})}
         if ($info->{"school_$_"});
  }
  $output{schools} = \@schools;

  # copy overs with slight alterations
  $output{propidx} = $idx;
  $output{site} = $self->{site};
  $output{etsite} = $self->{etsite};

  $output{listprice} = '$' . $info->{listprice};
  $output{sqft} = $info->{sqft} . '* ' . $info->{sqftsrce};
  $output{mapcord} = $info->{map} . $info->{mapcord};

  # the state for everything is Texas... for now
  $output{state} = 'TX';
  $output{offstate} = 'TX';

  # mls number
  $output{mlsnum} = $info->{prcmlnum};

  $output{romance} = $info->{romance};
  foreach (1, 2, 3) {
    $output{romance} .= $info->{'romance'.$_} if ( $info->{'romance'.$_} ne "");
  }

  # Community Pool

  if ($info->{'feat_common'} =~ /03/ && $info->{'pool'} eq 'N') {
    $output{pool} = 'Community';
  }




 
 

 

  # HOA Dues
  my %hoa_bill = (
    A => 'Annual',
    M => 'Monthly',
    S => 'Semi-annual',
    O => 'Other',
    Q => 'Quarterly',
  );
  if ($info->{'hoa'} =~ /M|V/) {
    my $freq = $info->{'hoa'} eq 'M'?'Mandatory':'Voluntary';
    $output{'hoa'} = $info->{'hoa_dues'} .' '. $hoa_bill{$info->{'hoa_billing_frequency'}}
      ." ($freq)";
  }
   

 
  # BEGIN PHOTO HANDLING

  my %args;
  if ($info->{'source'} eq 'M' || $info->{mls_photos} eq 'Y') {
    $args{'M'} = $info->{prcmlnum};
  }
  if ($info->{'source'} eq 'E') {
    $args{'E'} = $idx;
    $args{'L'} = $info->{old_propidx};
  }
  my $pf = Ebby::PhotoFinder->new(%args);
  my @pics;

  my $limit = $self->{limit};
  $limit = $self->{mls_limit} if ( lc($info->{isebby}) eq "false");

  if ($pf->count() > 0) {
    $pf->set_max_width($limit);
    @pics = $pf->details();
  }    
 
  if (@pics) {  
    my $mainp = $pics[0];
    my ($picw, $pich) = ( $mainp->{width}, $mainp->{height} );
    $output{picture} = $mainp->{thumb}."?x=$mainp->{scaled_width};y=$mainp->{scaled_height}";
    $output{dimen} = sprintf( 'WIDTH=%d HEIGHT=%d',
                               $mainp->{scaled_width},
                               $mainp->{scaled_height} );
  }

  # detect if there is more than one picture

  if ($pf->count() > 1) {
    $output{morepictures} = 1;
  }

  # create list of pictures in directory

  my @gallery;
 
  foreach my $still (@pics) {
    my $shot = {};
    $shot->{photo} = $still->{id};
    ( $shot->{photowidth}, $shot->{photoheight} )
                 = ( $still->{width}, $still->{height} );
     
    if ( @gallery < 6 )
    {
      push @gallery, $shot;
    }
  }

  if (@pics > @gallery) {
    my $num = @pics - @gallery;
    for (1..$num) { push @gallery, {blah=>1}; }
    $output{gallerypage} = 1;
  }

  $output{gallery} = \@gallery;

  # END PHOTO HANDLING
  ##########################################################
  #############WHY DOES THIS BELOW NOT WORK, BUT IF I CAHNGE MY TEMPLATE TO
##### IF NAME="picture" IT WORKS FINE ##########################################
  $output{tuxedo} = 1;
  $output{pending} = ( $info->{'property_status'} =~ /P/ ) ? 1 : undef;

  $output{url_address} = $self->enc($info->{'address'});
  $output{url_city}    = $self->enc($output{city});

  my $tmp_idx = $idx;
  $tmp_idx =~ s/^L//i;
  $output{mqmap} = $tmp_idx unless ($info->{'web_map'} eq 'N');

  $output{hvac} = $self->getFeatures($info->{'feat_hvac'}, 'feat_hvac');
  $output{roof} = $self->getFeatures($info->{'feat_roof'}, 'feat_roof');
  $output{found} = $self->getFeatures($info->{'feat_foundation'}, 'feat_foundation');
  $output{fence} = $self->getFeatures($info->{'feat_fence'}, 'feat_fence');
  $output{ext} = $self->getFeatures($info->{'feat_construction'}, 'feat_construction');

 
  # feature list
  my @feat;
  push @feat, 'Ebby Select Home' if ($info->{ebbyselect} eq 'True');

  my @features = (
                  ['feat_exterior', 1, 'Balcony'],
                   ['feat_common', 14, 'Gated Community'],
                 ['feat_lot_desc', 12, 'Located next to Golf Course'],
                 ['feat_exterior', 13, 'Guest Quarters'],
                  ['feat_handicap', 0, 'Handicap Amenities'],
              ['feat_housing_type', 4, 'High Rise/Condominium'],
                 ['feat_lot_desc', 15, 'Lake Front Lot'],
                 ['feat_lot_desc', 14, 'Lake View'],
           ['feat_specialty_rooms', 3, 'Library/Study'],
              ['feat_house_style', 20, 'Loft'],
            ['feat_specialty_rooms', 5, 'Media Room'],
             ['feat_housing_type', 18, 'Mobile Home'],
              ['feat_housing_type', 3, 'Zero Lot Line']);

  foreach my $f (@features) {
    push @feat, $f->[2] if (
      ( ($f->[1] == 0) && ($info->{$f->[0]}) ) ||
      grep {$_ == $f->[1]} split('/', $info->{$f->[0]})
    );
  }
  if (@feat > 0) {
    $output{featurelist} = join(', ', @feat);
  }

  if ( lc($info->{iseb}) eq "true") {
    #  make the ebby agent/office info
    #
    #  template fields
    #  ofcidx, etsite, offname, offstreet, offcity, offstate,
    #  offzip, homeph, agent_url, agentname, messph, email,
    #  email

    my %office = $self->get_agent_info( $info->{pers_code} );

    $output{ebbyoffice} = 1;

    my @offinfo = qw(ofcidx offname offstreet offphone offcity
                     offstate offzip etsite);

    # copy values from %output for consistency of state, etsite
    foreach (@offinfo) { $office{$_} = $output{$_}; }
   
    foreach (qw(name homeph agentname messph email agtcode pgname)) {
      $output{$_} = $office{$_};
    }
 
    $output{agent_url} = $self->{agturl} . $office{pgname};

    my $tbuser = $info->{pers_code} || $info->{gtcode};
    # print STDERR "TBUSER: ", $tbuser, "\n";
    $output{talkbutton} = $self->talkbutton( $tbuser, $self->{'db'} );

    my $tour = E::VirtualTour->new( $self->{db}, $idx );

    if ( length($tour->url) > 0 ) {

       # button options may come back, but no one
       # is using them right now

       my %vbut = ( '0' => 'vtours',
                    '1' => 'addph',
                    '2' => 'addinf',
                    '3' => 'audio',
                    '4' => 'video' );

       my $vbutton = $vbut{'0'};
       my $vth = $tour->height;
       my $vtw = $tour->width;

       my $vlink = $tour->url;
       $vlink = 'http://'.$vlink unless ($vlink =~ /^http:\/\//);
       #$vlink = qq{javascript:Opener('} . $vlink
       #       . qq{','$vth','$vtw','no');};

       $output{vtour_link}   = $vlink;
       $output{vtour_button} = $vbutton;
       $output{vtour_height} = $tour->height;
       $output{vtour_width}  = $tour->width;
    }

    my $fplan = Ebby::FloorPlan->new( $self->{db}, $idx );

    if ( length($fplan->url) > 0 ) {

        my $fplink = $fplan->url;
        my $fpht   = $fplan->height;
        my $fpwd   = $fplan->width;
   
        $fplink = 'http://'.$fplink unless ($fplink =~ /^http:\/\//);
        #$fplink = qq{javascript:Opener('} . $fplink
        #        . qq{','$fpht','$fpwd','yes');};

        $output{floorplan_link}   = $fplink;
        $output{floorplan_height} = $fpht;
        $output{floorplan_width}  = $fpwd;
    }

 
    if ( lc($info->{showoh}) eq 'yes' ) {
      my $ohtext = qq#<B>Open House on # . $info->{openday} . ' ';
      $ohtext .= $info->{openmon} . ' ' . $info->{opendayofm};
      $ohtext .= ' at ' . $info->{opentime} if ($info->{opentime} ne "");
      $ohtext .= qq#</B>#;
      $output{openhouse} = $ohtext;
    }
 
    if ( $info->{homeshow} ) {
      $output{homeshow_link} = '/cgi-bin/homeshow_video.cgi?ref=' .
                                $info->{prcmlnum};
    }

 

    # 800 number message setting
    my $number_msg = $self->get_800_number();
    $output{'800number'} = ($number_msg) ? $number_msg : undef;

    $output{'appointment_formID'} = 1046;
    $output{'moreinfo_formID'} = 1047;
  }

  # weekday setting
  my $dow = (localtime(time))[6];
  $output{weekday} = 1 if ($dow != 0 and $dow != 6);

  return %output;
}




0
Comment
Question by:chuckbeats
  • 3
  • 2
5 Comments
 
LVL 84

Expert Comment

by:ozo
ID: 18880777
Can you show how to get the incorrect output from that program, and indiicate the output that it should have?
0
 

Author Comment

by:chuckbeats
ID: 18881901
its an apache handler - returned from a detailed property listing on ebby dot com
0
 

Author Comment

by:chuckbeats
ID: 18881973
more importantly, in perl -

using strict - the my %ouput is;   - inititates a hash

should the syntax $output{tuxedo} = 1;  create a new hash key tuxedo with a value of 1 or true for HTML::Template purposes
0
 
LVL 84

Accepted Solution

by:
ozo earned 500 total points
ID: 18883931
the syntax $output{tuxedo} = 1;  creates a new hash key tuxedo with a value of 1
0
 

Author Comment

by:chuckbeats
ID: 18887048
Thanks for the help ozo - i think i owed you points from before. We have two instances of apache running - 1 with mod perl, one without, i was reloading the main instance without mod perl - so the changes I was making to my Apache Handler were not taking effect - somedays i just love computers
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
graphic software 6 91
I starting with php 12 136
pdf file 7 91
PHP Curl to output a url 7 46
Using Quotation Marks in PHP This question (http://www.experts-exchange.com/Web_Development/Web_Languages-Standards/PHP/Q_28217211.html) seems to come up a lot for developers who are new to PHP.  And it got me thinking, "How can we explain the rule…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
The purpose of this video is to demonstrate how to set up the permalinks on a WordPress Website. This will be demonstrated using a Windows 8 PC. Go to your WordPress login page. This will look like the following: mywebsite.com/wp-login.php : Go t…
Learn how to set-up PayPal payment integration in your Wufoo form. Allow your users to remit payment through PayPal upon completion of your online form. This is helpful for collecting membership payments, customer payments, donations, and more.

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question