Solved

Perl and HTML::Template - variable not passing

Posted on 2007-04-09
5
230 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

New Relic: Our company recently started researching several products to figure out what were the best ways for us to increase our web page speed and to quickly identify performance problems that we may be having. One of the products we evaluated wa…
If I have to fix slow responding website my first thoughts are server side optimizations: the database may not be optimized or caching is not enabled, or things like that. We often overlook another major part of our web application: the client. We o…
The purpose of this video is to demonstrate how to exclude a particular blog category from the main blog page. This is can be used when a category already has its own tab, or you simply want certain types of posts not to show up on the main blog. …
The purpose of this video is to demonstrate how to set up an RSS Feed on a WordPress Website. This will be demonstrated using a Windows 8 PC. Feedburner will be used for this demonstration. Go to your WordPress login page. This will look like the…

910 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now