| 1455 | | # Subs: Updates & Installations |
| 1456 | | # ----------------------------------------- |
| 1457 | | |
| 1458 | | sub update |
| 1459 | | { |
| 1460 | | &log("\nChecking for updates:\n\n"); |
| 1461 | | |
| 1462 | | my $data = fetch_shepherd_file("status"); |
| 1463 | | |
| 1464 | | return 0 unless ($data); |
| 1465 | | |
| 1466 | | my $made_changes = 0; |
| 1467 | | my %clist = %$components; |
| 1468 | | |
| 1469 | | # TEMPORARY CODE FOR TRANSITION TO NEW FORMAT: REMOVE THIS LATER |
| 1470 | | if ($data =~ /:/) |
| 1471 | | { |
| 1472 | | while ($data =~ /(.*):(.*):(.*)/g) |
| 1473 | | { |
| 1474 | | my ($progtype, $proggy, $latestversion) = ($1,$2,$3); |
| 1475 | | # TEMP HACK FOR TRANSITION: REMOVE LATER |
| 1476 | | if ($latestversion eq 'shepherd') |
| 1477 | | { |
| 1478 | | $latestversion = $proggy; |
| 1479 | | $proggy = 'shepherd'; |
| 1480 | | } |
| 1481 | | if (update_component($proggy, $latestversion, $progtype)) |
| 1482 | | { |
| 1483 | | $made_changes = 1; |
| 1484 | | } |
| 1485 | | delete $clist{$proggy}; |
| 1486 | | } |
| 1487 | | } |
| 1488 | | else |
| 1489 | | { |
| 1490 | | # END TEMPORARY CODE |
| 1491 | | while ($data =~ /(\S+)\s+(\S+)\s+(\S+)/g) |
| 1492 | | { |
| 1493 | | my ($progtype, $proggy, $latestversion) = ($1,$2,$3); |
| 1494 | | if (update_component($proggy, $latestversion, $progtype)) |
| 1495 | | { |
| 1496 | | $made_changes = 1; |
| 1497 | | } |
| 1498 | | delete $clist{$proggy}; |
| 1499 | | } |
| 1500 | | } |
| 1501 | | |
| 1502 | | # work out what components disappeared (if any) |
| 1503 | | foreach (keys %clist) { |
| 1504 | | unless ($components->{$_}->{disabled}) { |
| 1505 | | &log("\nDeleted component: $_.\n"); |
| 1506 | | disable($_, 2); |
| 1507 | | $made_changes = 1; |
| 1508 | | } |
| 1509 | | } |
| 1510 | | $made_changes; |
| 1511 | | } |
| 1512 | | |
| 1513 | | sub update_component |
| 1514 | | { |
| 1515 | | my ($proggy, $latestversion, $progtype) = @_; |
| 1516 | | |
| 1517 | | my $ver = 0; |
| 1518 | | |
| 1519 | | if ($progtype eq "shepherd") |
| 1520 | | { |
| 1521 | | $ver = $version if (-e "$CWD/$progname"); |
| 1522 | | } else { |
| 1523 | | $ver = $components->{$proggy}->{ver} if (defined $components->{$proggy} and -e ($progtype . "s/$proggy/$proggy")); |
| 1524 | | } |
| 1525 | | |
| 1526 | | my $result = versioncmp($ver, $latestversion); |
| 1527 | | my $action = $result == -1 ? ($ver ? "UPGRADING" : "NEW") : |
| 1528 | | $result == 1 ? "DOWNGRADING" : |
| 1529 | | "up to date"; |
| 1530 | | &log(sprintf "* %-40s %30s\n", |
| 1531 | | ucfirst($progtype) . " $proggy" . |
| 1532 | | ($ver ? " v$ver" : '') . "...", |
| 1533 | | $action); |
| 1534 | | return 0 unless ($result); |
| 1535 | | install($proggy, $latestversion, $progtype); |
| 1536 | | return 1; |
| 1537 | | } |
| 1538 | | |
| 1539 | | sub install |
| 1540 | | { |
| 1541 | | my ($proggy, $latestversion, $progtype) = @_; |
| 1542 | | my $config; |
| 1543 | | |
| 1544 | | &log("Downloading $proggy v$latestversion.\n"); |
| 1545 | | |
| 1546 | | my $rdir = ""; |
| 1547 | | my $ldir = $CWD; |
| 1548 | | my $ver = "unknown"; |
| 1549 | | |
| 1550 | | if ($progtype eq "shepherd") { |
| 1551 | | $ver = $version; |
| 1552 | | } else { |
| 1553 | | $rdir = $progtype . "s"; |
| 1554 | | $ldir = "$CWD/$progtype" . "s/$proggy"; |
| 1555 | | $ver = $components->{$proggy}->{ver} if ((defined $components->{$proggy}) && $components->{$proggy}->{ver}); |
| 1556 | | -d ("$CWD/$progtype" . "s") or mkdir ("$CWD/$progtype" . "s") or die "Cannot create directory $CWD/$progtype" . "s: $!"; |
| 1557 | | } |
| 1558 | | -d $ldir or mkdir $ldir or die "Cannot create directory $ldir: $!"; |
| 1559 | | |
| 1560 | | my $newfile = "$ldir/$proggy-$latestversion"; |
| 1561 | | my $rfile = "$rdir/$proggy"; |
| 1562 | | |
| 1563 | | return unless (fetch_shepherd_file($rfile, $newfile)); |
| 1564 | | |
| 1565 | | # Fetch grabber config file |
| 1566 | | if ($progtype eq 'grabber') |
| 1567 | | { |
| 1568 | | $rfile .= ".conf"; |
| 1569 | | $config = fetch_shepherd_file($rfile); |
| 1570 | | return unless ($config); # grabbers MUST have config files |
| 1571 | | eval $config; |
| 1572 | | } |
| 1573 | | |
| 1574 | | # Make component executable |
| 1575 | | chmod 0755,$newfile; |
| 1576 | | |
| 1577 | | -d $ARCHIVE_DIR or mkdir $ARCHIVE_DIR or die "Cannot create directory $ARCHIVE_DIR: $!"; |
| 1578 | | |
| 1579 | | if (-e "$ldir/$proggy") |
| 1580 | | { |
| 1581 | | rename("$ldir/$proggy", "$ARCHIVE_DIR/$proggy-$ver"); |
| 1582 | | } |
| 1583 | | rename($newfile, "$ldir/$proggy"); |
| 1584 | | |
| 1585 | | &log("Installed $proggy v$latestversion.\n") if ($debug); |
| 1586 | | |
| 1587 | | # if the update was for shepherd itself, restart it |
| 1588 | | if ($progtype eq "shepherd") { |
| 1589 | | &log("\n*** Restarting ***\n\n"); |
| 1590 | | &close_logfile unless $opt->{nolog}; |
| 1591 | | exec("$ldir/$proggy @options"); |
| 1592 | | # This exits. |
| 1593 | | } |
| 1594 | | |
| 1595 | | my $result = test_proggy($ldir,"$ldir/$proggy"); |
| 1596 | | |
| 1597 | | $components->{$proggy}->{type} = $progtype; |
| 1598 | | $components->{$proggy}->{ver} = $latestversion; |
| 1599 | | $components->{$proggy}->{ready} = $result; |
| 1600 | | $components->{$proggy}->{config} = $config if ($progtype eq 'grabber'); |
| 1601 | | |
| 1602 | | # If this component was disabled automatically, re-enable it. |
| 1603 | | # But if it was disabled manually, leave it off. |
| 1604 | | my $d = $components->{$proggy}->{disabled}; |
| 1605 | | if ($d and $d == 2) |
| 1606 | | { |
| 1607 | | enable($proggy); |
| 1608 | | } |
| 1609 | | |
| 1610 | | $components->{$proggy}->{laststatus} = sprintf "updated to %s on %s", $latestversion, (strftime "%a%d%b%y",localtime(time)); |
| 1611 | | |
| 1612 | | } |
| 1613 | | |
| 1614 | | sub fetch_shepherd_file |
| 1615 | | { |
| 1616 | | my ($fn, $store) = @_; |
| 1617 | | |
| 1618 | | my $sites = ""; |
| 1619 | | $sites = "$mirror_site," if ($mirror_site); |
| 1620 | | $sites .= $HOME; |
| 1621 | | |
| 1622 | | my $ret; |
| 1623 | | foreach my $site (split(/,/,$sites)) |
| 1624 | | { |
| 1625 | | $ret = fetch_file("$site/$fn", $store, 1); |
| 1626 | | return $ret if ($ret); |
| 1627 | | } |
| 1628 | | return undef; |
| 1629 | | } |
| 1630 | | |
| 1631 | | sub test_proggy |
| 1632 | | { |
| 1633 | | my ($testdir,$proggyexec) = @_; |
| 1634 | | |
| 1635 | | &log("Testing $proggyexec...\n"); |
| 1636 | | |
| 1637 | | chdir($testdir); |
| 1638 | | my $result = call_prog("$proggyexec --ready"); |
| 1639 | | chdir ($CWD); |
| 1640 | | |
| 1641 | | print "Return value: $result\n" if ($debug); |
| 1642 | | |
| 1643 | | if ($result) |
| 1644 | | { |
| 1645 | | &log("\nComponent $proggyexec did not exit cleanly!\n" . |
| 1646 | | "It may require configuration.\n\n"); |
| 1647 | | } |
| 1648 | | else |
| 1649 | | { |
| 1650 | | &log("OK.\n"); |
| 1651 | | } |
| 1652 | | return !$result; |
| 1653 | | } |
| 1654 | | |
| 1655 | | sub enable |
| 1656 | | { |
| 1657 | | my $proggy = shift; |
| 1658 | | |
| 1659 | | # confirm it exists first |
| 1660 | | if (!$components->{$proggy}) { |
| 1661 | | printf "No such component: \"%s\".\n",$proggy; |
| 1662 | | return; |
| 1663 | | } |
| 1664 | | print "Enabling $proggy.\n"; |
| 1665 | | |
| 1666 | | delete $components->{$proggy}->{disabled}; |
| 1667 | | $components->{$proggy}->{laststatus} = sprintf "enabled on %s, not run yet",(strftime "%a%d%b%y", localtime(time)); |
| 1668 | | } |
| 1669 | | |
| 1670 | | sub disable |
| 1671 | | { |
| 1672 | | my ($proggy, $n) = @_; |
| 1673 | | |
| 1674 | | # confirm it exists first |
| 1675 | | if (!$components->{$proggy}) { |
| 1676 | | printf "No such component: \"%s\".\n",$proggy; |
| 1677 | | return; |
| 1678 | | } |
| 1679 | | print "Disabling $proggy.\n"; |
| 1680 | | |
| 1681 | | $n ||= 1; |
| 1682 | | $components->{$proggy}->{disabled} = $n; |
| 1683 | | $components->{$proggy}->{laststatus} = sprintf "manually disabled on %s",(strftime "%a%d%b%y", localtime(time)); |
| 1684 | | } |
| 1685 | | |
| 1686 | | sub check |
| 1687 | | { |
| 1688 | | my $result; |
| 1689 | | foreach my $proggy (keys %$components) { |
| 1690 | | my $progtype = $components->{$proggy}->{type}; |
| 1691 | | $result = test_proggy("$CWD/$progtype" . "s/$proggy", "$CWD/$progtype" . "s/$proggy/$proggy"); |
| 1692 | | if (!$result ne !$components->{$proggy}->{ready}) { |
| 1693 | | $components->{$proggy}->{ready} = $result; |
| 1694 | | } |
| 1695 | | } |
| 1696 | | } |
| 1697 | | # ----------------------------------------- |
| 2013 | | # if a preferred title source has been specified, add it to our config |
| 2014 | | sub setpreftitlesource |
| 2015 | | { |
| 2016 | | my $arg = shift; |
| 2017 | | $pref_title_source = $arg; |
| 2018 | | print "Added preferred title source: $pref_title_source\n"; |
| 2019 | | 1; |
| 2020 | | } |
| 2021 | | |
| 2022 | | # if requesting to clear preferred title and we have one, remove it |
| 2023 | | sub clearpreftitlesource |
| 2024 | | { |
| 2025 | | $pref_title_source = undef; |
| 2026 | | print "Removed preferred title source $pref_title_source\n"; |
| 2027 | | 1; |
| 2028 | | } |
| 2029 | | |
| 2030 | | # if a mirror has been specified, add it into our config |
| 2031 | | sub setmirror |
| 2032 | | { |
| 2033 | | my $arg = shift; |
| 2034 | | $mirror_site = $arg; |
| 2035 | | print "Setting mirror site(s): $mirror_site\n"; |
| 2036 | | } |
| 2037 | | |
| 2038 | | # ----------------------------------------- |
| 2039 | | # Subs: Configuration |
| 2040 | | # ----------------------------------------- |
| 2041 | | |
| 2042 | | sub configure |
| 2043 | | { |
| 2044 | | my $REGIONS = { |
| 2045 | | "ACT" => 126, |
| 2046 | | "NSW: Sydney" => 73, |
| 2047 | | "NSW: Newcastle" => 184, |
| 2048 | | "NSW: Central Coast" => 66, |
| 2049 | | "NSW: Griffith" => 67, |
| 2050 | | "NSW: Broken Hill" => 63, |
| 2051 | | "NSW: Northern NSW" => 69, |
| 2052 | | "NSW: Southern NSW" => 71, |
| 2053 | | "NSW: Remote and Central" => 106, |
| 2054 | | "NT: Darwin" => 74, |
| 2055 | | "NT: Remote & Central" => 108, |
| 2056 | | "QLD: Brisbane" => 75, |
| 2057 | | "QLD: Gold Coast" => 78, |
| 2058 | | "QLD: Regional" => 79, |
| 2059 | | "QLD: Remote & Central" => 114, |
| 2060 | | "SA: Adelaide" => 81, |
| 2061 | | "SA: Renmark" => 82, |
| 2062 | | "SA: Riverland" => 83, |
| 2063 | | "SA: South East SA" => 85, |
| 2064 | | "SA: Spencer Gulf" => 86, |
| 2065 | | "SA: Remote & Central" => 107, |
| 2066 | | "Tasmania" => 88, |
| 2067 | | "VIC: Melbourne" => 94, |
| 2068 | | "VIC: Geelong" => 93, |
| 2069 | | "VIC: Eastern Victoria" => 90, |
| 2070 | | "VIC: Mildura/Sunraysia" => 95, |
| 2071 | | "VIC: Western Victoria" => 98, |
| 2072 | | "WA: Perth" => 101, |
| 2073 | | "WA: Regional" => 102 |
| 2074 | | }; |
| 2075 | | |
| 2076 | | print "\nConfiguring.\n\n" . |
| 2077 | | "Select your region:\n"; |
| 2078 | | foreach (sort keys %$REGIONS) |
| 2079 | | { |
| 2080 | | printf(" (%3d) %s\n", $REGIONS->{$_}, $_); |
| 2081 | | } |
| 2082 | | $region = ask_choice("Enter region code:", "94", values %$REGIONS); |
| 2083 | | |
| 2084 | | print "\nFetching channel information... "; |
| 2085 | | |
| 2086 | | my @channellist = get_channels(); |
| 2087 | | |
| 2088 | | print "done.\n\n" . |
| 2089 | | "For each channel you want guide data for, enter an XMLTV id\n" . |
| 2090 | | "of your choice (e.g. \"seven.free.au\"). If you don't need\n" . |
| 2091 | | "guide data for this channel, just press Enter.\n\n" . |
| 2092 | | "Please don't subscribe to unneeded channels.\n\nChannels:\n"; |
| 2093 | | $channels = {}; |
| 2094 | | my $line; |
| 2095 | | foreach (@channellist) |
| 2096 | | { |
| 2097 | | $line = ask(" \"$_\"? "); |
| 2098 | | $channels->{$_} = $line if ($line); |
| 2099 | | } |
| 2100 | | |
| 2101 | | print "\nHigh Definition TV (HDTV)\n". |
| 2102 | | "Most Australian TV networks broadcast at least some\n". |
| 2103 | | "programmes in HDTV each week, but for the most part\n". |
| 2104 | | "either upsample SD to HD or play a rolling demonstration\n". |
| 2105 | | "HD clip when they don't have the programme in HD format.\n\n". |
| 2106 | | "If you have a HDTV capable system and are interested in\n". |
| 2107 | | "having Shepherd's postprocessors populate HDTV content\n". |
| 2108 | | "then Shepherd will need to know the XMLTV IDs for the HD\n". |
| 2109 | | "channels also.\n"; |
| 2110 | | if (ask_boolean("\nDo you wish to include HDTV channels?")) { |
| 2111 | | print "\nFor each channel you want guide data for, enter an XMLTV id\n" . |
| 2112 | | "of your choice (e.g. \"sevenhd.free.au\"). If you don't need\n" . |
| 2113 | | "guide data for this channel, just press Enter.\n\n"; |
| 2114 | | |
| 2115 | | $opt_channels = {}; |
| 2116 | | foreach (@channellist) |
| 2117 | | { |
| 2118 | | next if (($_ =~ /ABC2/i) || ($_ =~ /SBS News/i) || ($_ =~ /31/)); |
| 2119 | | $_ .= "HD"; |
| 2120 | | $line = ask(" \"$_\"? "); |
| 2121 | | $opt_channels->{$_} = $line if ($line); |
| 2122 | | } |
| 2123 | | } |
| 2124 | | |
| 2125 | | |
| 2126 | | print "\nWould you like to transition seamlessly from your current grabber?\n\n". |
| 2127 | | "Different data sources can have different names for the same show. For\n". |
| 2128 | | "example, one grabber might call a show \"Spicks & Specks\" while another\n". |
| 2129 | | "calls it \"Spicks and Specks\". These differences can make MythTV think\n". |
| 2130 | | "they're actually different shows.\n\n". |
| 2131 | | ucfirst($progname) . " is able to merge these differences so that it always\n". |
| 2132 | | "presents shows with a consistent name, no matter where it actually sourced\n". |
| 2133 | | "show data from. If you'd like, it can also rename shows so they're consistent\n". |
| 2134 | | "with whichever grabber you've been using until now.\n\n". |
| 2135 | | "The advantage of this is that you should get a smoother transition to\n". |
| 2136 | | ucfirst($progname) . ", with no shows changing names and no need to re-create\n". |
| 2137 | | "any recording rules. The main disadvantage is that if your previous grabber\n". |
| 2138 | | "used an inferior data source -- i.e. it sometimes has typos or less\n". |
| 2139 | | "informative program names -- then you'll continue to see these.\n\n". |
| 2140 | | "If you were using one of the following grabbers previously AND you want\n". |
| 2141 | | ucfirst($progname) . " to use that grabber's program names, select it here.\n\n"; |
| 2142 | | |
| 2143 | | my $def = "Do not transition; just use best quality titles"; |
| 2144 | | my %transition = ( "ltd (aka tv_grab_au, versions 1,30, 1.40 or 1.41)" => "yahoo7widget,abc2_website", |
| 2145 | | "OzTivo" => 'oztivo', |
| 2146 | | "JRobbo" => 'jrobbo' ); |
| 2147 | | my $pref = ask_choice("Transition from grabber?", $def, |
| 2148 | | $def, keys %transition); |
| 2149 | | $pref_title_source = $transition{$pref}; |
| 2150 | | |
| 2151 | | print "\n"; |
| 2152 | | show_channels(); |
| 2153 | | unless(ask_boolean("\nCreate configuration file?")) |
| 2154 | | { |
| 2155 | | print "Aborting configuration.\n"; |
| 2156 | | exit 0; |
| 2157 | | } |
| 2158 | | |
| 2159 | | write_config_file(); |
| 2160 | | write_channels_file(); |
| 2161 | | |
| 2162 | | print "Finished configuring.\n\n" . |
| 2163 | | "Shepherd is installed into $CWD.\n\n"; |
| 2164 | | |
| 2165 | | if ($invoked ne "$CWD/$progname" and $invoked =~ /$progname/) |
| 2166 | | { |
| 2167 | | print "Warning: you invoked this program as $invoked.\n" . |
| 2168 | | "In the future, it should be run as $CWD/$progname,\n" . |
| 2169 | | "to avoid constantly re-downloading the latest version.\n\n" . |
| 2170 | | "MythTV users may wish to create the following symlink, by " . |
| 2171 | | "doing this (as root):\n" . |
| 2172 | | "\"ln -s $CWD/$progname /usr/bin/tv_grab_au\".\n\n" . |
| 2173 | | "You may safely delete $invoked.\n\n"; |
| 2174 | | } |
| 2175 | | |
| 2176 | | status(); |
| 2177 | | |
| 2178 | | unless (ask_boolean("\nGrab data now?")) |
| 2179 | | { |
| 2180 | | exit 0; |
| 2181 | | } |
| 2182 | | } |
| 2183 | | |
| 2184 | | sub get_channels |
| 2185 | | { |
| 2186 | | my @date = localtime; |
| 2187 | | my $page = fetch_file( |
| 2188 | | "http://au.tv.yahoo.com/results.html?rg=$region&dt=" . |
| 2189 | | ($date[5] + 1900) . "-$date[4]-$date[3]"); |
| 2190 | | my @channellist; |
| 2191 | | while ($page =~ /<tr class=rtb><td class=rth><a .*?>(.*?)<\/a>/g) |
| 2192 | | { |
| 2193 | | push @channellist, $1; |
| 2194 | | } |
| 2195 | | return @channellist; |
| 2196 | | } |
| 2197 | | |
| 2201 | | |
| 2202 | | sub show_config |
| 2203 | | { |
| 2204 | | print "\nConfiguration\n". |
| 2205 | | "-------------\n" . |
| 2206 | | "Config file: $config_file\n" . |
| 2207 | | "Debug mode : " . is_set($debug) . "\n" . |
| 2208 | | "Output file: " . ($opt->{output} ? $opt->{output} : "None") . "\n" . |
| 2209 | | "Region ID : $region\n"; |
| 2210 | | show_channels(); |
| 2211 | | print "\n"; |
| 2212 | | status(); |
| 2213 | | print "\n"; |
| 2214 | | } |
| 2215 | | |
| 2216 | | sub show_channels |
| 2217 | | { |
| 2218 | | print "Subscribed channels:\n"; |
| 2219 | | print " $_ -> $channels->{$_}\n" for sort keys %$channels; |
| 2220 | | print "Optional (HDTV) channels:\n"; |
| 2221 | | print " $_ -> $opt_channels->{$_}\n" for sort keys %$opt_channels; |
| 2222 | | } |
| 2223 | | |
| 2224 | | sub is_set |
| 2225 | | { |
| 2226 | | my $arg = shift; |
| 2227 | | return $arg ? "Yes" : "No"; |
| 2228 | | } |
| 2229 | | |
| 2230 | | sub pretty_print |
| 2231 | | { |
| 2232 | | my ($p, $len) = @_; |
| 2233 | | my $spaces = ' ' x (79-$len); |
| 2234 | | my $ret = ""; |
| 2235 | | |
| 2236 | | while (length($p) > 0) { |
| 2237 | | if (length($p) <= $len) { |
| 2238 | | $ret .= $p; |
| 2239 | | $p = ""; |
| 2240 | | } else { |
| 2241 | | # find a space to the left of cutoff |
| 2242 | | my $len2 = $len; |
| 2243 | | while ((substr($p,$len2,1) ne ' ') && ($len2 > 0)) { |
| 2244 | | $len2--; |
| 2245 | | } |
| 2246 | | if ($len2 == 0) { |
| 2247 | | # no space - just print it with cutoff |
| 2248 | | $ret .= substr($p,0,$len); |
| 2249 | | $p = substr($p,$len,(length($p)-$len)); |
| 2250 | | } else { |
| 2251 | | # print up to space |
| 2252 | | $ret .= substr($p,0,$len2); |
| 2253 | | $p = substr($p,($len2+1),(length($p)-$len2+1)); |
| 2254 | | } |
| 2255 | | # print whitespace |
| 2256 | | $ret .= "\n".$spaces; |
| 2257 | | } |
| 2258 | | } |
| 2259 | | return $ret; |
| 2260 | | } |
| 2261 | | |
| 2262 | | sub status |
| 2263 | | { |
| 2264 | | print "\nThe following plugins are known:\n", |
| 2265 | | " Type Name Version Description\n". |
| 2266 | | " -------- -------------- ------- ----------------------------------------------\n"; |
| 2267 | | |
| 2268 | | foreach (sort { $components->{$a}->{type} cmp $components->{$b}->{type} } keys %{$components}) { |
| 2269 | | printf " %-8s %-15s%7s %46s\n", |
| 2270 | | substr($components->{$_}->{type},0,8), |
| 2271 | | length($_) > 15 ? substr($_,0,13).".." : $_, |
| 2272 | | ($components->{$_}->{ver} ? substr($components->{$_}->{ver},0,7) : "unknown"), |
| 2273 | | (defined $components->{$_}->{config}->{desc} ? |
| 2274 | | pretty_print($components->{$_}->{config}->{desc},46) : ""); |
| 2275 | | } |
| 2276 | | printf "\n"; |
| 2277 | | |
| 2278 | | print "Grabbers, listed in order of quality:\n". |
| 2279 | | " Enabled/\n". |
| 2280 | | " Grabber Qual Ready Last Run Status\n" . |
| 2281 | | " -------------- ---- ----- ---------- -----------------------------------------\n"; |
| 2282 | | my %qual_table = ( 3 => "Best", 2 => "Good", 1 => "Avg" ); |
| 2283 | | foreach (sort { $components->{$b}->{config}->{quality} <=> $components->{$a}->{config}->{quality} } query_grabbers()) { |
| 2284 | | my $h = $components->{$_}; |
| 2285 | | printf " %-15s%-4s %1s/%1s %11s %s\n", |
| 2286 | | length($_) > 15 ? substr($_,0,13).".." : $_, |
| 2287 | | $qual_table{($h->{config}->{quality})}, |
| 2288 | | $h->{disabled} ? 'N' : 'Y', |
| 2289 | | $h->{ready} ? 'Y' : 'N', |
| 2290 | | $h->{lastdata} ? (strftime "%a%d%b%y", localtime($h->{lastdata})) : 'never', |
| 2291 | | $h->{laststatus} ? pretty_print($h->{laststatus},41) : ''; |
| 2292 | | } |
| 2293 | | |
| 2294 | | print "\n". |
| 2295 | | " Enabled/\n". |
| 2296 | | " Reconciler Ready Last Run Status\n" . |
| 2297 | | " -------------- ----- ---------- ----------------------------------------------\n"; |
| 2298 | | foreach (sort { $components->{$a} <=> $components->{$b} } query_reconcilers()) { |
| 2299 | | my $h = $components->{$_}; |
| 2300 | | printf " %-15s %1s/%1s %11s %s\n", |
| 2301 | | length($_) > 15 ? substr($_,0,13).".." : $_, |
| 2302 | | $h->{disabled} ? 'N' : 'Y', |
| 2303 | | $h->{ready} ? 'Y' : 'N', |
| 2304 | | $h->{lastdata} ? (strftime "%a%d%b%y", localtime($h->{lastdata})) : 'never', |
| 2305 | | $h->{laststatus} ? pretty_print($h->{laststatus},46) : ''; |
| 2306 | | } |
| 2307 | | |
| 2308 | | print "\n". |
| 2309 | | " Enabled/\n". |
| 2310 | | " Postprocessor Ready Last Run Status\n" . |
| 2311 | | " -------------- ----- ---------- ----------------------------------------------\n"; |
| 2312 | | foreach (sort { $components->{$a} <=> $components->{$b} } query_postprocessors()) { |
| 2313 | | my $h = $components->{$_}; |
| 2314 | | printf " %-15s %1s/%1s %11s %s\n", |
| 2315 | | length($_) > 15 ? substr($_,0,13).".." : $_, |
| 2316 | | $h->{disabled} ? 'N' : 'Y', |
| 2317 | | $h->{ready} ? 'Y' : 'N', |
| 2318 | | $h->{lastdata} ? (strftime "%a%d%b%y", localtime($h->{lastdata})) : 'never', |
| 2319 | | $h->{laststatus} ? pretty_print($h->{laststatus},46) : ''; |
| 2320 | | } |
| 2321 | | printf "\nPreferred titles from grabber '%s'\n",$pref_title_source if ($pref_title_source); |
| 2322 | | printf "\n"; |
| 2323 | | } |
