#!/usr/bin/perl # # Note: The explicit use of the mysql tool as a command exporting to xml # is intentional - it avoids pulling in the perl DBI components and thus # reducing the dependencies. It's not a good way to do things! # # Recommended use: # ./sync.pl -rename # Renames the channels to be consistent # ./sync.pl -callsigns # Updates inconsistent callsigns # ./sync.pl -regionals # Hides/deletes regional stations we don't use # ./sync.pl -xmltv # Update the XMLTV details in the database and creates .xmltv files # ./sync.pl -duplicates # Warns about duplicate files # ./sync.pl -validatenumbers # Writes a value for any channels numbers that are not numbers # ./sync.pl -listcategories # ./sync.pl -listcategory # Lists all categories, or the channels in a category # ./sync.pl -hidecategory # ./sync.pl -unhidecategory # Hides/Unhides all the channels in a category # ./sync.pl -alignfreesat # ./sync.pl -alignfreeview # Renumber channels to match freesat or freeview # ./sync.pl -listfreesat # ./sync.pl -listfreeview # List the channels in freesat or freeview ordering # # # Hiding lots of channels: # ./sync.pl -hidecategory Music,Radio,International,Shopping,Documentaries,Religious,Adult,Lifestyle,Shopping,Specialist,Dating,Gambling $doUpdate = 0; %regions = ( "BBC One" => "BBC One South", "BBC Two" => "BBC Two England", # Just seems to be called 'BBC Two' now. "ITV 1" => "ITV 1 London", "Channel 4" => "Channel 4" ); # whether we delete or just hide regional channels $deleteRegionals = 0; # whether we use FreeSatFromSky $useFreesatFromSky = 0; # The source ids which contain the channels #@sources_freeview = ( 1 ); #@sources_freesat = ( 4 ); @sources_freeview = (); @sources_freesay = ( 1 ); # Any prefix and suffix strings for channel names ($prefix_freeview, $suffix_freeview) = (undef, undef); ($prefix_freesat, $suffix_freesat) = (undef, undef); # If you want to force freeview channels to a particular range, # set these to 'undef', otherwise they'll be defaulted for you. $basechan_freeview = undef; $basechan_freesat = undef; # Set this to the separation of the base channel numbers. # You can use 0 to overlay, although this may be confusing # and will certainly make this script non-functional on # subsequent passes. $basechan_separation = undef; # Set this to the range of the primary channel numbers. # Usually this is 2000 as the primary assigned numbers are # 0-1999 and ourside this are the 'other' channels $basechan_primary = undef; # Myth configuration $myth_user = "mythtv"; $myth_pass = "mythtv"; $myth_db = "mythconverg"; use Getopt::Long; use Encode; use Data::Dumper; # Inferred options: $useFreesat = @sources_freesat > 0; $useFreeview = @sources_freeview > 0; if (!$useFreesat && !$useFreeview) { # They've not given any source details. # Let's guess. $guessSources = 1; $useFreesat = 1; $useFreeview = 1; } @allSources = ( @sources_freeview, @sources_freesat ); GetOptions("verbose" => \$verbose, "dbname=s" => \$myth_db, "dbuser=s" => \$myth_user, "dbpass=s" => \$myth_pass, "live" => \$doUpdate, "xmltv" => \$updateXmlTv, "regionals" => \$removeRegionals, "deleteRegionals" => \$deleteRegionals, "guessSources" => \$guessSources, "rename" => \$updateChannelNames, "validateNumbers" => \$validateChannelNums, "callsigns" => \$updateCallsigns, "duplicates" => \$reportDuplicates, "freesatfromsky" => \$useFreesatFromSky, # allow '--nofreesatfromsky' "freesat!" => \$useFreesat, # allow '--nofreesat' "freeview!" => \$useFreeview, # allow '--nofreeview' "alignfreesat" => \$alignFreesat, "alignfreeview" => \$alignFreeview, "listfreesat" => \$listFreesat, "listfreeview" => \$listFreeview, "listcategories" => \$listCategories, "listcategory=s" => \$listCategory, "hidecategory=s" => \@hideCategory, "unhidecategory=s" => \@unhideCategory, ) || exit 1; my $basechan = 0; if (!defined $basechan_primary) { # Most channel groups are within a range of 2000. $basechan_primary = 2000; } if (!defined $basechan_separation) { # Most channel groups are within a range of 2000, # and we want to put all our other channels after # that so a separation of 2000 is usually ok. $basechan_separation = 2000; } if (!defined $basechan_freeview && $useFreeview) { $basechan_freeview = $basechan; $basechan += $basechan_separation * @sources_freeview; } if (!defined $basechan_freesat && $useFreesat) { $basechan_freesat = $basechan; $basechan += $basechan_separation * @sources_freesat; } # Freesat (digital spy) $page_freesat = "http://www.digitalspy.co.uk/satellite/freesatepg/"; $file_freesat = "freesat2.html"; # Freesat (joinfreesat) $page_freesat = "http://www.joinfreesat.co.uk/index.php/freesat-channels"; $file_freesat = "freesat3.html"; # Freesat From Sky (digital spy) $page_freesatfromsky = "http://www.digitalspy.co.uk/satellite/freesatfromskyepg/"; $file_freesatfromsky = "freesatfromsky.html"; # Freeview #$page_freeview = "http://www.digitalspy.co.uk/terrestrial/mux/"; #$file_freeview = "freeview.html"; $page_freeview = "http://www.radioandtelly.co.uk/freeviewchannels.html"; $file_freeview = "freeview2.html"; # XMLTV Radio Times $page_xmltvrt = "http://supplement.xmltv.org/tv_grab_uk_rt/channel_ids"; $file_xmltvrt = "xmltvrt.txt"; %regionalNames = ( "BBC One" => [ "BBC One Channel Islands", "BBC One East (E)", "BBC One East (W)", "BBC One East Midlands", "BBC One East Yorkshire & Lincolnshire", "BBC One London", "BBC One North East", "BBC One North West", "BBC One Northern Ireland", "BBC One Oxford", "BBC One Scotland", "BBC One South", "BBC One South East", "BBC One South West", "BBC One Wales", "BBC One West", "BBC One West Midlands", "BBC One Yorkshire" ], "BBC Two" => [ "BBC Two Scotland", "BBC Two England", "BBC Two Wales", "BBC Two Northern Ireland" ], "ITV 1" => [ "ITV 1 Anglia East", "ITV 1 Anglia South", "ITV 1 Borders", "ITV 1 Border England", "ITV 1 Border Scotland", "ITV 1 Central East", "ITV 1 Central South", "ITV 1 Central West", "ITV 1 Channel Islands", "ITV 1 Granada", "ITV 1 London", "ITV 1 Meridian South", "ITV 1 Meridian South East", "ITV 1 Tyne Tees", "ITV 1 Wales", "ITV 1 West", "ITV 1 West Country", "ITV 1 Yorkshire", "ITV 1 Central E", "ITV 1 Central S", "stv", "UTV" ], "Channel 4" => [ "Channel 4", "S4C Digidol", ], ); %regionalCallSign = ( "BBC One" => "BBC ONE", "BBC Two" => "BBC TWO", "ITV 1" => "ITV1", "Channel 4" => "Channel 4", ); %nameStandards = ( # BBC TV 'BBC *1' => 'BBC One', 'BBC *2' => 'BBC Two', 'BBC *3' => 'BBC Three', 'BBC *4' => 'BBC Four', 'BBC *News' => 'BBC News', 'BBC *News Channel' => 'BBC News', 'BBC PARL\'MNT' => 'BBC Parliament', 'BBC Alba' => 'BBC Alba', 'CBBC Channel' => 'CBBC', # BBC Regionals 'BBC One E Mids' => 'BBC One East Midlands', 'BBC One W Mids' => 'BBC One West Midlands', 'BBC One N West' => 'BBC One North West', 'BBC One NE & C' => 'BBC One North East', 'BBC One North East & Cumbria' => 'BBC One North East', 'BBC One S East' => 'BBC One South East', 'BBC One S West' => 'BBC One South West', 'BBC One Yrks&Lin' => 'BBC One East Yorkshire & Lincolnshire', 'BBC One East Yorks & Lincs' => 'BBC One East Yorkshire & Lincolnshire', 'BBC One Yorks$' => 'BBC One Yorkshire', 'BBC One South \(Oxford\)' => 'BBC One Oxford', 'BBC One South \[Southampton\]' => 'BBC One South', 'BBC One East \(East Edition\) \[Norwich\]' => 'BBC One East (E)', 'BBC One East \(West Edition\) \[Cambridge\]' => 'BBC One East (W)', 'BBC One South West \(Channel Islands\)' => 'BBC One Channel Islands', # BBC Radio 'BBC *R(?=\d)' => 'BBC Radio ', 'BBC *R Cymru' => 'BBC Radio Cymru', 'BBC *R n Gael' => 'BBC Radio nan Gaidheal', 'BBC *R Scot.' => 'BBC Radio Scotland', 'BBC *R Ulster' => 'BBC Radio Ulster', 'BBC *R Wales' => 'BBC Radio Wales', 'BBC *Radio Five' => 'BBC Radio 5', 'BBC *Radio 4$' => 'BBC Radio 4 FM', 'BBC *Radio 5 *L$' => 'BBC Radio 5 Live', 'BBC *Radio 5 *L SportsX$' => 'BBC Radio 5 Live Sports Extra', 'BBC *Radio 5 *SX$' => 'BBC Radio 5 Live Sports Extra', 'BBC *Asian Net\.?(work)?' => 'BBC Radio Asian Network', 'BBC *Asian$' => 'BBC Radio Asian Network', 'BBC *World Sv\.' => 'BBC World Service', 'BBC *WS' => 'BBC World Service', 'BBC OneXtra' => 'BBC Radio 1Xtra', 'BBC 5' => 'BBC Radio 5', 'BBC 6 Music' => 'BBC Radio 6', 'BBC 7' => 'BBC Radio 7', 'BBC London' => 'BBC Radio London', 'BBC Radio London 94.9' => 'BBC Radio London', # Common suffixes ' CI$' => ' Channel Islands', ' NI$' => ' Northern Ireland', ' FM$' => ' FM', # Common abbreviations 'Netwrk' => 'Network', 'Chnl' => 'Channel', 'Ch$' => 'Channel', 'tv$' => 'TV', # Channel 5 '5USA' => '5 USA', # ITV 'ITV(?=\d)' => 'ITV ', 'ITV ?1 ?HD' => 'ITV HD', 'ITV 1? London' => 'ITV 1 London', 'CITV Channel' => 'CITV', # ITV Regionals 'ITV ?1 Anglia E$' => 'ITV 1 Anglia East', # Doesn't exist according to Wikipedia - they have North though 'ITV ?1 Anglia S$' => 'ITV 1 Anglia South', 'ITV ?1 Border$' => 'ITV 1 Border England', 'ITV ?1 Border \(Scotland\)' => 'ITV 1 Border Scotland', 'ITV ?1 BorderSco$' => 'ITV 1 Border Scotland', 'ITV ?1 Central E$' => 'ITV 1 Central East', 'ITV ?1 Central W$' => 'ITV 1 Central West', 'ITV ?1 Central S$' => 'ITV 1 Central South', # Doesn't exist according to Wikipedia 'ITV ?1 Meridian S$' => 'ITV 1 Meridian South', 'ITV ?1 Meridian E$' => 'ITV 1 Meridian South East', # Named according to Wikipedia (find me a better source) 'ITV ?1 TT N' => 'ITV 1 Tyne Tees', 'ITV ?1 W Country' => 'ITV 1 West Country', 'ITV ?1 Yorks W' => 'ITV 1 Yorkshire', 'ITV Channel Is$' => 'ITV 1 Channel Islands', # Channel 4 'Channel4' => 'Channel 4', '^E *4' => 'E4', '^More *4' => 'More4', '4TV Interactive Services' => '4TV Interactive', '4TV *Interactive' => '4TV Interactive', '^S4C$' => 'S4C Digidol', '^S4C2' => 'S4C 2', # Radios '^Heat$' => 'Heat', '^Heat Radio' => 'Heat', 'Magic Radio' => 'Magic', '^Kiss 100$' => 'Kiss', '^Q Radio$' => 'Q', '102.2 Smooth FM' => 'Smooth Radio', '^Capital$' => 'Capital FM', 'Choice FM 96.9' => 'Choice FM', 'Classic FM' => 'Classic FM', 'InsightRadio' => 'Insight Radio', 'Mojo' => 'Mojo', '^NME$' => 'NME Radio', '^WRN Europe$' => 'WRN Radio', 'Premier Radio' => 'Premier Christian Radio', '^Absolute$' => 'Absolute Radio', '^Absolute CR$' => 'Absolute Classic Rock', '^Absolute Class Rock$' => 'Absolute Classic Rock', '^Absolute XT$' => 'Absolute Xtreme', '^Yorkshire R$' => 'Yorkshire Radio', '^Caroline$' => 'Radio Caroline', '^Sunrise$' => 'Sunrise Radio', 'Planet Rock' => 'Planet Rock', 'FUN Kids' => 'FUN Kids', 'RTE 2FM' => 'RTE Radio 2 FM', '^RTE Radio 2$' => 'RTE Radio 2 FM', '^Lyric FM' => 'RTE Lyric FM', 'RTE R na G' => 'RTE Raidio na Gaeltachta', 'XFM 104.9' => 'XFM', '^Raidio na Gaeltachta' => 'RTE Raidio na Gaeltachta', 'Gaydarradio' => 'Gaydar Radio', 'JazzFM' => 'Jazz FM', 'Punjabi Radio' => 'Punjabi Radio', 'ArrRock' => 'Arrow Radio', 'ArrwRock' => 'Arrow Radio', 'The Arrow' => 'Arrow Radio', # Stupid 'UK TV' group naming '^Dave ja vu' => 'Dave +1', # +1 is too good for us '^G.o.l.d$' => 'G.O.L.D.', # An acronym ? Really ?! '^UKTV History'=> 'Yesterday', # "What's on Yesterday" ? # Others '^Zone(?! )' => 'Zone ', 'Movies4Men' => 'Movies4Men', 'Movies4Men2' => 'Movies4Men 2', 'Mov4Men' => 'Movies4Men', 'Horror Channel' => 'Horror Channel', '[Hh]orror [Cc]h ?\+1' => 'Horror Channel +1', '^euronews' => 'euronews', 'Setanta Sports' => 'Setanta Sports', 'Setanta Sports 1' => 'Setanta Sports', '^talk *Sport' => 'talkSPORT', 'Virgin(?=\d)' => 'Virgin ', 'tvtv *digital$' => 'tvtv DIGITAL EPG', # EPG is NOT part of the name, but I've added it to distinguish from real channels 'smile *tv' => 'Smile TV', 'smile *tv *2' => 'Smile TV 2', '^Quest$' => 'Quest', '^GOD Europe' => 'GOD Europe', '^GOD Channel' => 'GOD Channel', 'stv' => 'stv', 'TMF: TMF' => 'TMF', 'The Music Factory' => 'TMF', 'DanceNationTV' => 'Dance Nation TV', 'Ttext Holidays' => 'Teletext Holidays', 'Teletext Holidays &$' => 'Teletext Holidays & Cars', 'Teletext Holidays & Cars' => 'Teletext Holidays & Cars', 'Teletext Hols' => 'Teletext Holidays', '^Teletext On 4' => 'Teletext On 4', 'TT On 4' => 'Teletext On 4', 'smile *tv' => 'Smile TV', '^Community Channel' => 'Community', '^CommunityChnl' => 'Community', 'Teachers\' TV' => 'Teachers TV', 'National Lottery Xtra' => 'Lottery Xtra', '^CNN$' => 'CNN International', 'Bloomberg (Television|TV)' => 'Bloomberg', 'Men and Motors' => 'Men & Motors', 'Zee Music' => 'Zee Muzic', 'Inspiration TV' => 'Inspiration', '^INI$' => 'Inspiration', 'Daystar TV' => 'Daystar', 'Supreme Mastr' => 'Supreme Master', 'Al Jazeera English' => 'Al Jazeera', 'Al Jazeera Eng$' => 'Al Jazeera', 'jazeerachildren' => 'Jazeera Children', 'CasinoTV' => 'Casino TV', 'FriendlyTV' => 'Friendly TV', 'Channel \'S\'' => 'Channel S', 'channel U' => 'Channel U', 'GayDateTV' => 'Gay Date TV', 'HITV' => 'HiTV', 'oMusic TV' => 'O Music TV', 'RockworldTV' => 'Rockworld TV', '^propeller' => 'Propeller', '^revelation' => 'Revelation', 'MTA-Muslim TV' => 'MTA - Muslim TV', 'Horse & Country TV' => 'Horse & Country', 'euronews' => 'Euronews', 'Aastha$' => 'Aastha TV', '9X$' => '9XM', 'EWTN$' => 'EWTN TV', 'Mandani Chnl' => 'Mandani Channel', 'Comedy CentralX' => 'Comedy Central Extra', 'ComedyCtl' => 'Comedy Central', 'Info TV' => 'Information TV', 'Viva' => 'Viva', 'Colors' => 'Colors', 'More>Movies' => 'More Movies', 'm>movies \+1' => 'More Movies +1', 'Film ?On.?TV' => 'FilmOn.TV', "BET:BlackEntTV" => 'BET', 'France 24' => 'France 24', 'France 24$' => 'France 24 Eng', 'France 24 Eng$' => 'France 24 English', 'France Eng' => 'France 24 English', 'GEO TEZ' => 'GEO Tez', 'Chartshw Dnce' => 'Chart Show Dance', 'Chartshow Dance' => 'Chart Show Dance', 'CH NINE UK' => 'Channel 9 UK', 'Blissmas' => 'Bliss', 'NOW Christmas' => 'NOW Christmas', 'Smash hits!' => 'Smash Hits', 'Rishtay' => 'Rishtey', 'Community$' => 'Community TV', # Five '^Fiver' => 'Fiver', '^Five' => 'Five', # Sky channels '^Sky' => 'Sky', '^Sky (?=[123])' => 'Sky', 'Sky Two' => 'Sky2', 'Sky THREE' => 'Sky3', 'Sky Spts News' => 'Sky Sports News', 'Pick TV' => 'Pick TV', # Shopping '^TV *Shop' => 'TV Shop', '^Shop on TV' => 'Shop on TV', '^Gems TV *(?=[1234])' => 'Gems TV ', '^Gems[ \.]*TV' => 'Gems TV', '^Gems *TV *1' => 'Gems TV', '^Pitch *World' => 'Pitch World', '^Pitch *TV' => 'Pitch TV', 'Jewellery Ch\.' => 'Jewellery Channel', 'Jewelry Maker' => 'Jewellery Maker', 'JewelleryMaker' => 'Jewellery Maker', 'Record TV' => 'Record Internacional Europa', 'HighStreetTV' => 'High Street TV', 'CelebrityShop' => 'Celebrity Shop', 'Screenshop2' => 'Screenshop 2', 'speedauctiontv' => 'Speed Auction TV', 'Bid TV' => 'bid tv', '^bid$' => 'bid tv', '^price[- ]drop$' => 'price-drop tv', 'price[- ]drop tv' => 'price-drop tv', 'Travel Ch \+1' => 'Travel Channel +1', 'TravelChannel2' => 'Travel Channel 2', 'JML Home&DIY' => 'JML Home & DIY', 'JML CookShop' => 'JML Cook Shop', 'JJB Sports TV' => 'JJB Sports', 'Wedding TV Asia' => 'Wedding TV Asia', 'Wedding TV' => 'Wedding TV', 'holiday\+cruise' => 'Holiday and Cruise', 'Paversshoes.TV' => 'PaversShoes TV', 'Rocks & Co ?' => 'RocksAndCo', 'Sony SAB' => 'Sony SAB', 'The ?Deal ?Channel' => 'The Deal Channel', 'The Style Ntwk' => "The Style Network", # XXX 'Livexxxbabes' => 'Live XXX Babes', 'Sportxxxbabes' => 'Sport XXX Babes', 'Sportxxxgirls' => 'Sport XXX Girls', 'Sportxxxwives' => 'Sport XXX Wives', 'Babeworld$' => 'Babeworld.tv', 'Live XXX TV' => 'Live XXX', 'PlayboyTV' => 'Playboy TV', '^Red Light$' => 'Red Light 1', 'RedHot Mums' => 'RedHot Mums', 'RedHot 18s' => 'RedHot 18s', # Kids '^Pop' => 'Pop', 'Pop *Girl' => 'Pop Girl', 'Tiny Pop' => 'Tiny Pop', 'Kix!' => 'Kix', # Gaming 'Net *Play *TV' => 'NetPlayTV', 'Teletext *Casino' => 'Teletext Casino', '^Super *Casino' => 'SuperCasino', # +1 channels in a standard format '(? ' +1', '\+ 1' => '+1', # Character replacements (simplifies some of the Irish stations) 'É' => 'E', 'ó' => 'o', # Simplify 'and' ' and ' => ' & ', ); %xmltvEquivilent = ( '^BBC One East Midlands' => 'BBC One Midlands', '^BBC One West Midlands' => 'BBC One Midlands', '^ITV 1 Meridian.*' => 'ITV 1 Meridian', '^ITV 1 Central.*' => 'ITV 1 Central', '^ITV 1 Anglia.*' => 'ITV 1 Anglia', '^BBC One.*' => 'BBC One Generic', '^BBC Two.*' => 'BBC Two Generic' ); if ($useFreesat) { # We get both so that we can ensure that our names are consistent # between the two. print "> Get FreeSat channels\n" if ($verbose); # $freesat_regular = freesat2_getchannels(0); $freesat_regular = freesat3_getchannels(0); if ($useFreesatFromSky) { print "> Get FreeSatFromSky channels\n" if ($verbose); $freesat_fromsky = freesat2_getchannels(1); } # And update the variable to the one we'll use $freesat = $useFreesatFromSky ? $freesat_fromsky : $freesat_regular; } if ($useFreeview) { print "> Get FreeView channels\n" if ($verbose); $freeview = freeview2_getchannels(); } print "> Get XML TV RT channesl\n" if ($verbose); $xmltvrt = xmltvrt_getchannels(); print "> Get MythTV channels\n" if ($verbose); $myth = myth_getchannels(); print "> Get Category channels\n" if ($verbose); $categories = categories_getchannels(); # Standardise our Freesat names if ($useFreesat) { print "> Standardise FreeSat names\n" if ($verbose); $changes = names_standardise($freesat); $freesat = changes_apply($changes, $freesat); } # Standardise our Freeview names if ($useFreeview) { print "> Standardise FreeView names\n" if ($verbose); $changes = names_standardise($freeview); $freeview = changes_apply($changes, $freeview); } # Standardise our XMLTV names print "> Standardise XMLTV names\n" if ($verbose); $changes = names_standardise($xmltvrt); $xmltvrt = changes_apply($changes, $xmltvrt); # Standardise our XMLTV names print "> Standardise category names\n" if ($verbose); $changes = names_standardise($categories); $categories = changes_apply($changes, $categories); # Update the names of channels print "> Standardise MythTV names\n" if ($verbose); $changes = names_standardise($myth); if ($updateChannelNames) { myth_applychanges($changes, $myth); } $myth = changes_apply($changes, $myth); print "> Validate the channel numbers\n" if ($verbose); $changes = channels_validate($myth, 0); if ($validateChannelNums) { myth_applychanges($changes, $myth); } $myth = changes_apply($changes, $myth); # Check for similar items, which usually indicate problems in naming if ($useFreesat) { if (names_checksimilar('MythTV->FreeSat', $myth, $freesat)) { die "\nCheck page at $page_freesat\n"; } if (names_checksimilar('XMLTVRT->FreeSat', $xmltvrt, $freesat)) { die "\nCheck page at $page_freesat or $page_xmltvrt\n"; } if (names_checksimilar('Categories->FreeSat', $categories, $freesat)) { die "\nCheck page at $page_freesat or our categories\n"; } # Check both the freesat and freesat from sky for consistency if (names_checksimilar('FreeSatFromSky->FreeSat', $freesat_fromsky, $freesat_regular)) { die "\nCheck page at $page_freesatfromsky or $page_freesat\n"; } } if ($useFreeview) { if (names_checksimilar('MythTV->FreeView', $myth, $freeview)) { die "\nCheck page at $page_freeview\n"; } if (names_checksimilar('XMLTVRT->FreeView', $xmltvrt, $freeview)) { die "\nCheck page at $page_freeview or $page_xmltvrt\n"; } if (names_checksimilar('Categories->FreeView', $categories, $freeview)) { die "\nCheck page at $page_freeview or our categories\n"; } } if ($useFreeview && $useFreesat) { if (names_checksimilar('FreeSat->FreeView', $freesat, $freeview)) { die "\nCheck page at $page_freesat or $page_freeview\n"; } } if (names_checksimilar('XMLTVRT->MythTV', $xmltvrt, $myth)) { die "\nCheck page at $page_xmltvrt (or your MythTV settings)\n"; } if (names_checksimilar('XMLTVRT->Categories', $xmltvrt, $categories)) { die "\nCheck page at $page_xmltvrt or our categories\n"; } if (names_checksimilar('Categories->MythTV', $categories, $myth)) { die "\nCheck MythTV settings or our categories\n"; } # Let's see if we can guess what the sources are if ($guessSources) { myth_guesssources($myth, $freeview, $freesat); } # Remove any regional channels they might not want $changes = channels_reduceregionals($myth); if ($removeRegionals) { myth_applychanges($changes, $myth); } $myth = changes_apply($changes, $myth); # Update XmlTv IDs if ($updateXmlTv) { # Create the xmltv files for us $files = xmltv_makefiles($myth); for $filename (keys %$files) { print "Construct XMLTV file '$filename'\n"; open(OUT, "> $filename") || die "Cannot write $filename: $!\n"; print OUT $files->{$filename}; close(OUT); } # Update the Myth IDs on the channels $changes = xmltv_setid($xmltvrt, $myth); myth_applychanges($changes, $myth); $myth = changes_apply($changes, $myth); } if ($reportDuplicates) { $changes = names_reportduplicates($myth); print "Duplicate channels:\n"; for my $id (sort { $changes->{$a}->{'name'} cmp $changes->{$b}->{'name'} } keys %$changes) { my $one = $myth->{$id}; my $two = $myth->{$changes->{$id}->{'id'}}; # For ease, we'll ignore duplicates that are on different # sources - that way S+T won't be confusing. next if ($one->{'sourceid'} != $two->{'sourceid'}); printf "%6s : %6s : %s\n", $one->{'num'}, $two->{'num'}, $one->{'name'}; } } if ($alignFreeview) { print "Aligning channels on Freeview\n"; $basechan = $basechan_freeview; for my $sourceid (@sources_freeview) { $changes = channels_align($myth, $freeview, $sourceid, $basechan, $basechan+$basechan_primary, $prefix_freeview, $suffix_freeview); myth_applychanges($changes, $myth); #print Dumper($changes); } } if ($alignFreesat) { print "Aligning channels on Freesat\n"; $basechan = $basechan_freesat; for my $sourceid (@sources_freesat) { $changes = channels_align($myth, $freesat, $sourceid, $basechan, $basechan+$basechan_primary, $prefix_freesat, $suffix_freesat); myth_applychanges($changes, $myth); #print Dumper($changes); } } if ($updateCallsigns) { print "Updating callsigns\n"; $changes = channels_checkcallsigns($myth); myth_applychanges($changes, $myth); #print Dumper($changes); } # List the channels if ($listFreesat) { print "Listing Freesat channels\n"; channels_listchannels($freesat, $myth, \@sources_freesat, $basechan_freesat) } if ($listFreeview) { print "Listing Freeview channels\n"; channels_listchannels($freeview, $myth, \@sources_freeview, $basechan_freeview) } if ($listCategories) { print "Listing all categories\n"; categories_list($categories); } if ($listCategory) { print "Listing category '$listCategory'\n"; categories_listcategory($categories, $listCategory, $myth); } if (@hideCategory) { @hideCategory = split / *, */, join ',', @hideCategory; print "Hiding category ", join(", ", @hideCategory), "\n"; $changes = categories_hide($categories, $myth, 1, @hideCategory); myth_applychanges($changes, $myth); } if (@unhideCategory) { print "Unhiding category ", join(", ", @unhideCategory), "\n" if (@unhideCategory); $changes = categories_hide($categories, $myth, 0, @unhideCategory); myth_applychanges($changes, $myth); } #print Dumper($xmltvrt); #print Dumper($freesat); #print Dumper($freeview); #print Dumper($myth); #print Dumper($changes); sub web_getpage { my ($url, $file) = @_; #print "$url =>\n $file\n Age: " . (-A $file) . "\n"; if (!-e $file || -z $file || -A $file > 3) { # Fetch the freesat page print "> Fetching $url\n" if ($verbose); unlink $file; system "wget --quiet -O $file $url"; } open(IN, "< $file") || return ""; $t = ""; while () { $t .= $_ } close(IN); return $t; } sub xmltvrt_getchannels { my %chan; my $t; $t = web_getpage($page_xmltvrt, $file_xmltvrt); for (split /\n/, $t) { # 1) XMLTV ID (*) # 2) Radio Times ID (from http://xmltv.radiotimes.com/xmltv/channels.dat) (*) # 3) Channel name (+) # 4) Channel icon URL (+) # 5) Offset for a timeshifted channel compared to that of the regular channel # available from RT (+) # 6) Broadcast hours for channels carried only part-time on certain platforms # (i.e. Freeview) which have regular listings available from the Radio # Times (+) next if (/^#/); next if (/^blank\./); # 'Do Not Use' my %hash; my @cols = split /\|/, $_; $hash{'xmltvid'} = $cols[0]; #$hash{'rtid'} = $cols[1]; # unuseful at present $hash{'name'} = $cols[2]; $hash{'icon'} = $cols[3]; $hash{'num'} = $cols[0]; $hash{'id'} = $cols[0]; $chan{$cols[0]} = \%hash; } return \%chan; } # Make XMLTV files from the channels given # # @param[in] $channels The channels to process # @return a hashref keyed by filename containing the contents of that file sub xmltv_makefiles { my ($channels) = @_; my (%files); my (%seen); for my $chan (sort { $a->{'name'} cmp $b->{'name'} || $a->{'sourceid'} cmp $b->{'sourceid'} } values %$channels) { my $id = $chan->{'xmltvid'}; next if (!$chan->{'visible'}); if (defined $id && $id ne "") { my $sourcename = $chan->{'sourceidname'}; $sourcename = "channels" if (!defined $sourcename); $sourcename .= ".xmltv"; if (!defined $files{$sourcename}) { $files{$sourcename} = ""; $seen{$sourcename} = {}; } if (!defined $seen{$sourcename}->{$id}) { print "$chan->{'sourceid'}: $chan->{'name'}: $id\n" if ($verbose); $files{$sourcename} .= "channel $id\n"; $seen{$sourcename}->{$id} = 1; $allseen{$id} = 1; } } } return \%files; } sub freesat3_getchannels { my %chan; my $t; $t = web_getpage($page_freesat, $file_freesat); $t =~ s/\n+/ /g; $t =~ s/\r+/ /g; $t =~ s/(.*?)<\/strong>/$1/g; $t =~ s/(.*?)<\/em>/$1/g; $t =~ s/<\/em>//g; $t =~ s/&/&/g; # Do a substitions for the radio channel 'gold' to disambiguate $t =~ s/(7..) Gold/$1 Gold radio/; while ($t =~ s/

([^<]*?)<\/font><\/p>

(.*?)<\/p>//) { my $category = $1; my $chunk = $2; my @rows = split /
/, $chunk; for my $row (@rows) { if ($row =~ /(\d+) (.*)/) { my %hash; $hash{'name'} = $2; $hash{'num'} = $1; $hash{'id'} = $1; $hash{'visible'} = 1; $hash{'callsign'} = callsign_fromname($hash{'name'}); $chan{$hash{'num'}} = \%hash; #print "$hash{'num'}: $hash{'name'}\n"; } } } if (0 == keys %chan) { die "No freesat channels known\n"; } return \%chan; } sub freesat2_getchannels { my ($fromSky) = @_; my %chan; my $t; if ($fromSky) { $t = web_getpage($page_freesatfromsky, $file_freesatfromsky); } else { $t = web_getpage($page_freesat, $file_freesat); } $t =~ s/\n+/ /g; $t =~ s/\r+/ /g; if ($t =~ /

Freesat.*?: Channel Lineup<\/h1>(.*)$/) { my $chunk = $1; $chunk =~ s///g; $chunk =~ s/[\n ]+//g; $chunk =~ s///g; $chunk =~ s/ + +/>/g; my @rows = split //, $chunk; for my $row (@rows) { my %hash; my @td = split //, $row; next if ($td[1] !~ /^(\d+)/); my $num = $1; if ($num =~ /^0/) { # Radio channels start with 0 $num += 1000; } next if ($td[3] !~ /(.*?)<\/b>/); my $name = $1; $hash{'name'} = $name; $hash{'num'} = $num; $hash{'id'} = $num; $hash{'visible'} = 1; # There might be duplicates because of different # regional or timing channels. if (defined $chan{$num}) { %hash = %{$chan{$num}}; if (!defined $hash{'callsign'}) { $hash{'callsign'} = callsign_fromname($hash{'name'}); } if (0 == grep { $_ eq $name } split " / ", $hash{'name'}) { $hash{'name'} .= " / $name"; } } if ($td[2] =~ /src="(.*?)"/) { my $url = $1; if ($url !~ /\/blank.gif/) { if (!defined $hash{'logo'}) { $hash{'logo'} = $url; } } } if ($td[3] =~ /href="(.*?)"/) { my $url = $1; if ($url !~ /\/blank.gif/) { if (!defined $hash{'website'}) { $hash{'website'} = $url; } } } $chan{$num} = \%hash; # print "$hash{'num'}: $hash{'name'} : $hash{'logo'} : $hash{'website'}\n"; } } if (0 == keys %chan) { die "No freesat channels known (digital spy)\n"; } return \%chan; } sub freeview_getchannels { my %chan; my $t; $t = web_getpage($page_freeview, $file_freeview); my @chunks = split /

Multiplex /, $t; for my $chunk (@chunks) { if ($chunk !~ //) { next; } my ($multiplex) = ($chunk =~ /^(.*?) *//, $chunk; for my $row (@rows) { my %hash; my @td = split /(.*?)<\/tr>/g); for my $row (@rows) { #print "ROW: $row\n"; my @cols = ($row =~ /]*?> *(.*?) *<\/td>/g); if ($cols[0] =~ /(\d+)/) { my %hash; $hash{'num'} = $1; $hash{'id'} = $1; $hash{'name'} = $cols[1]; $hash{'callsign'} = callsign_fromname($hash{'name'}); $hash{'type'} = $cols[2]; $hash{'multiplex'} = $cols[4]; $hash{'visible'} = 1; $chan{$hash{'num'}} = \%hash; #print "$hash{'num'}: $hash{'name'}\n"; } } } if (0 == keys %chan) { die "No freeview channels known\n"; } return \%chan; } sub myth_getchannels { my %chan; my $list; my %sources; $list = myth_query("SELECT * FROM videosource"); %sources = map { $_->{'sourceid'} => $_->{'name'} } @$list; $list = myth_query("SELECT * FROM channel;"); for my $row (@$list) { my %hash; $hash{'callsign'} = $row->{'callsign'}; $hash{'name'} = $row->{'name'}; $hash{'serviceid'} = $row->{'serviceid'}; $hash{'visible'} = $row->{'visible'}; $hash{'sourceid'} = $row->{'sourceid'}; $hash{'multiplex'} = $row->{'mplexid'}; $hash{'xmltvid'} = $row->{'xmltvid'} if ($row->{'xmltvid'} ne ""); $hash{'sourceid'} = $row->{'sourceid'}; $hash{'sourceidname'} = $sources{$row->{'sourceid'}}; $hash{'num'} = $row->{'channum'}; $hash{'id'} = $row->{'chanid'}; $chan{$hash{'id'}} = \%hash; #print "$hash{'num'} : $hash{'name'} : $row->{'visible'}\n"; } return \%chan; } sub myth_applychanges { my ($changes, $myth) = @_; for my $id (sort keys %$changes) { my $change = $changes->{$id}; my $set = ""; for my $field (keys %$change) { if ($field eq 'xmltvid' || $field eq 'name' || $field eq 'visible' || $field eq 'num' || $field eq 'callsign') { my $name = $field; $set .= "," if ($set ne ""); $name = 'channum' if ($field eq 'num'); $set .= "$name='"; my $value = $change->{$field}; $value =~ s/'/\\'/; $set .= $value . '\''; } elsif ($field eq 'id' && !defined $change->{$field}) { # Special case; they want the row deleted $set = undef; } else { die "It's probably not wise to try changing $field on myth\n"; } } if (defined $set) { $sql = "UPDATE channel " . "SET $set " . "WHERE chanid='$id'"; } else { $sql = "DELETE " . "FROM channel " . "WHERE chanid='$id'"; } print "$sql\n"; if ($doUpdate) { myth_query($sql); } } } sub myth_query { my ($sql) = @_; my (@list); $sql =~ s/\n/ /g; $sql =~ s/\\/\\\\/g; # we'll need to escape escapes $sql =~ s/"/\\"/g; # we'll need to escape quotes my $cmd = "mysql -X -u $myth_user --password=$myth_pass $myth_db -e \"$sql\" 2>&1"; #if ($cmd =~ /UPDATE/) #{ print "$cmd\n"; die; } my $result = `$cmd`; if ($? != 0) { print "Failed: $cmd\n"; print "Output:\n$result\n"; die "Running comment failed\n"; } #if ($cmd =~ /UPDATE/) #{ # print "$cmd\n\n\n"; # print $result; # die; #} my (@rows) = split //, $result; for my $row (@rows) { my %hash; while ($row =~ s/(.*?)<\/field>//) { # " decode results my ($key, $value) = ($1, $2); next if ($value eq ""); $value =~ s/<//; $value =~ s/"/"/; $value =~ s/&/&/; # Replace things like "s that are escaped $hash{$key} = $value; } push @list, \%hash if (%hash); } return \@list; } ## # Read the details about the sources that are present # @return hashref of sourceid->hashref for each source # 'sourceid' => source id # 'name' => configured name # 'xmltvgrabber' => the grabber to use # 'useit' => whether it's enabled (dunno how this is configured) sub myth_getsources { my $list = myth_query("SELECT * FROM videosource"); my %sources = map { $_->{'sourceid'} => $_ } @$list; return \%sources; } ## # Work out what the sources are from those on the server sub myth_guesssources { my ($myth, $freeview, $freesat) = @_; my ($sources); my (%lineup, $line); $lineup{'freeview'} = { 'channels' => $freeview, 'sourceList' => \@sources_freeview }; $lineup{'freesat'} = { 'channels' => $freesat, 'sourceList' => \@sources_freesat }; for $line (keys %lineup) { # Forcible empty the source list @{$lineup{$line}->{'sourceList'}} = (); $lineup{$line}->{'namemap'} = {}; for my $chandata (values %{$lineup{$line}->{'channels'}}) { my $name = $chandata->{'name'}; for my $subname (split / \/ /, $name) { $lineup{$line}->{'namemap'}->{$subname} = $chandata; } } $lineup{$line}->{'unique'} = {}; } my %chanCount; for $line (keys %lineup) { for my $chan (keys %{$lineup{$line}->{'namemap'}}) { $chanCount{$chan}++; } } for $line (keys %lineup) { for my $chan (sort { $a cmp $b } keys %{$lineup{$line}->{'namemap'}}) { if ($chanCount{$chan} == 1) { if ($verbose) { print "$line: $chan is unique to lineup\n"; } $lineup{$line}->{'unique'}->{$chan} = 1; } } } $sources = myth_getsources(); @allSources = (); for my $sourceid (sort { $a <=> $b } keys %$sources) { my $line; my $bestScore = -1000000; my $bestLine = undef; my %justSourceChans = map { $myth->{$_}->{'name'} => $myth->{$_} } grep { $myth->{$_}->{'sourceid'} == $sourceid } keys %$myth; if (keys %justSourceChans == 0) { print "No channels exist for source $sourceid ('$sources->{$sourceid}->{'name'}')\n"; next; } # Now we know channels exist, we put it in our array push @allSources, $sourceid; for $line (keys %lineup) { my $namemap = $lineup{$line}->{'namemap'}; my $unique = $lineup{$line}->{'unique'}; my $requireHit = 0; my $requireMiss = 0; my $uniqueHit = 0; my $uniqueMiss = 0; for my $name (keys %$namemap) { if (defined $justSourceChans{$name}) { $requireHit++; $uniqueHit++ if (defined $unique->{$name}); } else { $requireMiss++; $uniqueMiss++ if (defined $unique->{$name}); } } my $score = $requireHit - $requireMiss + $uniqueHit*2 - $uniqueHit*2; if ($verbose) { print "Source $sourceid: $line: +$requireHit-$requireMiss / " . "+$uniqueHit-$uniqueMiss : $score\n"; } if ($score > $bestScore) { $bestScore = $score; $bestLine = $line; } } print "Source $sourceid: $sources->{$sourceid}->{'name'}: $bestLine\n"; push @{$lineup{$bestLine}->{'sourceList'}}, $sourceid; } } sub callsign_fromname { my ($name) = @_; $name =~ s/^(.*?) \/ .*$/$1/; $name =~ s/ +\+ 1 /+1/; return $name; } # Apply changes to an existing list sub changes_apply { my ($changes, $oldChan) = @_; my %newChan; for my $name (sort keys %$oldChan) { my %newHash = %{$oldChan->{$name}}; if (defined $changes && defined $changes->{$name}) { my $change = $changes->{$name}; #print "To '$name':'$newHash{'name'}':\n"; for my $key (keys %$change) { if (defined $change->{$key}) { #print " '$key' => '$change->{$key}'\n"; $newHash{$key} = $change->{$key}; } else { #print " '$key' => deleted\n"; delete $newHash{$key}; } } } if (defined $newHash{'id'}) { $newChan{$name} = \%newHash; } } return \%newChan; } sub names_standardisename { my ($name) = @_; my $change = 1; my $count = 0; while ($change) { $change = $name; while (my ($from, $to) = each %nameStandards) { $name =~ s/$from/$to/ig; if (length($to) > 2) { if ($to !~ /[^A-Za-z 0-9\-]/) { if ($from !~ /[\^\$]/) { $name =~ s/$to/$to/ig; # will correct case differences } else { $name =~ s/^$to/$to/ig; # will correct case differences at start } } } } $change = ($change ne $name); $count++; if ($count > 10) { die "Had a problem standardising with '$chandata->{'name'}'\n"; } } # Trim leading and trailing spaces and reduce multiple spaces $name =~ s/^ +//; $name =~ s/ +$//; $name =~ s/ +/ /g; return $name; } sub names_standardise { my ($channels) = @_; my (%changes); for my $channel (sort keys %$channels) { my $chandata = $channels->{$channel}; my $name = $chandata->{'name'}; my @list = split / \/ /, $name; for $_ (@list) { #print "$name: $_ : "; $_ = names_standardisename($_); #print "$_\n"; } $name = join " / ", @list; if ($name ne $chandata->{'name'}) { $changes{$channel} = { 'name' => $name }; #print "Change $chandata->{'name'} -> $name\n"; } } return \%changes; } sub names_canonicalise { my ($name) = @_; $name =~ tr/A-Z/a-z/; $name =~ s/ TV$//; $name =~ s/[ \-\(\)\.']//g; # Strip 's and things return $name; } # Check for similar items sub names_checksimilar { my ($check, $one, $two) = @_; print "> Checking similarities between $check\n" if ($verbose); $changes = names_reportsimilar($myth, $freesat); if (%$changes > 0) { print "\nDifferences in $check naming:\n"; print Dumper($changes); return 1; } return 0; } sub names_reportsimilar { my ($one, $two) = @_; my (%changes); my (%oneK); # Get keys for all 'one' names for my $chan (sort keys %$one) { my $name = $one->{$chan}->{'name'}; my @list = split / \/ /, $name; for (@list) { my $key = names_canonicalise($_); $oneK{$key} = [] if (!defined $oneK{$key}); push @{$oneK{$key}}, $_; } } # Now check against all the 'two' names for those # that don't match for my $chan (sort keys %$two) { my $names = $two->{$chan}->{'name'}; for my $name2 (split / \/ /, $names) { my $key = names_canonicalise($name2); my $chan1list = $oneK{$key}; next if (!defined $chan1list); for my $name1 (@$chan1list) { if ($name1 ne $name2) { $changes{$key} = { $name1 => $name2 }; } } } } return \%changes; } sub names_reportduplicates { my ($one) = @_; my (%changes); my (%oneK); # Get keys for all 'one' names for my $chan (grep { $one->{$_}->{'visible'} } sort keys %$one) { my $chandata = $one->{$chan}; my $name = $chandata->{'name'}; if (defined $oneK{$name}) { $changes{$chan} = { 'id' => $oneK{$name}->{'id'}, 'name' => $name }; } $oneK{$name} = $chandata; } return \%changes; } sub xmltv_setid { my ($xmltv, $channels) = @_; my %xmltvChan; my %changes; %xmltvChan = map { $_->{'name'} => $_ } values %$xmltv; #print map { "> $_\n" } sort keys %xmltvChan; for my $id (sort keys %$channels) { my $chan = $channels->{$id}; my $name = $chan->{'name'}; if (!defined $xmltvChan{$name}) { for my $equiv (sort { length $b <=> length $a } keys %xmltvEquivilent) { if ($name =~ /$equiv/) { #print "Change: $name -> $xmltvEquivilent{$equiv}\n"; $name = $xmltvEquivilent{$equiv}; } } } next if (!defined $xmltvChan{$name} || !defined $xmltvChan{$name}->{'xmltvid'}); if ($chan->{'xmltvid'} ne $xmltvChan{$name}->{'xmltvid'} && $chan->{'visible'}) { #print "Change channel $name, $num from '$chan->{'xmltvid'}' to '$xmltvChan{$name}->{'xmltvid'}'\n"; $changes{$id} = { 'xmltvid' => $xmltvChan{$name}->{'xmltvid'} } ; } } return \%changes; } ## # Read the categories file for the channels sub categories_getchannels { my ($fh); my %channels; open($fh, "< categories.txt") || return \%channels; while (<$fh>) { chomp; if (/^([^#].+?): *(.*?)\r?$/) { my $category = $1; my $name = $2; my %hash; $hash{'id'} = $name; $hash{'name'} = $name; $hash{'category'} = $category; $channels{$name} = \%hash; } } close($fh); return \%channels; } # List all the categories sub categories_list { my ($categories) = @_; my %cats = map { $_->{'category'} => $_ } values %$categories; print map { " $_\n" } sort keys %cats; } # Find all the matching categories and call a functionfor them sub categories_findcategory { my ($categories, $category, $myth, $func, $priv) = @_; my %cats = map { $_->{'id'} => $_ } grep { lc($_->{'category'}) eq lc($category) || $category eq '*' } values %$categories; my $chan; my %chanMap; for $chan (values %$myth) { my $name = $chan->{'name'}; $chanMap{$name} = [] if (!defined $chanMap{$name}); push @{$chanMap{$name}}, $chan; } for my $id (sort keys %cats) { my $name; $name = $cats{$id}->{'name'}; my @list; @list = defined($chanMap{$name}) ? @{$chanMap{$name}} : (undef); for $chan (@list) { &$func($priv, $chan, $name); } $name = "$name +1"; if (defined $chanMap{$name}) { @list = defined($chanMap{$name}) ? @{$chanMap{$name}} : (undef); for $chan (@list) { &$func($priv, $chan, $name); } } } } # List all the channels that match a category sub categories_listcategory { my ($categories, $category, $myth) = @_; categories_findcategory($categories, $category, $myth, sub { my ($priv, $chan, $name) = @_; printf "%7s %s%s\n", defined $chan ? $chan->{'num'} : '', $name, defined $chan ? ($chan->{'visible'} ? '' : ' [hid]') : ''; }, undef); } # Hide (or unhide) a given category list sub categories_hide { my ($categories, $myth, $hide, @catList) = @_; my $visible = $hide ? 0 : 1; my %changes; for my $category (@catList) { categories_findcategory($categories, $category, $myth, sub { my ($priv, $chan, $name) = @_; if (defined $chan) { if ($chan->{'visible'} != $visible) { printf "%s channel %s (%s)\n", $visible ? "Unhide" : "Hide", $chan->{'name'}, $chan->{'num'}; $priv->{$chan->{'id'}} = { 'visible' => $visible }; } } }, \%changes); } return \%changes; } # Reset any channels which haven't got valid names # @param[in] $delete 1 to delete, 0 to just renumber sub channels_validate { my ($chans, $delete) = @_; my (@usednums) = map { $_->{'num'} } values %$chans; my ($maxnum); my (%changes); # Find the highest number so we can use that for remapping $maxnum = 0; for (@usednums) { if (/(\d+)/ && $1 > $maxnum) { $maxnum = $1; } } print "Maximum channel number used: $maxnum\n" if ($verbose); for my $chan (values %$chans) { if ($chan->{'num'} !~ /^(\d+)/) { print "Channel ID $chan->{'id'} ($chan->{'name'}) has no number ($chan->{'num'})\n"; if ($delete) { $changes{$chan->{'id'}} = { 'id' => undef }; } else { $changes{$chan->{'id'}} = { 'num' => ++$maxnum }; } } } return \%changes; } # Line up the channels from myth with those from our source sub channels_align { my ($myth, $sources, $sourceid, $base, $limit, $prefix, $suffix) = @_; my (%changes); $prefix = "" if (!defined $prefix); $suffix = "" if (!defined $suffix); $base= 0 if (!defined $base); $limit= $base+1000 if (!defined $limit); my %sourceName; for my $source (values %$sources) { my @list = split / \/ /, $source->{'name'}; for (@list) { $sourceName{$_} = $source; } } # my %sourceName = map { $_->{'name'} => $_ } values %$sources; #print "Sources:\n", map { " $_\n" } sort keys %sourceName; #print "SourceIDs:\n", map { " $_\n" } sort keys %$sources; # Work out what channels we actually have my %realChan; my %inverseRegionals = map { $regions{$_} => $_ } keys %regions; my @mapout; for my $id (sort { my ($an) = ($myth->{$a}->{'num'} =~ /(\d+)/); my ($bn) = ($myth->{$b}->{'num'} =~ /(\d+)/); $an <=> $bn || $myth->{$a}->{'num'} cmp $myth->{$b}->{'num'} } keys %$myth) { my $chan = $myth->{$id}; my $num = $chan->{'num'}; my $name = $chan->{'name'}; my $sname = $name; next if ($chan->{'sourceid'} != $sourceid); if (defined $inverseRegionals{$name}) { # This is one of our regionals that we need to (notionally) rename $name = $inverseRegionals{$name}; } if ($verbose) { print "Check channel $num ($name): "; print "[hid] " if (!$chan->{'visible'}); } if (!defined $sourceName{$name}) { if ($verbose) { print "Not known - "; } # It doesn't exist in our sources, we need to move it # out if it's in our range. if ($num =~ /(\d+)/) { if ($1 > $base && $1 < $limit) { # It's in our range, we need to move it push @mapout, $chan->{'id'}; if ($verbose) { print "Need to move out\n"; } } else { if ($verbose) { print "Ok\n"; } } } else { die "I don't understand channel '$num': '$name', it's not a number\n"; } next; } $sname = $sourceName{$name}->{'name'}; if (!defined $realChan{$sname}) { # Didn't exist, so we put it where it's meant to be $realChan{$sname} = $chan; if ($verbose) { print "Real channel ('$prefix" . ($base + $sourceName{$name}->{'num'}) . "$suffix'='$sname')\n"; } } else { if ($verbose) { print "Real duplicate channel - "; } # It exists. Does the new one live in our range of numbers ? if ($num =~ /(\d+)/) { if ($num > $base && $num < $limit) { # It's in our range; keep the old one and move this out push @mapout, $chan->{'id'}; if ($verbose) { print "Moving this one out\n"; } } else { # It's outside the range, we should map it out #push @mapout, $num; if ($verbose) { print "Ok\n"; } } } else { # It's not a numbered channel. Uh. Ok. die "I don't understand channel '$num': '$name', it's not a number\n"; } } } # Look for missing channels for my $schan (sort { $a->{'num'} <=> $b->{'num'} } values %$sources) { my $name = $schan->{'name'}; if (!defined $realChan{$name}) { # This is printed all the time because it might mean that # the channels need rescanning. print "Channel $schan->{'num'} ('$name') not found\n"; } } # Look for mis-mapped channels for my $schan (sort { $a->{'num'} <=> $b->{'num'} } values %$sources) { my $name = $schan->{'name'}; if (defined $realChan{$name}) { my $chan = $realChan{$name}; my $num = $prefix . ($base + $schan->{'num'}) . $suffix; my $inRange = 0; my $remap = 0; if ($num ne $chan->{'num'}) { print "Channel $chan->{'num'} ('$chan->{'name'}') needs moving to $num\n"; $changes{$chan->{'id'}} = { 'num' => $num }; } } } # Now move out the channels that we identified as being # positioned improperly. my $unknowns = 0; my %usedChanNums = map { $_->{'channum'} => $_ } values %$myth; for (@mapout) { my $newName; do { $newName = $prefix . ($limit + $unknowns++) . $suffix; } while (defined $usedChanNums{$newName}); $changes{$_} = { 'num' => $newName }; } return \%changes; } sub channels_reduceregionals { my ($channels) = @_; my %keepers; my %changes; for my $id (keys %$channels) { my $chan = $channels->{$id}; my $name = $chan->{'name'}; my $num = $chan->{'num'}; if (grep { $chan->{'sourceid'} == $_ } @sources_freeview) { # This is a freeview channel so it is implicitly # given the regional name for my $regName (keys %regions) { if ($chan->{'name'} eq $regName) { $changes{$id} = { 'name' => $regions{$regName} }; } } } for my $regName (keys %regionalNames) { my $regChannels = $regionalNames{$regName}; for my $regChan (@$regChannels) { if ($regChan eq $name) { # Regional channel found # Are we keeping it ? if (defined $regions{$regName}) { if ($regChan eq $regions{$regName}) { print "Regional $regName: Keeping $num: $name\n" if ($verbose); # It's our preferred regional channel $keepers{$regName} = $chan; if (!defined $regionalCallSign{$regName}) { die "No regional callsign defined for $regName"; } if ($chan->{'callsign'} ne $regionalCallSign{$regName} || $chan->{'visible'} == 0) { $changes{$id} = { 'callsign' => $regionalCallSign{$regName}, 'visible' => 1 }; }; } else { # Mark as deletable if ($chan->{'visible'}) { print "Regional $regName: Losing $num: $name\n" if ($verbose); if ($deleteRegionals) { $changes{$id} = { 'id' => undef }; } else { $changes{$id} = { 'visible' => 0 }; } } # Also replace the callsign with a different one if it matches # the regular one. if ($chan->{'callsign'} eq callsign_fromname($regName)) { $changes{$id}->{'callsign'} = callsign_fromname($name); } } } else { # They didn't set anything, so we keep the channel } } } } } # Check that we got all the channels we need to keep for my $name (keys %regions) { if (!defined $keepers{$name}) { # Not necessarily a failure - freeview for example doesn't have # regional variations because it's already part of the signal. print "No channel definition exists for $name ('$regions{$name}')\n"; } } return \%changes; } sub channels_checkcallsigns { my ($chans) = @_; my %byName; my %changes; for my $id (sort keys %$chans) { my $chan = $chans->{$id}; my $name = $chan->{'name'}; next if ($name eq ''); if (!defined $byName{$name}) { $byName{$name} = $chan; } else { my $chan2 = $byName{$name}; my $callsign2 = $chan2->{'callsign'}; my $callsign1 = $chan->{'callsign'}; if ($callsign1 ne $callsign2) { # The callsigns don't match print "Mismatch: Chan $chan->{'num'}, $chan2->{'num'}: " . "'$callsign1' != '$callsign2' for '$name'\n"; # Update the second to match the first $changes{$chan->{'id'}} = { 'callsign' => $callsign2 }; } else { #print "Match: Chan $chan->{'num'}, $chan2->{'num'}: '$callsign1' == '$callsign2' for '$name'\n"; } } } return \%changes; } sub channels_listchannels { my ($canon, $sources, $sourceList, $basechan) = @_; my @sourcesOrdered = (); my @canonOrdered; my %sourceidHash; for (0..@$sourceList-1) { push @sourcesOrdered, {}; $sourceidHash{$sourceList->[$_]} = $_; } for my $chandata (values %$myth) { my $sourceid = $chandata->{'sourceid'}; my $sourceindex = $sourceidHash{$sourceid}; my $sourcehash = $sourcesOrdered[$sourceindex]; my $channum = $chandata->{'num'}; next if (!defined $sourceindex); # not one of our sources next if ($channum !~ /(\d+)/); # No number; not listed my $num = $1; $num = $num - ($basechan + $sourceindex * $basechan_separation); $num += 100000 if ($num < 0); $chandata->{'sourceoffset'} = $num; $sourcehash->{$num} = $chandata; } for (0..@$sourceList-1) { my $hash = $sourcesOrdered[$_]; my @array = map { $hash->{$_} } sort { $a <=> $b } keys %$hash; $sourcesOrdered[$_] = \@array; } @canonOrdered = map { $canon->{$_} } sort { $a <=> $b } keys %$canon; #print "Ordered canonical:\n", map { " $_\n" } @canonOrdered; #print "Keys canonical:\n", map { " $_\n" } keys %$canon; my $format = "%-16.16s | " x (@sourcesOrdered + 1); printf "| %6s | $format\n", "Chan#", "Canonical", map { "$_->[0]->{'sourceid'}: $_->[0]->{'sourceidname'}" } @sourcesOrdered; print "+--------+" . (("-" x 18 . '+') x (@sourcesOrdered+1)) . "\n"; while (1) { my $lowest = 1000000000; $lowest = $canonOrdered[0]->{'num'} if (defined $canonOrdered[0]); for (@sourcesOrdered) { if (defined $_->[0] && $_->[0]->{'sourceoffset'} < $lowest) { $lowest = $_->[0]->{'sourceoffset'}; } } if ($lowest == 1000000000) { last; } my @list; if (defined $canonOrdered[0] && $canonOrdered[0]->{'num'} == $lowest) { push @list, shift @canonOrdered; } else { push @list, undef; } for (@sourcesOrdered) { if (defined $_->[0] && $_->[0]->{'sourceoffset'} == $lowest) { push @list, shift @{$_}; } else { push @list, undef; } } my $format = "%-16.16s | " x (@sourcesOrdered + 1); printf "| %6d | $format\n", $lowest, map { defined($_) ? ($_->{'visible'} ? ' ' : '-') . $_->{'name'} : "" } @list; } }
/g; $chunk =~ s/[\n ]+//g; $chunk =~ s///g; $chunk =~ s/\n+/ /g; $chunk =~ s/\r+/ /g; $chunk =~ s/ + +/>/g; my @rows = split /
/, $row; next if ($td[1] !~ /^(\d+)/); my $num = $1; next if ($td[3] !~ /^(.*?)<\/span>/); my $name = $1; $hash{'name'} = $name; $hash{'num'} = $num; $hash{'id'} = $num; $hash{'visible'} = 1; # There might be duplicates because of different # regional or timing channels. if (defined $chan{$num}) { %hash = %{$chan{$num}}; if (!defined $hash{'callsign'}) { $hash{'callsign'} = callsign_fromname($hash{'name'}); } if (0 == grep { $_ eq $name } split " / ", $hash{'name'}) { $hash{'name'} .= " / $name"; } } $hash{'multiplex'} = $multiplex; if ($td[2] =~ /src="(.*?)"/) { my $url = $1; if ($url !~ /\/blank.gif/) { if (!defined $hash{'logo'}) { $hash{'logo'} = $url; } } } if ($td[3] =~ /href="(.*?)"/) { my $url = $1; if ($url !~ /\/blank.gif/) { if (!defined $hash{'website'}) { $hash{'website'} = $url; } } } $chan{$num} = \%hash; } } if (0 == keys %chan) { die "No freeview channels known\n"; } return \%chan; } sub freeview2_getchannels { my %chan; my $t; $t = web_getpage($page_freeview, $file_freeview); $t =~ s/\n+/ /g; $t =~ s/\r+/ /g; if ($t =~ /

Freeview Channel Lineup<\/h1>(.*)<\/table>/m) { $t = $1; while ($t =~ s/]+>(.*?)<\/font>/$1/g) {} $t =~ s/(.*?)<\/b>/$1/g; $t =~ s/

(.*?)<\/p>/$1/g; $t =~ s/

(.*?)<\/center>/$1/g; $t =~ s/]+>(.*?)<\/a>/$1/g; my (@rows) = ($t =~ /