| 2181 | | print "\n\nPopulating Channel Icons.\n\n"; |
| 2182 | | |
| 2183 | | -d "$CWD/icons" or mkdir "$CWD/icons" or die "Cannot create directory $CWD/icons: $!"; |
| 2184 | | &require_module("DBI"); |
| 2185 | | |
| 2186 | | print "In order to update channel icons, Shepherd will need to connect to your\n". |
| 2187 | | "MythTV backend database. Provide the database details below.\n". |
| 2188 | | "If you don't understand or know what these settings are set to, the chances\n". |
| 2189 | | "are you can simply accept the default values below.\n\n"; |
| 2190 | | |
| 2191 | | my $myth_host = ask("IP address of database backend [default: 127.0.0.1]: ") || "127.0.0.1"; |
| 2192 | | my $myth_db = ask("Database name [default: mythconverg]: ") || "mythconverg"; |
| 2193 | | my $myth_user = ask("Database username [default: mythtv]: ") || "mythtv"; |
| 2194 | | my $myth_pass = ask("Database password [default: mythtv]: ") || "mythtv"; |
| 2195 | | |
| 2196 | | # test database settings |
| 2197 | | print "\nConnecting to database ... "; |
| 2198 | | my $dbh; |
| 2199 | | die "Could not connect to database: $!\n" |
| 2200 | | if (!($dbh = DBI->connect("dbi:mysql:database=".$myth_db.":host=".$myth_host,$myth_user, $myth_pass))); |
| 2201 | | |
| 2202 | | # fetch icon styles |
| 2203 | | print "Done.\n\nFetching icon styles ... "; |
| 2204 | | my $icon_styles = fetch_file('http://www.whuffy.com/shepherd/logo_list.txt'); |
| 2205 | | exit(1) if (!$icon_styles); |
| 2206 | | |
| 2207 | | print "Done\n\n". |
| 2208 | | "There are (typically) multiple themes available for each channel.\n". |
| 2209 | | "For each channel you will be asked which theme graphic you'd like for\n". |
| 2210 | | "each channel icon\n". |
| 2211 | | "Aesthetically, you probably want all channel graphics sourced from a single\n". |
| 2212 | | "theme, but you can choose individual graphics for each if you choose.\n\n". |
| 2213 | | "The following themes are available. Please browse the URL of each theme\n". |
| 2214 | | "to see if you like the general style:\n\n". |
| 2215 | | " Theme Name Theme Description Theme Preview URL\n". |
| 2216 | | " ---------------- ------------------------------ ------------------------------\n"; |
| 2217 | | |
| 2218 | | my $t; |
| 2219 | | |
| 2220 | | foreach my $line (split/\n/,$icon_styles) { |
| 2221 | | if ($line =~ /^THEME\t(.*)\t(.*)\t(.*)$/) { |
| 2222 | | my ($theme_name, $theme_desc, $theme_preview_url) = ($1, $2, $3, $4); |
| 2223 | | printf " %-16s %-30s %s\n",$theme_name,$theme_desc,$theme_preview_url; |
| 2224 | | } elsif ($line =~ /^ICON\t(.*)\t(.*)\t(.*)$/) { |
| 2225 | | my ($ch, $ch_theme, $url) = ($1, $2, $3); |
| 2226 | | my $themename = "$ch_theme [$url]"; |
| 2227 | | $t->{ch}->{$ch}->{themes}->{$themename}->{url} = $url; |
| 2228 | | |
| 2229 | | $t->{ch}->{$ch}->{themes}->{$themename}->{fname} = $ch_theme."_".$ch; |
| 2230 | | if ($url =~ /\/([a-zA-Z0-9\.\_]+)$/) { |
| 2231 | | $t->{ch}->{$ch}->{themes}->{$themename}->{fname} = $ch_theme."_".$1; |
| 2232 | | } |
| 2233 | | |
| 2234 | | $t->{ch}->{$ch}->{first_theme} = $themename if (!defined $t->{ch}->{$ch}->{first_theme}); |
| 2235 | | $t->{ch}->{$ch}->{count}++; |
| 2236 | | } |
| 2237 | | } |
| 2238 | | |
| 2239 | | print "\nFor each channel, choose the icon theme you would like to use:\n"; |
| 2240 | | foreach my $ch (sort keys %{($t->{ch})}) { |
| 2241 | | next if ((!defined $channels->{$ch}) && (!defined $opt_channels->{$ch})); |
| 2242 | | my $xmlid = $channels->{$ch}; |
| 2243 | | $xmlid = $opt_channels->{$ch} if (defined $opt_channels->{$ch}); |
| 2244 | | |
| 2245 | | printf "\n\n$ch: [%s]\n",$xmlid; |
| 2246 | | |
| 2247 | | # verify that channel is in database |
| 2248 | | my ($chan_id,$curr_icon) = $dbh->selectrow_array("SELECT chanid,icon FROM channel WHERE xmltvid LIKE '".$xmlid."'"); |
| 2249 | | if (!$chan_id) { |
| 2250 | | print " Skipped - not in channels database.\n"; |
| 2251 | | next; |
| 2252 | | } else { |
| 2253 | | print "Icon currently set to: $curr_icon\n"; |
| 2254 | | } |
| 2255 | | |
| 2256 | | # let user choose the icon theme they want. if there is only one choice, choose it for them |
| 2257 | | my $chosen_theme = ""; |
| 2258 | | if (($t->{ch}->{$ch}->{count} == 1) && ($curr_icon eq "none")) { |
| 2259 | | $chosen_theme = $t->{ch}->{$ch}->{first_theme}; |
| 2260 | | print "Only one theme and icon not currently set, using: $chosen_theme\n"; |
| 2261 | | } else { |
| 2262 | | $chosen_theme = &XMLTV::Ask::ask_choice("Choose theme:", |
| 2263 | | ($curr_icon eq "none" ? $t->{ch}->{$ch}->{first_theme} : "current icon ($curr_icon)"), |
| 2264 | | "current icon ($curr_icon)", "none", |
| 2265 | | sort keys %{($t->{ch}->{$ch}->{themes})}); |
| 2266 | | } |
| 2267 | | |
| 2268 | | if (($chosen_theme ne "") && ($chosen_theme !~ /^current/)) { |
| 2269 | | my $fname; |
| 2270 | | if ($chosen_theme eq "none") { |
| 2271 | | $fname = "none"; |
| 2272 | | } else { |
| 2273 | | # always re-fetch icons even if we already had them. |
| 2274 | | # this simplifies the case if a download was corrupt. |
| 2275 | | my $url = $t->{ch}->{$ch}->{themes}->{$chosen_theme}->{url}; |
| 2276 | | $fname = "$CWD/icons/".$t->{ch}->{$ch}->{themes}->{$chosen_theme}->{fname}; |
| 2277 | | |
| 2278 | | print "Fetching $url .. "; |
| 2279 | | if (!(fetch_file($url, $fname, 1))) { |
| 2280 | | print "Failed.\n"; |
| 2281 | | next; |
| 2282 | | } |
| 2283 | | print "done.\n"; |
| 2284 | | } |
| 2285 | | |
| 2286 | | # update database |
| 2287 | | print "Updating database to $fname .. "; |
| 2288 | | $dbh->do("UPDATE channel SET icon='".$fname."' WHERE chanid LIKE $chan_id") || |
| 2289 | | die "could not update database channel icon: ".$dbh->errstr; |
| 2290 | | print "done.\n"; |
| 2291 | | } |
| 2292 | | } |
| 2293 | | |
| 2294 | | print "\n\nAll done.\n". |
| 2295 | | "You will need to restart both mythbackend and mythfrontend for any icon changes to appear.\n\n"; |
| | 2084 | use lib "references"; |
| | 2085 | require Shepherd::Configure; |
| | 2086 | &Shepherd::Configure::set_icons; |
| 2430 | | if ($opt->{configure} ne '1') |
| 2431 | | { |
| 2432 | | my $proggy = $opt->{configure}; |
| 2433 | | print "\nAttempting to configure \"$proggy\".\n"; |
| 2434 | | |
| 2435 | | unless ($components->{$proggy}) |
| 2436 | | { |
| 2437 | | print "Unknown component: \"$proggy\".\n"; |
| 2438 | | exit 0; |
| 2439 | | } |
| 2440 | | |
| 2441 | | my $progtype = $components->{$proggy}->{type}; |
| 2442 | | unless ($progtype eq 'grabber' or $progtype eq 'postprocessor' |
| 2443 | | or $progtype eq 'reconciler') |
| 2444 | | { |
| 2445 | | print "Cannot configure $progtype components.\n"; |
| 2446 | | exit 0; |
| 2447 | | } |
| 2448 | | |
| 2449 | | call_prog($proggy, query_filename($proggy, $progtype) . " ". query_config($proggy, 'option_config')); |
| 2450 | | |
| 2451 | | exit 0; |
| 2452 | | } |
| 2453 | | print "\nConfiguring.\n\n" . |
| 2454 | | "Step 1: Region Selection\n\nSelect your region:\n"; |
| 2455 | | foreach (sort { $REGIONS{$a} cmp $REGIONS{$b} } keys %REGIONS) |
| 2456 | | { |
| 2457 | | printf(" (%3d) %s\n", $_, $REGIONS{$_}); |
| 2458 | | } |
| 2459 | | $region = &XMLTV::Ask::ask_choice("Enter region code:", ($region || "94"), |
| 2460 | | keys %REGIONS); |
| 2461 | | |
| 2462 | | print "\nStep 2: Channel Selection\n\n"; |
| 2463 | | |
| 2464 | | print "Shepherd offers two methods of channel selection: Guided and Advanced.\n". |
| 2465 | | "Guided is easier; Advanced allows manual entering of XMLTV IDs.\n\n"; |
| 2466 | | |
| 2467 | | my $guided = &XMLTV::Ask::ask_boolean("Would you like Guided channel selection?", 1); |
| 2468 | | |
| 2469 | | my $mchans = &configure_channels_guided if ($guided); |
| 2470 | | &configure_channels_advanced unless ($mchans); |
| 2471 | | |
| 2472 | | print "\nStep 3: Transitioning\n\n". |
| 2473 | | "Would you like to transition seamlessly from your current grabber?\n\n". |
| 2474 | | "Different data sources can have different names for the same show. For\n". |
| 2475 | | "example, one grabber might call a show \"Spicks & Specks\" while another\n". |
| 2476 | | "calls it \"Spicks and Specks\". These differences can make MythTV think\n". |
| 2477 | | "they're actually different shows.\n\n". |
| 2478 | | ucfirst($progname) . " is able to merge these differences so that it always\n". |
| 2479 | | "presents shows with a consistent name, no matter where it actually sourced\n". |
| 2480 | | "show data from. If you'd like, it can also rename shows so they're consistent\n". |
| 2481 | | "with whichever grabber you've been using until now.\n\n". |
| 2482 | | "The advantage of this is that you should get a smoother transition to\n". |
| 2483 | | ucfirst($progname) . ", with no shows changing names and no need to re-create\n". |
| 2484 | | "any recording rules. The main disadvantage is that if your previous grabber\n". |
| 2485 | | "used an inferior data source -- i.e. it sometimes has typos or less\n". |
| 2486 | | "informative program names -- then you'll continue to see these.\n\n". |
| 2487 | | "If you were using one of the following grabbers previously AND you want\n". |
| 2488 | | ucfirst($progname) . " to use that grabber's program names, select it here.\n\n"; |
| 2489 | | |
| 2490 | | my $def = "Do not transition; just use best quality titles"; |
| 2491 | | my %transition = ( "ltd (aka tv_grab_au, versions 1,30, 1.40 or 1.41)" => 'yahoo7widget', |
| 2492 | | "OzTivo" => 'oztivo', |
| 2493 | | "Rex" => 'rex'); |
| 2494 | | my $defaulttrans = $def; |
| 2495 | | foreach my $key (keys %transition) { |
| 2496 | | $defaulttrans = $key if ((defined $pref_title_source) && ($transition{$key} eq $pref_title_source)); |
| 2497 | | } |
| 2498 | | my $pref = &XMLTV::Ask::ask_choice("Transition from grabber?", $defaulttrans, |
| 2499 | | $def, keys %transition); |
| 2500 | | $pref_title_source = $transition{$pref}; |
| 2501 | | |
| 2502 | | print "\n"; |
| 2503 | | &show_channels if (!$mchans); |
| 2504 | | &show_mythtv_mappings($debug, $mchans) if ($mchans); |
| 2505 | | |
| 2506 | | my $str = "Create configuration file"; |
| 2507 | | $str .= " and update MythTV" if ($mchans); |
| 2508 | | unless(&XMLTV::Ask::ask_boolean("\n$str?", 1)) |
| 2509 | | { |
| 2510 | | print "Aborting configuration.\n"; |
| 2511 | | exit 0; |
| 2512 | | } |
| 2513 | | $last_successful_run = undef; |
| 2514 | | |
| 2515 | | write_config_file(); |
| 2516 | | write_channels_file(); |
| 2517 | | &update_mythtv_channels($mchans) if ($mchans); |
| 2518 | | |
| 2519 | | print "Checking if any components require configuration.\n\n"; |
| 2520 | | ✓ |
| 2521 | | |
| 2522 | | print "Finished configuring.\n\n"; |
| 2523 | | |
| 2524 | | status(); |
| 2525 | | |
| 2526 | | print "\nShepherd is installed into $CWD.\n\n" . |
| 2527 | | "Run it as: $CWD/shepherd\n\n". |
| 2528 | | "MythTV users may wish to create the following symlink, by " . |
| 2529 | | "doing this (as root):\n" . |
| 2530 | | " \"ln -s $CWD/$progname /usr/bin/tv_grab_au\".\n\n"; |
| 2531 | | |
| 2532 | | if (&XMLTV::Ask::ask_boolean("\n\nShepherd can (optionally) install channel icons.\nDo you wish to do this now?")) { |
| 2533 | | &set_icons; |
| 2534 | | } |
| 2535 | | |
| 2536 | | print "\nIf you wish to add/change channel icons in future, you can call Shepherd with:\n". |
| 2537 | | " $CWD/$progname --set-icons\n\n"; |
| 2538 | | |
| 2539 | | unless (&XMLTV::Ask::ask_boolean("\nGrab data now?")) |
| 2540 | | { |
| 2541 | | exit 0; |
| 2542 | | } |
| 2543 | | } |
| 2544 | | |
| 2545 | | sub configure_channels_guided |
| 2546 | | { |
| 2547 | | my $mythids = &retrieve_mythtv_channels; |
| 2548 | | unless ($mythids) |
| 2549 | | { |
| 2550 | | print "\nUnable to retrieve list of MythTV channels.\n" . |
| 2551 | | "Guided channel selection is not available, now using Advanced.\n"; |
| 2552 | | return undef; |
| 2553 | | } |
| 2554 | | |
| 2555 | | print "\n* Guided Channel Selection *\n\n"; |
| 2556 | | |
| 2557 | | print "\nHigh Definition TV (HDTV)\n". |
| 2558 | | "Most Australian TV networks broadcast at least some\n". |
| 2559 | | "programmes in HDTV each week, but for the most part\n". |
| 2560 | | "either upsample SD to HD or play a rolling demonstration\n". |
| 2561 | | "HD clip when they don't have the programme in HD format.\n\n". |
| 2562 | | "If you have a HDTV capable system and are interested in\n". |
| 2563 | | "having Shepherd's postprocessors populate HDTV content\n". |
| 2564 | | "then Shepherd will need to know the XMLTV IDs for the HD\n". |
| 2565 | | "channels also. HD related SD channels are required.\n", |
| 2566 | | "The 7HD, Nine HD and TEN HD channels are populated\n", |
| 2567 | | "with programs from the first related SD channel.\n", |
| 2568 | | "$wiki/FAQ#MyhighdefinitionHDchannelsaremissingprograms\n"; |
| 2569 | | my $want_hdtv = &XMLTV::Ask::ask_boolean("Do you have High-Definition (HDTV)?"); |
| 2570 | | |
| 2571 | | my (@channellist, @hd_channellist, @paytv_channellist); |
| 2572 | | |
| 2573 | | @channellist = sort &read_official_channels($region); |
| 2574 | | $channels = { }; |
| 2575 | | $opt_channels = { }; |
| 2576 | | foreach (@channellist) |
| 2577 | | { |
| 2578 | | $channels->{$_} = undef; |
| 2579 | | } |
| 2580 | | |
| 2581 | | if ($want_hdtv) |
| 2582 | | { |
| 2583 | | @hd_channellist = grep(!/ABC2|SBS News|31/i, @channellist); |
| 2584 | | |
| 2585 | | #limit to ones in $channels (don't know so can't) and if 7HD remove 7HD and first 7 (don't know so do anyway) |
| 2586 | | foreach my $hdchannel (keys %$hd_to_sds) { |
| 2587 | | @hd_channellist = grep(!/^$hdchannel$/i, @hd_channellist); |
| 2588 | | my $oldlength = scalar @hd_channellist; |
| 2589 | | foreach my $sdchannel (@{$hd_to_sds->{$hdchannel}}) { |
| 2590 | | @hd_channellist = grep(!/^$sdchannel$/i, @hd_channellist); |
| 2591 | | if ($oldlength != scalar @hd_channellist) { # removed first |
| 2592 | | print "'$hdchannel' is going to be populated from '$sdchannel'\n"; |
| 2593 | | last; |
| 2594 | | } |
| 2595 | | } |
| 2596 | | } |
| 2597 | | |
| 2598 | | foreach (@hd_channellist) |
| 2599 | | { |
| 2600 | | $_.='HD'; |
| 2601 | | $opt_channels->{$_} = undef; |
| 2602 | | } |
| 2603 | | } |
| 2604 | | |
| 2605 | | my $want_paytv = &XMLTV::Ask::ask_boolean("\nDo you have PayTV?"); |
| 2606 | | if ($want_paytv) |
| 2607 | | { |
| 2608 | | $want_paytv = &XMLTV::Ask::ask_choice("Which PayTV provider do you have?", |
| 2609 | | $want_paytv_channels || "Foxtel", |
| 2610 | | ("Foxtel", "SelecTV")); |
| 2611 | | $want_paytv_channels = $want_paytv; |
| 2612 | | @paytv_channellist = &read_official_channels($want_paytv); |
| 2613 | | foreach (@paytv_channellist) |
| 2614 | | { |
| 2615 | | $opt_channels->{$_} = undef; |
| 2616 | | } |
| 2617 | | } |
| 2618 | | |
| 2619 | | my @sdchannels = (@channellist, @hd_channellist); |
| 2620 | | my @allchannels = (@sdchannels, @paytv_channellist); |
| 2621 | | my @paytvchannels = ((undef) x scalar(@sdchannels), (@paytv_channellist)); |
| 2622 | | |
| 2623 | | printf "\nYour MythTV has %d channels. Shepherd offers %d channels of guide\n". |
| 2624 | | "data for %s (%d free-to-air, %d HDTV, %d Pay-TV).\n\n". |
| 2625 | | "Please associate each MythTV channel with a Shepherd guide data\n". |
| 2626 | | "channel.\n\n", |
| 2627 | | scalar(keys %$mythids), |
| 2628 | | scalar(@allchannels), |
| 2629 | | $REGIONS{$region}, |
| 2630 | | scalar(@channellist), |
| 2631 | | scalar(@hd_channellist), |
| 2632 | | scalar(@paytv_channellist); |
| 2633 | | |
| 2634 | | my $display_mode = 0; |
| 2635 | | foreach my $ch (sort keys %$mythids) |
| 2636 | | { |
| 2637 | | my @table = $display_mode ? @paytvchannels : @sdchannels; |
| 2638 | | if ($want_paytv) |
| 2639 | | { |
| 2640 | | push @table, ($display_mode ? 'f:(Free to Air channel)' : 'p:(Pay TV channel)' ); |
| 2641 | | } |
| 2642 | | |
| 2643 | | &guided_configure_table(@table); |
| 2644 | | |
| 2645 | | my $mch = $mythids->{$ch}; |
| 2646 | | my $longname = $mch->{name}; |
| 2647 | | $longname .= " ($mch->{callsign})" if ($mch->{callsign} and lc($mch->{callsign}) ne lc($longname)); |
| 2648 | | |
| 2649 | | my $channum = $mch->{channum} || '-'; |
| 2650 | | printf "MythTV channel %s: %s ? ", |
| 2651 | | $channum, |
| 2652 | | $longname; |
| 2653 | | my $inp = <STDIN>; |
| 2654 | | chomp $inp; |
| 2655 | | if ($inp eq '?') |
| 2656 | | { |
| 2657 | | &guided_configure_help; |
| 2658 | | redo; |
| 2659 | | } |
| 2660 | | elsif ($inp eq 'f') |
| 2661 | | { |
| 2662 | | $display_mode = 0; |
| 2663 | | redo; |
| 2664 | | } |
| 2665 | | elsif ($inp eq 'p') |
| 2666 | | { |
| 2667 | | $display_mode = 1; |
| 2668 | | redo; |
| 2669 | | } |
| 2670 | | elsif ($inp =~ /\d+/) |
| 2671 | | { |
| 2672 | | my $xmltvid = ''; |
| 2673 | | if ($inp == 0) |
| 2674 | | { |
| 2675 | | print "$ch -> (no guide data)\n"; |
| 2676 | | } |
| 2677 | | else |
| 2678 | | { |
| 2679 | | $inp--; |
| 2680 | | my $target = $allchannels[$inp]; |
| 2681 | | unless ($target) |
| 2682 | | { |
| 2683 | | print "Unknown #: $inp\n"; |
| 2684 | | redo; |
| 2685 | | } |
| 2686 | | $xmltvid = lc "$target.shepherd.au"; |
| 2687 | | $xmltvid =~ s/ //g; |
| 2688 | | if ($inp < @channellist) |
| 2689 | | { |
| 2690 | | $channels->{$target} = $xmltvid; |
| 2691 | | } |
| 2692 | | else |
| 2693 | | { |
| 2694 | | $opt_channels->{$target} = $xmltvid; |
| 2695 | | } |
| 2696 | | print "$ch -> $allchannels[$inp].\n"; |
| 2697 | | } |
| 2698 | | $mythids->{$ch}->{xmltvid} = $xmltvid; |
| 2699 | | |
| 2700 | | } |
| 2701 | | else |
| 2702 | | { |
| 2703 | | print "Unknown selection. Please try again.\n"; |
| 2704 | | redo; |
| 2705 | | } |
| 2706 | | } |
| 2707 | | |
| 2708 | | foreach (keys %$opt_channels) |
| 2709 | | { |
| 2710 | | if (defined $opt_channels->{$_} && $_ =~ /HD$/) { |
| 2711 | | my $sd = $_; |
| 2712 | | $sd =~ s/HD$//; |
| 2713 | | if (!defined $channels->{$sd}) { |
| 2714 | | print "No corresponding SD channel for a HD channel. '$_' needs '$sd'. Please try again.\n"; |
| 2715 | | exit; |
| 2716 | | } |
| 2717 | | } |
| 2718 | | } |
| 2719 | | |
| 2720 | | foreach (keys %$channels) |
| 2721 | | { |
| 2722 | | delete $channels->{$_} unless defined $channels->{$_}; |
| 2723 | | } |
| 2724 | | foreach (keys %$opt_channels) |
| 2725 | | { |
| 2726 | | delete $opt_channels->{$_} unless defined $opt_channels->{$_}; |
| 2727 | | } |
| 2728 | | |
| 2729 | | &show_mythtv_mappings($debug, $mythids); |
| 2730 | | |
| 2731 | | print "\nIf you proceed to the end of configuration, Shepherd will\n" . |
| 2732 | | "write these channel mappings to MythTV.\n\n"; |
| 2733 | | |
| 2734 | | exit unless (&XMLTV::Ask::ask_boolean("Is this table correct? ", 1)); |
| 2735 | | |
| 2736 | | return $mythids; |
| 2737 | | } |
| 2738 | | |
| 2739 | | sub guided_configure_table |
| 2740 | | { |
| 2741 | | my @chs; |
| 2742 | | my $skip = 0; |
| 2743 | | foreach (@_) |
| 2744 | | { |
| 2745 | | if (defined $_) |
| 2746 | | { |
| 2747 | | push @chs, $_; |
| 2748 | | } |
| 2749 | | else |
| 2750 | | { |
| 2751 | | $skip++; |
| 2752 | | } |
| 2753 | | } |
| 2754 | | |
| 2755 | | @chs = ('(no guide)', @chs); |
| 2756 | | |
| 2757 | | my $half = int(scalar(@chs) / 2); |
| 2758 | | $half++ if (scalar(@chs) % 2); |
| 2759 | | |
| 2760 | | my $i = 0; |
| 2761 | | my $n; |
| 2762 | | my $str = ''; |
| 2763 | | while ($i < $half) |
| 2764 | | { |
| 2765 | | $n = $i; |
| 2766 | | $n += $skip if ($n); |
| 2767 | | my $selection = &guided_configure_table_entry($chs[$i], $n); |
| 2768 | | $selection .= &guided_configure_table_entry($chs[$i+$half], $n+$half) if ($i + $half < @chs); |
| 2769 | | $str .= "$selection\n"; |
| 2770 | | $i++; |
| 2771 | | } |
| 2772 | | print "Guide data sources:\n$str"; |
| 2773 | | } |
| 2774 | | |
| 2775 | | sub guided_configure_table_entry |
| 2776 | | { |
| 2777 | | my ($entry, $num) = @_; |
| 2778 | | if ($entry =~ /^(\w):(.*)/) |
| 2779 | | { |
| 2780 | | $num = $1; |
| 2781 | | $entry = $2; |
| 2782 | | } |
| 2783 | | return sprintf "(%2s) %-30s", $num, $entry; |
| 2784 | | } |
| 2785 | | |
| 2786 | | sub configure_channels_advanced |
| 2787 | | { |
| 2788 | | my @channellist = &read_official_channels($region); |
| 2789 | | |
| 2790 | | $channels = channel_selection("Free to Air", ".free.au", $channels, @channellist); |
| 2791 | | &check_channel_xmltvids; |
| 2792 | | |
| 2793 | | my $old_opt_channels = $opt_channels; |
| 2794 | | print "\nHigh Definition TV (HDTV)\n". |
| 2795 | | "Most Australian TV networks broadcast at least some\n". |
| 2796 | | "programmes in HDTV each week, but for the most part\n". |
| 2797 | | "either upsample SD to HD or play a rolling demonstration\n". |
| 2798 | | "HD clip when they don't have the programme in HD format.\n\n". |
| 2799 | | "If you have a HDTV capable system and are interested in\n". |
| 2800 | | "having Shepherd's postprocessors populate HDTV content\n". |
| 2801 | | "then Shepherd will need to know the XMLTV IDs for the HD\n". |
| 2802 | | "channels also. HD related SD channels are required.\n", |
| 2803 | | "The 7HD, Nine HD and TEN HD channels are populated\n", |
| 2804 | | "with programs from the first related SD channel.\n", |
| 2805 | | "$wiki/FAQ#MyhighdefinitionHDchannelsaremissingprograms\n"; |
| 2806 | | if (&XMLTV::Ask::ask_boolean("\nDo you wish to include HDTV channels?")) |
| 2807 | | { |
| 2808 | | #limit to ones in $channels and if 7HD remove 7HD and first 7 |
| 2809 | | my @hd_channellist = grep(!/ABC2|SBS News|31/i, keys %$channels); |
| 2810 | | |
| 2811 | | foreach my $hdchannel (keys %$hd_to_sds) { |
| 2812 | | my $oldlength = scalar @hd_channellist; |
| 2813 | | @hd_channellist = grep(!/^$hdchannel$/i, @hd_channellist); |
| 2814 | | next if ($oldlength == scalar @hd_channellist); # didn't remove |
| 2815 | | $oldlength = scalar @hd_channellist; |
| 2816 | | foreach my $sdchannel (@{$hd_to_sds->{$hdchannel}}) { |
| 2817 | | @hd_channellist = grep(!/^$sdchannel$/i, @hd_channellist); |
| 2818 | | if ($oldlength != scalar @hd_channellist) { # removed first |
| 2819 | | print "'$hdchannel' is going to be populated from '$sdchannel'\n"; |
| 2820 | | last; |
| 2821 | | } |
| 2822 | | } |
| 2823 | | } |
| 2824 | | |
| 2825 | | foreach (@hd_channellist) |
| 2826 | | { |
| 2827 | | $_ .= "HD"; |
| 2828 | | } |
| 2829 | | |
| 2830 | | $opt_channels = channel_selection("HDTV", ".hd.free.au", $old_opt_channels, @hd_channellist); |
| 2831 | | &check_channel_xmltvids; |
| 2832 | | } |
| 2833 | | else |
| 2834 | | { |
| 2835 | | $opt_channels = { }; |
| 2836 | | } |
| 2837 | | |
| 2838 | | if (&XMLTV::Ask::ask_boolean("\nDo you wish to include PayTV (e.g. Foxtel, SelecTV) channels?", defined $want_paytv_channels)) |
| 2839 | | { |
| 2840 | | $want_paytv_channels = &XMLTV::Ask::ask_choice("Which PayTV provider?", $want_paytv_channels || "Foxtel", ("Foxtel", "SelecTV")); |
| 2841 | | my @paytv_channellist = &read_official_channels($want_paytv_channels); |
| 2842 | | my $paytv = channel_selection("Pay TV", ".paytv.au", $old_opt_channels, @paytv_channellist); |
| 2843 | | if (keys %$paytv) { |
| 2844 | | $opt_channels = { %$opt_channels, %$paytv }; |
| 2845 | | } else { |
| 2846 | | $want_paytv_channels = undef; |
| 2847 | | } |
| 2848 | | &check_channel_xmltvids; |
| 2849 | | } |
| 2850 | | else |
| 2851 | | { |
| 2852 | | $want_paytv_channels = undef; |
| 2853 | | } |
| 2854 | | } |
| 2855 | | |
| 2856 | | # Sourced from YourTV |
| 2857 | | sub fetch_regions |
| 2858 | | { |
| 2859 | | my ($reg, $shh) = @_; |
| 2860 | | |
| 2861 | | &log("Fetching free-to-air region information...\n") unless ($shh); |
| 2862 | | |
| 2863 | | # Download list |
| 2864 | | my $ua = LWP::UserAgent->new(); |
| 2865 | | $ua->env_proxy; |
| 2866 | | $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322'); |
| 2867 | | $ua->cookie_jar({}); |
| 2868 | | $ua->get('http://www.yourtv.com.au'); |
| 2869 | | my $response = $ua->get('http://www.yourtv.com.au/?'); |
| 2870 | | |
| 2871 | | my $page = $response->content; |
| 2872 | | die "Unable to download region list page" if ($response->is_error()); |
| 2873 | | |
| 2874 | | die "Unable to parse region list" if (!($page =~ /<select[^>]*fta_region_id[^>]*>(.*?)<\/select>/is)); |
| 2875 | | my $regions = $1; |
| 2876 | | |
| 2877 | | my %regions; |
| 2878 | | while ($regions =~ /value.*?(\d+).*?>(.*?)(<|$)/sg) { |
| 2879 | | my ($num, $name) = ($1, $2); |
| 2880 | | $name =~ s/^\s+//s; |
| 2881 | | $name =~ s/\s+$//s; |
| 2882 | | $name =~ s/\s+/ /gs; |
| 2883 | | $name =~ s/ -/:/; |
| 2884 | | |
| 2885 | | $regions{$num} = $name; |
| 2886 | | #printf "Downloaded %d %s\n", $num, $name; |
| 2887 | | } |
| 2888 | | |
| 2889 | | my %REGIONSLOCAL = %REGIONS; |
| 2890 | | my %regionslocal = %regions; |
| 2891 | | foreach my $num (keys %regionslocal) { |
| 2892 | | #printf "Checking %d %s\n", $num, $regions{$num}; |
| 2893 | | if (!defined($REGIONSLOCAL{$num}) || $REGIONS{$num} ne $regions{$num}) { |
| 2894 | | #printf "Missing %d %s\n", $num, $regions{$num}; |
| 2895 | | } else { |
| 2896 | | delete $REGIONSLOCAL{$num}; |
| 2897 | | delete $regionslocal{$num}; |
| 2898 | | } |
| 2899 | | } |
| 2900 | | |
| 2901 | | if ((scalar(keys %REGIONSLOCAL) != 0) || (scalar(keys %regionslocal) != 0)) { |
| 2902 | | print "old regions not matched:\n"; |
| 2903 | | foreach (sort { $REGIONSLOCAL{$a} cmp $REGIONSLOCAL{$b} } keys %REGIONSLOCAL) { |
| 2904 | | printf(" %3d %s\n", $_, $REGIONSLOCAL{$_}); |
| 2905 | | } |
| 2906 | | print "new regions not matched:\n"; |
| 2907 | | foreach (sort { $regionslocal{$a} cmp $regionslocal{$b} } keys %regionslocal) { |
| 2908 | | printf(" %3d %s\n", $_, $regionslocal{$_}); |
| 2909 | | } |
| 2910 | | print "new region list:\n"; |
| 2911 | | my $count = 0; |
| 2912 | | print "\tmy %REGIONS = ("; |
| 2913 | | foreach (sort { $a <=> $b } keys %regions) { |
| 2914 | | if ($count%3 == 0) { |
| 2915 | | print"\n\t\t"; |
| 2916 | | } else { |
| 2917 | | print"\t"; |
| 2918 | | } |
| 2919 | | printf('%d => "%s",', $_, $regions{$_}); |
| 2920 | | $count+=1; |
| 2921 | | } |
| 2922 | | print ");\n"; |
| 2923 | | } |
| 2924 | | } |
| 2925 | | |
| 2926 | | # Sourced from YourTV |
| 2927 | | sub fetch_channels |
| 2928 | | { |
| 2929 | | my ($reg, $shh) = @_; |
| 2930 | | |
| 2931 | | &log("Fetching free-to-air channel information...\n") unless ($shh); |
| 2932 | | |
| 2933 | | # Download list |
| 2934 | | my $ua = LWP::UserAgent->new(); |
| 2935 | | $ua->env_proxy; |
| 2936 | | $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322'); |
| 2937 | | $ua->cookie_jar({}); |
| 2938 | | $ua->get('http://www.yourtv.com.au'); |
| 2939 | | my $response = $ua->get('http://www.yourtv.com.au/profile/ajax.cfm?action=channels®ion_id='.$reg); |
| 2940 | | |
| 2941 | | my $page = $response->content; |
| 2942 | | die "Unable to download channel list" if ($response->is_error()); |
| 2943 | | |
| 2944 | | # Rules for Station Names: |
| 2945 | | # Station names are comprised of the channel name (eg "Seven") and an |
| 2946 | | # optional regional qualifier in brackets (eg "(Cairns/Rockhampton)"). |
| 2947 | | # Station names shall not contain a regional qualifer unless |
| 2948 | | # necessary to distinguish between identical channel names in |
| 2949 | | # the same region; in this case, a regional qualifier shall always |
| 2950 | | # be included. In the absence of anything better, the region name |
| 2951 | | # (eg "NSW: Regional NSW") is used as the regional qualifier. |
| 2952 | | my (@channellist, $clist, $cn, $rq); |
| 2953 | | while ($page =~ /<label for="venue_id.*?>(.*?)<\/label>/sg) |
| 2954 | | { |
| 2955 | | my $channel = $1; |
| 2956 | | $channel =~ s/\s{2,}//g; |
| 2957 | | if ($channel =~ /(.*) (\(.*\))/) |
| 2958 | | { |
| 2959 | | ($cn, $rq) = ($1, $2); |
| 2960 | | } |
| 2961 | | else |
| 2962 | | { |
| 2963 | | $cn = $channel; |
| 2964 | | $rq = ''; |
| 2965 | | } |
| 2966 | | # Is there already a channel with this name? |
| 2967 | | if ($clist->{$cn}) |
| 2968 | | { |
| 2969 | | # Set regional qualifier for existing station if not already set |
| 2970 | | if (@{$clist->{$cn}} == 1 and $clist->{$cn}[0] eq '') |
| 2971 | | { |
| 2972 | | $clist->{$cn} = [ "(".$REGIONS{$reg}.")" ]; |
| 2973 | | } |
| 2974 | | $rq = $REGIONS{$reg} if ($rq eq ''); |
| 2975 | | die "Bad channel list in region $reg!" if (grep($rq eq $_, @{$clist->{$cn}})); |
| 2976 | | push @{$clist->{$cn}}, $rq; |
| 2977 | | } |
| 2978 | | else |
| 2979 | | { |
| 2980 | | $clist->{$cn} = [ $rq ]; |
| 2981 | | } |
| 2982 | | } |
| 2983 | | foreach $cn (keys %$clist) |
| 2984 | | { |
| 2985 | | if (@{$clist->{$cn}} == 1) |
| 2986 | | { |
| 2987 | | push @channellist, $cn; |
| 2988 | | } |
| 2989 | | else |
| 2990 | | { |
| 2991 | | foreach $rq (@{$clist->{$cn}}) |
| 2992 | | { |
| 2993 | | push @channellist, "$cn $rq"; |
| 2994 | | } |
| 2995 | | } |
| 2996 | | } |
| 2997 | | return @channellist; |
| 2998 | | } |
| 2999 | | |
| 3000 | | sub fetch_channels_foxtel |
| 3001 | | { |
| 3002 | | my $shh = shift; |
| 3003 | | &log("Fetching PayTV channel information...\n") unless ($shh); |
| 3004 | | |
| 3005 | | my $ua = LWP::UserAgent->new(); |
| 3006 | | $ua->env_proxy; |
| 3007 | | $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322'); |
| 3008 | | $ua->cookie_jar({}); |
| 3009 | | my $response = $ua->get('http://www.foxtel.com.au/channel/lineup.html'); |
| 3010 | | |
| 3011 | | my $page = $response->content; |
| 3012 | | die "Unable to download channel list" if ($response->is_error()); |
| 3013 | | |
| 3014 | | my @channellist; |
| 3015 | | while ($page =~ /<option value="\/channel\/.*?>(.*?)<\/option>/sg) |
| 3016 | | { |
| 3017 | | my $ch = $1; |
| 3018 | | $ch =~ s/[ \t()\[\]\+\.\-]//g; # remove special chars |
| 3019 | | $ch =~ s/(&|&)/and/g; # & to and |
| 3020 | | $ch =~ s|[/,].*||; # and deleting after / or , |
| 3021 | | |
| 3022 | | push @channellist,$ch; |
| 3023 | | } |
| 3024 | | |
| 3025 | | return @channellist; |
| 3026 | | } |
| 3027 | | |
| 3028 | | sub fetch_channels_selectv |
| 3029 | | { |
| 3030 | | my $shh = shift; |
| 3031 | | &log("Fetching PayTV channel information...\n") unless ($shh); |
| 3032 | | |
| 3033 | | my $ua = LWP::UserAgent->new(); |
| 3034 | | $ua->env_proxy; |
| 3035 | | $ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322'); |
| 3036 | | $ua->cookie_jar({}); |
| 3037 | | my $response = $ua->get('http://www.selectv.com/go/tv-guide'); |
| 3038 | | |
| 3039 | | my $page = $response->content; |
| 3040 | | die "Unable to download channel list" if ($response->is_error()); |
| 3041 | | |
| 3042 | | my @channellist; |
| 3043 | | while ($page =~ /<option value=".*?">(.*?)<\/option>/sg) |
| 3044 | | { |
| 3045 | | my $ch = $1; |
| 3046 | | $ch =~ s/[ \t()\[\]\+\.\-]//g; # remove special chars |
| 3047 | | $ch =~ s/(&|&)/and/g; # & to and |
| 3048 | | $ch =~ s|[/,].*||; # and deleting after / or , |
| 3049 | | |
| 3050 | | # also in selectv_website |
| 3051 | | my %SelecTV_to_Foxtel = ( |
| 3052 | | "AnimalPlanet" => "AnimalPlanet", |
| 3053 | | "AntennaGreek" => "AntennaGreek", # SelecTV only |
| 3054 | | "BBCWorld" => "BBCWorld", |
| 3055 | | "CartoonNetwork" => "CartoonNetwork", |
| 3056 | | "CNNI" => "CNN", # rename |
| 3057 | | "DiscoveryScience" => "DiscoveryScience", |
| 3058 | | "DiscoveryHomeandHealth" => "DiscoveryHealth", # rename |
| 3059 | | "DiscoveryTravelandLiving" => "DiscoveryTravel",# rename |
| 3060 | | "DiscoveryRealTime" => "DiscoveryRealTime", # SelecTV and OzTivo |
| 3061 | | "E!Entertainment" => "E!Entertainment", |
| 3062 | | "ERTGreek" => "ERTGreek", # SelecTV only |
| 3063 | | "Eurosport" => "Eurosport", # SelecTV and OzTivo |
| 3064 | | "FashionTV" => "FashionTV", |
| 3065 | | "MovieExtra" => "MOVIEEXTRA", # rename |
| 3066 | | "MovieGreats" => "MOVIEGREATS", # rename |
| 3067 | | "MovieOne" => "MOVIEONE", # rename |
| 3068 | | "MovieTwo" => "MOVIETWO", # rename |
| 3069 | | "MTV" => "MTV", |
| 3070 | | "NatGeoAdventure" => "NatGeoAdventure", |
| 3071 | | "NationalGeographic" => "NationalGeographic", |
| 3072 | | "Ovation" => "Ovation", |
| 3073 | | "SkyRacing" => "SkyRacing", |
| 3074 | | "TurnerClassicMovies" => "TCM", # rename |
| 3075 | | "TVChileSpanish" => "TVChileSpanish", # SelecTV and OzTivo |
| 3076 | | "TVE" => "TVE", # SelecTV and OzTivo |
| 3077 | | "VH1" => "VH1", |
| 3078 | | ); |
| 3079 | | print " Unknown channel: $ch\n" if !exists($SelecTV_to_Foxtel{$ch}); |
| 3080 | | $ch = $SelecTV_to_Foxtel{$ch} if $SelecTV_to_Foxtel{$ch}; |
| 3081 | | |
| 3082 | | push @channellist,$ch; |
| 3083 | | } |
| 3084 | | |
| 3085 | | return @channellist; |
| 3086 | | } |
| 3087 | | |
| 3088 | | # Channel Selection (advanced/manual entering of XMLTV IDs) |
| 3089 | | # |
| 3090 | | # We try to help users match XMLTV IDs to their MythTV installation. |
| 3091 | | # We also try to make all the defaults match what they selected last |
| 3092 | | # time, if they're re-running configure. |
| 3093 | | sub channel_selection |
| 3094 | | { |
| 3095 | | my ($type, $default_tail, $old_channels, @channellist) = @_; |
| 3096 | | |
| 3097 | | my $mythids = &retrieve_mythtv_channels; |
| 3098 | | |
| 3099 | | print "\nYour region has " . scalar(@channellist) . " $type channels:\n " . |
| 3100 | | join(', ', @channellist) . ".\n\n"; |
| 3101 | | |
| 3102 | | my $newchannels = {}; |
| 3103 | | my $line; |
| 3104 | | my $c = 1; |
| 3105 | | print "\nEach channel you want guide data for needs a unique XMLTV ID. You can type\n". |
| 3106 | | "in an ID of your choice, or press ENTER to accept the suggested [default],\n". |
| 3107 | | "or type in \"n\" to skip this channel.\n\n". |
| 3108 | | "Please don't subscribe to unneeded channels.\n\n". |
| 3109 | | "$type Channels:\n"; |
| 3110 | | foreach my $ch (@channellist) |
| 3111 | | { |
| 3112 | | my $default; |
| 3113 | | my $status = "new"; |
| 3114 | | |
| 3115 | | # Ideally, keep what they assigned last time. |
| 3116 | | if ($old_channels->{$ch}) |
| 3117 | | { |
| 3118 | | $status = "previously configured"; |
| 3119 | | $default = $old_channels->{$ch}; |
| 3120 | | } |
| 3121 | | # If it looks like a channel in MythTV, suggest that. |
| 3122 | | elsif ($mythids->{$ch}) |
| 3123 | | { |
| 3124 | | $default = $mythids->{$ch}->{xmltvid}; |
| 3125 | | } |
| 3126 | | # Otherwise make up a name |
| 3127 | | else |
| 3128 | | { |
| 3129 | | $default = lc($ch); # make a default id by lower-casing |
| 3130 | | $default =~ s/[ \t()]//g; # removing whitespace and parens |
| 3131 | | $default =~ s|[/,].*||; # and deleting after / or , |
| 3132 | | $default .= $default_tail; # and tack on something like ".free.au". |
| 3133 | | } |
| 3134 | | |
| 3135 | | printf "(%2d/%2d) \"%s\" (%s)\n", $c, scalar(@channellist), $ch, $status; |
| 3136 | | |
| 3137 | | # Notify user if we found a matching MythTV channel |
| 3138 | | if ($mythids->{$ch}) |
| 3139 | | { |
| 3140 | | my $channum = $mythids->{$ch}->{channum} || '-'; |
| 3141 | | printf " Looks like MythTV channel #%s: \"%s\" (%s)\n", |
| 3142 | | $channum, |
| 3143 | | $mythids->{$ch}->{name}, |
| 3144 | | $mythids->{$ch}->{callsign}; |
| 3145 | | if ($default ne $mythids->{$ch}->{xmltvid}) |
| 3146 | | { |
| 3147 | | printf " Current ID is \"%s\" but MythTV Ch #%s is \"%s\"\n", |
| 3148 | | $default, $channum, $mythids->{$ch}->{xmltvid}; |
| 3149 | | } |
| 3150 | | } |
| 3151 | | |
| 3152 | | # Don't subscribe by default when user has configured previously |
| 3153 | | # and ignored this channel, or if it's a FTA Channel 31 variant. |
| 3154 | | if (($status eq 'new' and keys %$old_channels) |
| 3155 | | or |
| 3156 | | ($type eq 'Free to Air' and $ch =~ /31/)) |
| 3157 | | { |
| 3158 | | print " If subscribing, suggest \"$default\".\n"; |
| 3159 | | $default = ""; |
| 3160 | | } |
| 3161 | | |
| 3162 | | $line = ask(" [$default] ? "); |
| 3163 | | $line =~ s/\s//g; |
| 3164 | | |
| 3165 | | # Some users think they can enter 'y' to accept default |
| 3166 | | if (lc($line) eq 'y' or lc($line) eq 'yes') |
| 3167 | | { |
| 3168 | | if ($default) |
| 3169 | | { |
| 3170 | | $newchannels->{$ch} = $default; |
| 3171 | | } |
| 3172 | | else |
| 3173 | | { |
| 3174 | | print "No default value: please enter an XMLTV ID of your choice.\n"; |
| 3175 | | redo; |
| 3176 | | } |
| 3177 | | } |
| 3178 | | elsif ($line ne 'n' and ($line =~ /\w/ or $default)) |
| 3179 | | { |
| 3180 | | $newchannels->{$ch} = $line || $default; |
| 3181 | | } |
| 3182 | | |
| 3183 | | # Check XMLTV ID is unique |
| 3184 | | foreach (keys %$newchannels) |
| 3185 | | { |
| 3186 | | next if ($_ eq $ch); |
| 3187 | | if ($newchannels->{$_} and $newchannels->{$ch} and $newchannels->{$_} eq $newchannels->{$ch}) |
| 3188 | | { |
| 3189 | | print "ERROR: You have entered identical XMLTV IDs for $ch and $_ (\"$newchannels->{$_}\"). Exiting.\n"; |
| 3190 | | exit; |
| 3191 | | } |
| 3192 | | } |
| 3193 | | $c++; |
| 3194 | | } |
| 3195 | | printf "\nYou are subscribing to %d %s channels:\n", |
| 3196 | | scalar(keys %$newchannels), $type; |
| 3197 | | print "* $_ -> $newchannels->{$_}\n" for sort keys %$newchannels; |
| 3198 | | |
| 3199 | | my @not = grep (!$newchannels->{$_}, @channellist); |
| 3200 | | printf "\nYou are not subscribing to %d other channel%s: %s.\n", |
| 3201 | | scalar(@not), (@not > 1 ? 's' :''), join(', ', @not) |
| 3202 | | if (@not); |
| 3203 | | return $newchannels; |
| 3204 | | } |
| 3205 | | |
| 3206 | | sub retrieve_mythtv_channels |
| 3207 | | { |
| 3208 | | print "\nAttempting Mysql connection to MythTV database mythconverg.\n"; |
| 3209 | | |
| 3210 | | my $mchans; |
