#!/usr/bin/perl use strict; use lib qw(/var/www/sites/ubuyne/cgi-perl/modules/); use PW2_Functions; # Various functions use PW2_PrintBits; # Various Print functions, and HTML bits use PW2_CataBlogs; &process_blog_request; exit; # -------------------------------------------------------------------------------------------------------------------------- sub process_blog_request { undef my %FORM; &process_form_any2(\%FORM); my $catkey =$FORM{'cb'}; # The catalogue (ie. the storekey) my $blogid =$FORM{'b'}; # The blog ID my $page =$FORM{'p'}; # The page number to display my $ymdate =$FORM{'ym'}; # Year and Month (eg. 200610). Used when displaying blogs for certain year & month &numbers_only(\$blogid); &numbers_only(\$page); &numbers_only(\$ymdate); undef my $catlist; &fetch_catlist(\$catlist); my $domain =$ENV{'HTTP_HOST'}; my $content_ref=''; my $title=''; my $metadesc =''; my $metakeyw =''; my $og_title=''; my $og_desc=''; my $og_url=''; my $og_img=''; if ($blogid gt'') { &generate_this_blog(\$content_ref,\$title,\$blogid,\$catkey,\$metadesc,\$metakeyw); $og_title=$title; $og_desc=$metadesc; $og_url="https://price-wizard.com/cgi-perl/pw.catablogs.cgi?b=$blogid"; if (-e '/var/www/sites/ubuyne/images/screenshots/'.lc($catkey).'_screenshot.png'){ $og_img='https://price-wizard.com/images/screenshots/'.lc($catkey).'_screenshot.png'; } } elsif ($blogid eq'') { &generate_blogs(\$content_ref,\$catkey,\$page,\$ymdate,\$domain); # No blog-ID, so could be listing by storekey, or by date } if ($catkey eq'_non'){$catkey='';}; # We should be finished with using $catkey now, so set to '', so we get a banner if ($title eq'') { $title='Latest UK Catalogue News, Mail-Order Deals, Special Offers & Beyond'; } &print_myheader(); # Print the content/type header &html_top_of_page(-bannerkey=>\$catkey,-title=>\$title,-metadesc=>\$metadesc,-keywords=>\$metakeyw,-og_title=>\$og_title,-og_desc=>\$og_desc,-og_url=>\$og_url,-og_img=>\$og_img); print '
'; print $content_ref if (defined $content_ref); # Avoid errors by using the "defined" check print '
'; print qq~

$catlist
~; &print_footer(\0); # Print the copyright message and bar }1; # -------------------------------------------------------------------------------------------------------------------------- sub generate_this_blog { my $html =shift; # A reference my $title =shift; # " my $blogid =shift; # " my $storekey =shift; # " my $metadesc =shift; # " my $metakeyw =shift; # " my ($url,$desc,$longdesc,$related,$pmonths,$logdate,$blog,$welcome_text,$catextra,$contactlink,$desc_div,$urlposts,$catlink,$catlink2)=''x14; my $triangle='*'; # This would work if we had $storekey when we get to this point, but we only have the catablog ID so far. # my $SQLQUERY=qq~SELECT t1.TITLE,t1.URL,t1.STOREKEY,t1.DESCRIPTION,t1.LONGDESC,t1.RELATED,DATE_FORMAT(t1.LOGDATE,"%W, %D %M, %Y"),t2.STORENAME,t2.WORDS FROM STORES t2 JOIN PW_CATABLOGS t1 WHERE (t1.DKEY='$$blogid' AND t1.ACTIVE=1) AND t2.STOREKEY="$$storekey"~; my $SQLQUERY=qq~SELECT TITLE,URL,STOREKEY,DESCRIPTION,LONGDESC,RELATED,DATE_FORMAT(LOGDATE,"%W, %D %M, %Y") FROM PW_CATABLOGS WHERE DKEY='$$blogid' AND ACTIVE=1~; undef my @result; &fetch_single_record2(\@result,\$SQLQUERY); $$title =$result[0]; $url =$result[1]; $$storekey =$result[2]; $desc =$result[3]; $desc=~s/([^\000-\177])/'&#'.ord($1).';'/ge; $longdesc =$result[4]; $longdesc=~s/([^\000-\177])/'&#'.ord($1).';'/ge; $related =$result[5]; $logdate =$result[6]; my $banner300=''; &get_random_banner(\$banner300, $storekey,\'300',\'250',\'class="responsive_img img300d"'); # let's see if a 300x250 banner exists $SQLQUERY=qq~SELECT STORENAME,WORDS FROM STORES WHERE STOREKEY="$$storekey"~; undef my @result; &fetch_single_record2(\@result,\$SQLQUERY); my $storename=$result[0]; my $keyw=$result[1]; my $temp_meta=$longdesc; $temp_meta=substr($temp_meta,0,130); $temp_meta=substr($temp_meta,0,rindex($temp_meta,' ')); $$metadesc=$$title.'. '.$temp_meta .' …'; $$metadesc=~s/"/"/g; # swap out any quotation marks (unlikely to be any, but if there are it may screw up the page) $$metadesc =~ s|<.+?>||g; # remove any html tags (could be an occasional "" or "126) { substr($desc,$i,1)="&#$ord;"; $i=0; } } for(my $i=0;$i126) { substr($longdesc,$i,1)="&#$ord;"; $i=0; } } my $domain =$ENV{'HTTP_HOST'}; # Only do any of this section if we have a valid blog (ie. one with a title) if ($$title gt'') { $$storekey=~tr/A-Z/a-z/; if ($longdesc eq''){$longdesc=$desc}; $longdesc=~s/\n/
/g; $blog=join('','

',$$title,'

',$banner300,$longdesc); undef my @relatedurls; if ($related gt'') { @relatedurls=split(/\n/,$related); } if ($$storekey gt'') { my $catname=''; $SQLQUERY=qq~SELECT STORENAME,WORDS FROM STORES WHERE STOREKEY="$$storekey"~; undef my @result; &fetch_single_record2(\@result,\$SQLQUERY); my $catname=$result[0]; my $keyw=$result[1]; $$metakeyw=lc($keyw); if (index($$metakeyw,lc($catname)==-1)){$$metakeyw=lc($catname).', '.$$metakeyw;} $catextra=''; if ($catname gt'') { $$title=join(': ',$catname,$$title); $catlink=qq~$catname~; $catlink2=qq~$catname Online Store~; $catlink2=~s/Online Online/Online /g; # De-dupe # If we don't check for the img tag, then the "alt" text of any banner300 which may exist will get swapped instead, causing issues if (index($blog,'$catname Company Details");~; $contactlink=qq~~; } my $pwlink=qq~
  • $catname, at Price-Wizard.com
  • ~; $catextra=qq~

    Other $catname Links:

    $desc_div ~; } } elsif($url gt'') { } if (@relatedurls) { my $relatedurls='

    Links Relating To This Article:

    '; foreach(@relatedurls) { my ($ru,$rt)=split(/\|/,$_); $ru=~s#mycatalogues.com/cgi2/mc.catgo.cgi\?c#price-wizard.com/cgi-perl/pw.displaystore.cgi?store#; $ru=~s#mycatalogues.com/cgi2/mc.go.cgi\?c#price-wizard.com/cgi-perl/pw.direct.pl?store#; if ( (index($relatedurls,'http://')!=-1) || (index($relatedurls,'https://')!=-1) ){ $relatedurls.='   -   '; }; $relatedurls.=qq~$rt~; } $relatedurls.='

    '; $catextra.=$relatedurls; } $urlposts=''; &socialmedia_links(\$urlposts); } else { $blog=join('','

    Invalid CataBlog ID

    Sorry! The catablog ID requested is either invalid or is currently unavailable. If you reached this page from a link on our site then please feel free to let us know, and we can then take steps to fix the link. Alternatively, if you reached this page from a link on another site, you may like to let them know that one of their links may be broken.

    However, all of the catablogs on this site may be reached by using the calendar-menu above, so hopefully you can still easily locate the article you were looking for.

    '); } # end of "if ($$title gt'') ... my $headlines=''; &get_recent_headlines(\$headlines,$blogid,\$domain); if ($headlines gt'') { $headlines=~s/([^\000-\177])/'&#'.ord($1).';'/ge; $headlines=join('','

    Other Recent Shopping News:

    ',$headlines); } my $storelink=''; if ($catlink2 gt'') { $storelink=join('','  ',$catlink2,''); } &generate_monthlist(\$pmonths,\'',\'',$storekey,\'2',\$domain); $$html=qq~

    Price-Wizard Shopping News:


    $pmonths

    $logdate
    $storelink

    $blog
    $urlposts
    $catextra $headlines

    Interflora Flowers, Official Website
    ~; }1; # -------------------------------------------------------------------------------------------------------------------------- sub get_recent_headlines{ my $headlines =shift; # A reference my $blogid =shift; # " my $domain =shift; # " my $SQLQUERY=qq~SELECT TITLE,DESCRIPTION,DATE_FORMAT(LOGDATE,"%D %M, %Y"),DKEY FROM PW_CATABLOGS WHERE ACTIVE=1 AND LONGDESC>"" AND DKEY<>"$$blogid" ORDER BY LOGDATE DESC LIMIT 3~; undef my @records; &fetch_records2(\@records,\$SQLQUERY,'^'); for (@records) { my($title,$desc,$logdate,$dkey)=split(/\^/,$_); &numbers_only(\$dkey); $$headlines.=join('','',$logdate,': ',$title,'
    ','',$desc,'

    '); } undef $SQLQUERY; undef @records; }1; # -------------------------------------------------------------------------------------------------------------------------- sub get_store_description{ my $html =shift; # A reference my $storekey =shift; # " my $counter =0; my $SQLQUERY=join('','SELECT STORENAME,DESCRIPTION,REALURL FROM STORES WHERE STOREKEY="',$$storekey,'"'); undef my @record; &fetch_single_record2(\@record,\$SQLQUERY); my $storename =$record[0]; my $desc =$record[1]; my $realurl =$record[2]; $$html=qq~

    $storename Information


    $desc~; $$html.=join('','

    Official Website: ',$realurl,'
    '); $$html.='
    '; undef @record; undef $SQLQUERY; }1; # -------------------------------------------------------------------------------------------------------------------------- sub socialmedia_links{ my $links = shift; # A reference $$links=qq~
    Share this item with other Internet shoppers:
    ~; }1; # --------------------------------------------------------------------------------------------------------------------------