olive 1.3-4 / usr / share / olive / OliveMisc.pm

package OliveMisc;

=head1 NAME

OliveMisc - Utility routines for Olive

=head1 DESCRIPTION

Storage area for miscellaneous utility routines needed by other parts
of Olive.

=head1 SUBROUTINES

Exported: L</errorbox>, L</iso8601>, L</rfc822>, L</setkeys>, L</setpollwait>, L</sysinit>, L</sysinit2>

Unexported: L</aboutpop>, L</helppop>, L</followlink>, L</quitit>

=cut

require Exporter;
use warnings;
use strict;
use Date::Calc qw(Mktime);
use Log::Dispatch::File;
use OliveEdit;
use OliveOpts;

our @ISA       = qw(Exporter);
our @EXPORT    = qw( &sysinit &sysinit2 &setpollwait &setkeys
                     &db_fastmode &db_safemode
                     &errorbox &rfc822 &iso8601 );

my %months = ( 'Jan' => 1,
               'Feb' => 2,
               'Mar' => 3,
               'Apr' => 4,
               'May' => 5,
               'Jun' => 6,
               'Jul' => 7,
               'Aug' => 8,
               'Sep' => 9,
               'Oct' => 10,
               'Nov' => 11,
               'Dec' => 12
             );

my %z = ( 'GMT' => 0,
          'U'   => 0,
          'UTC' => 0,
          'WET' => 0,
          'Z'   => 0,
          'JST' => 9,
          'EST' => -5,
          'EDT' => -4,
          'CST' => -6,
          'CDT' => -5,
          'MST' => -7,
          'MDT' => -6,
          'PST' => -8,
          'PDT' => -7,
          'AKST'=> -9,
          'AKDT'=> -8,
        );


#-------------------------------------------------------------

sub sysinit {
    my $dotdir  = $ENV{HOME} . "/.olive";
    my $feeddir = $ENV{HOME} . "/.olive/feeds";
    my $dotfile = $dotdir . "/olive.yaml";
    my $errfile = $dotdir . "/errors.log";
    my @t       = localtime();

    # set up dotdirm feeddir, dotfile, and errlog
    mkdir $dotdir,  0700 unless (-e $dotdir);
    mkdir $feeddir, 0755 unless (-e $feeddir);
    system("touch $dotfile") unless (-e $dotfile);
    system("cp $errfile.1 $errfile.2") if (-e "$errfile.1");
    system("cp $errfile $errfile.1") if (-e $errfile);
    open STDERR, '>', $errfile;
}

#-------------------------------------------------------------

sub sysinit2 {
    my $cui = shift;
    my $c   = $cui->userdata->{c};
    my $dbh = $cui->userdata->{dbh};

    # set up logging
    $cui->userdata->{log} = Log::Dispatch::File->new( name      => 'olivelog',
                                                      min_level => $c->{loglevel} || 'warning',
                                                      filename  => ($ENV{HOME} . '/.olive/errors.log'),
                                                      mode      => 'write',
                                                      callbacks => \&OliveMisc::logstamper,
                                                    );
    # and log startup message
    my $rel = $cui->userdata->{rel};
    my $rev = $cui->userdata->{rev};
    $cui->userdata->{log}->log( level   => 'warning',
                                message => "Olive $rel (r$rev) starting up." );

    # say hello if we're new
    unless ($cui->userdata->{c}->{fr}) {
        $cui->dialog( -bfg => 'blue',
                      -message => "          This is Olive\n    A Totally Sweet Newsfeeder\n\nPress 'h' or '?' anytime for help.");
        $cui->userdata->{c}->{fr} = $cui->userdata->{rel};
    }

    # set up the db if it isn't (we're new, or it has been deleted)
    my $statement = 'SELECT count(id) FROM stories';
    my ($rows) = $dbh->selectrow_array($statement);
    if ($rows eq '') {
        # it isn't. make it.
        $statement = 'CREATE TABLE stories (id INTEGER PRIMARY KEY, nick TEXT, timestamp INT, md5 TEXT, read INT, new INT, star INT, link TEXT, title TEXT, desc TEXT)';
        my $sth = $dbh->prepare($statement);
        $sth->execute;
        $statement = 'CREATE TABLE links (sid INTEGER, num INT, link TEXT, desc TEXT)';
        $sth = $dbh->prepare($statement);
        $sth->execute;
        $statement = 'CREATE INDEX linkidx ON links (sid)';
        $sth = $dbh->prepare($statement);
        $sth->execute;
        $cui->userdata->{c}->{fr} = $cui->userdata->{rel};
    } else {
        # it is. clean shit up, y0
        $statement = "VACUUM";
        my $sth = $dbh->prepare($statement);
        $sth->execute;
    }

    # if the user last ran an older version, tell him to delete the db and restart
    if (($cui->userdata->{c}->{fr} eq 'b10') or ($cui->userdata->{c}->{fr} eq '1')) {
        errorbox($cui,'There are incompatible database changes in this release of Olive. Please delete ~/.olive/stories.db and restart. Olive will terminate when you dismiss this message.','DB Upgrade');
        quitit($cui);
    }

    # set feed fetch timeout if there isn't one defined
    $cui->userdata->{c}->{to} = 30 unless ($cui->userdata->{c}->{to});
    # and set story paging/status display if they don't exist
    $cui->userdata->{c}->{sls} = 1 unless (exists $cui->userdata->{c}->{sls});
    $cui->userdata->{c}->{gsp} = 1 unless (exists $cui->userdata->{c}->{gsp});

    $cui->userdata->{c}->write;

    # turn on utf8 if appropriate
    $cui->userdata->{utf8} = 0;
    $cui->userdata->{utf8} = 1 if ($ENV{LC_ALL} and ($ENV{LC_ALL} =~ /UTF-8/) or
                                   $ENV{LANG}   and ($ENV{LANG}   =~ /UTF-8/));
}

#-------------------------------------------------------------

sub db_fastmode {
    my ($d) = @_;
    $d->{AutoCommit} = 0;
    $d->do("PRAGMA default_synchronous = OFF");
}

#-------------------------------------------------------------

sub db_safemode {
    my ($d) = @_;
    $d->commit;
    $d->{AutoCommit} = 1;
    $d->do("PRAGMA default_synchronous = ON");
}

#-------------------------------------------------------------

sub errorbox {
    my ($cui,$msg,$title) = @_;
    $cui->disable_timer('clock');
    if($cui->getobj('__window_Dialog::Basic')){
        $cui->getobj('__window_Dialog::Basic')->focus;
        $cui->getobj('__window_Dialog::Basic')->draw;
        return;
    }
    $title = "Error" unless (defined $title);
    $cui->dialog( -title => $title, -message => $msg);
    $cui->enable_timer('clock');
}

#-------------------------------------------------------------

sub followlink {
    my ($cui,$link) = @_;
    unless ($cui->userdata->{c}->{www} && $cui->userdata->{c}->{www} =~ /LINK/) {
        errorbox($cui,"You must properly define a link command in the Options panel to enable this function.");
        return;
    }

    unless ($link) {
        my $d  = $cui->userdata->{dbh};
        my $w  = $cui->userdata->{wins};
        my $id = $w->{news}{list}->get;
        $link  = $d->selectrow_array("SELECT link FROM stories WHERE id = $id");
    }

    my $cmd = $cui->userdata->{c}->{www};
    $cmd =~ s/LINK/\'$link\'/g;
    system($cmd);
}


#-------------------------------------------------------------

sub logstamper {
    my %msghash = @_;
    my @t = localtime;

    return sprintf ("[%d-%02d-%02d %02d:%02d:%02d] %s\n",
                    ($t[5] + 1900), ($t[4] + 1), $t[3],
                    $t[2], $t[1], $t[0], $msghash{message});
}

#-------------------------------------------------------------

sub setpollwait {
    my $cui = shift;
    my $c = $cui->userdata->{c};
    $c->{pw} = 10 unless ($c->{pw});
    my $pw = $c->{pw} * 60;

    $cui->disable_timer('clock');
    $cui->set_timer('clock',
                    sub { &OliveFeed::feedpoll($cui);
                          &OliveStory::refreshlist($cui);
                          &OliveStory::shiftlist($cui);
                        },
                    $pw);
    $cui->enable_timer('clock');
}

#-------------------------------------------------------------

sub quitit {
    my $cui = shift;
    my $c = $cui->userdata->{c};

    if ($c->{coe}) {
    my $return = $cui->dialog( -message => "Really quit?",
                               -bfg     => "blue", 
                               -buttons => ['yes', 'no'],
			     );
        exit(0) if $return;
    } else {
        exit(0);
    }
}

#-------------------------------------------------------------

sub setkeys {
    my ($cui,$root,$docdir) = @_;
    my $c = $cui->userdata->{c};
    my $w = $cui->userdata->{wins};
    my $keys = $cui->userdata->{keys};

    # global keys, work everywhere all the time
    # not user-bindable
    $cui->set_binding(sub { &OliveFeed::getfeed($cui) },   "\cA");
    $cui->set_binding(sub { &OliveEdit::deletefeed($cui) },"\cR");
    $cui->set_binding(sub { &OliveEdit::editfeed($cui) },  "\cE");
    $cui->set_binding(sub { &OliveOpts::setopts($cui) },   "\cO");
    $cui->set_binding(sub { &OliveWindow::winredraw($cui,$root) }, "\cL");
    $cui->set_binding(sub { aboutpop($cui) }, "\cT");
    $cui->set_binding(sub { followlink( $cui, "file:///$docdir/index.html") }, "\cN");

    # root window keys, work whenever there isn't a dialog
    # visible (that's a $cui context)

    # these are not-user bindable
    $root->set_binding(sub { quitit($cui) },     'Q');
    $root->set_binding(sub { helppop($cui) },    'h','?');
    # but these are
    $root->set_binding(sub { &OliveStory::storyprev($cui) }, $keys->{prev} );
    $root->set_binding(sub { &OliveStory::storynext($cui) }, $keys->{next} );
    $root->set_binding(sub { &OliveStory::markone($cui,1) }, $keys->{mark} );
    $root->set_binding(sub { &OliveStory::markone($cui,0) }, $keys->{unmark} );
    $root->set_binding(sub { &OliveStory::markall($cui,1) }, $keys->{markall} );
    $root->set_binding(sub { &OliveStory::markall($cui,0) }, $keys->{unmarkall} );
    $root->set_binding(sub { &OliveStory::starone($cui) },   $keys->{star} );
    $root->set_binding(sub { &OliveWindow::winflip($cui) },  $keys->{focus} );
    $root->set_binding(sub { followlink($cui) },             $keys->{link} );
    $root->set_binding(sub { &OliveWindow::linklist($cui) }, $keys->{linklist} );
    $root->set_binding(sub { $cui->userdata->{flag} = $cui->userdata->{flag} ? 0 : 1;
                             &OliveStory::refreshlist($cui) }, $keys->{filterf} );
    $root->set_binding(sub { $cui->userdata->{star} = $cui->userdata->{star} ? 0 : 1;
                             &OliveStory::refreshlist($cui) }, $keys->{filters} );
    $root->set_binding(sub { &OliveFeed::feedpoll($cui);
                             &OliveStory::refreshlist($cui) }, $keys->{poll} );
    $root->set_binding(sub { my $f = &OliveFeed::forcefetch($cui); 
                             return errorbox($cui,'There are no feeds marked as forced.','Info')
                                 unless ($f);
                             &OliveStory::refreshlist($cui);
                             &OliveStory::shiftlist($cui) },   $keys->{force} );

    # and these can be on or off
    if ($c->{gsp}) {
        $root->set_binding( sub { $w->{story}{view}->cursor_pagedown; 
                                  $w->{story}{view}->draw; }, $keys->{gpdn} );
        $root->set_binding( sub { $w->{story}{view}->cursor_pageup;
                                  $w->{story}{view}->draw; }, $keys->{gpup} );
    }
}

#-------------------------------------------------------------

sub rfc822 {
    # Thu, 14 Apr XX05 10:16:24 GMT
    my $rfc822 = shift;
    my $dos = 0; # day offset for substr parsing
    my $yos = 0; # year offset for substr parsing
    my @t = ();  # time array
    my @l = localtime;  # localtime array

    # check for day-of-month with no leading zero
    $t[2]  = substr($rfc822,5,2);
    if ($t[2] =~ /^\d\s$/) {
        $t[2] = substr($rfc822,5,1);
        $dos  = 1;
    }

    # check for 2-digit year
    $t[0] = substr($rfc822,(12 - $dos),4);
    if ($t[0] =~ /^\d\d\s/) {
        $t[0] = substr($rfc822,(12 - $dos),2);
        $t[0] = "20" . $t[0];
        $yos  = 2 + $dos;
    }

    $t[1] = $months{substr($rfc822,(8 - $dos),3)}; # DOW
    $t[3] = substr($rfc822,(17 - $yos),2); # HH
    $t[4] = substr($rfc822,(20 - $yos),2); # MM
    $t[5] = substr($rfc822,(23 - $yos),2); # SS

    my $tz = substr($rfc822,(26 - $yos),3); # TZ

    # check/force chunks of date for validity
    # use null date if YYYY-MM-DD are missing/invalid
    return 0 if ($t[0] !~ /\d{4}/ || $t[0] < 1970 || $t[0] > ($l[5] + 1900));
    return 0 if ($t[1] =~ /\D/ || $t[1] < 1 || $t[1] > 12);
    return 0 if ($t[2] =~ /\D/ || $t[2] < 1 || $t[2] > 31);
    # HH:MM:SS can safely be slammed to 0
    for my $i (3..5) {
        $t[$i] = 0 unless (defined $t[$i] && $t[$i] !~ /\D/);
    }
    # munge tz
    if ($z{$tz}) {
        $tz = 3600 * $z{$tz};
    } elsif ($tz =~ /^[+-]/) {
        my $secs = $tz =~ /^\+/ ? 3600 : -3600;
        $tz = $secs * substr($tz,1,2);
    } else {
        $tz = 0;
    }

    my $time = Mktime(@t); # convert to timestamp
    $time = $time - $tz;   # TZ correction
    return $time;
}

#-------------------------------------------------------------

sub iso8601 {
    # 2005-04-14T12:38:51-05:00
    my $iso8601 = shift;
    my @t = ();
    my @l = localtime;

    $t[0] = substr($iso8601,0,4);
    $t[1] = substr($iso8601,5,2);
    $t[2] = substr($iso8601,8,2);
    $t[3] = substr($iso8601,11,2);
    $t[4] = substr($iso8601,14,2);
    $t[5] = substr($iso8601,17,2);
    my $sign = substr($iso8601,19,1);
    my $tz   = substr($iso8601,20,2);

    # check/force chunks of date for validity
    # use null date if YYYY-MM-DD are missing/invalid
    return 0 if ($t[0] !~ /\d{4}/ || $t[0] < 1970 || $t[0] > ($l[5] + 1900));
    return 0 if ($t[1] =~ /\D/ || $t[1] < 1 || $t[1] > 12);
    return 0 if ($t[2] =~ /\D/ || $t[2] < 1 || $t[2] > 31);
    # HH:MM:SS can safely be slammed to 0
    for my $i (3..5) {
        $t[$i] = 0 unless (defined $t[$i] && $t[$i] !~ /\D/);
    }

    my $secs = ($sign eq '+') ? 3600 : -3600;
    $tz = $secs * $tz;
    my $time = Mktime(@t); # convert to timestamp
    $time= $time - $tz;    # TZ correction
    return $time;
}

#-------------------------------------------------------------

sub aboutpop {
    my $cui = shift;
    return if($cui->getobj('dialog'));
    my $rel = $cui->userdata->{rel};
    my $rev = $cui->userdata->{rev};
    my $aboutmsg = <<ABOUT;
               ttjjffffffff;;..  ::jjffffff;;
                 ..,,ttffffffjj,,  ::jjffffff::
                       ..iiffffff;;  ,,jjfffftt
               ffjjii,,    ,,jjffff,,  ,,ffffff,,
               ;;ttfffftt::  ..jjffff..  iiffffjj
                     ;;ffff,,  ..jjfftt    jjffff;;
             ,,;;;;,,  ..jjff;;  ,,ffff,,  ;;fffftt
         ::ttffffttiitt..::ffjj..  ttfftt  ..ffffff
       ;;ffffffff..  ..tt  ,,ffii  ,,ffff..  jjffff,,
     iiffffffffff;;    ;;;;  ttjj    ffff,,  iiffff;;
   ;;ffffffffffffff::  ,,ii  ,,ff::  ttffii  ;;ffffii
   ffffffffffffffffffiittii  ..ff;;  iiffii  ,,fffftt
 ,,ffffffffffffffffffffff;;    tt,,  ,,tt;;  ..tttt;;
 ;;ffffffffffffffffffffff..
 ,,ffffffffffffffffffff;;
   jjfffffffffffffffftt
   ,,fffffffffffffftt    Olive
     ;;jjffffffjj;;      The Totally Sweet Newsfeeder
         ,,,,::          Release 1 Version 3 ($rev)


 Thanks to: Tildedot
            Professor Moglen
            obra and sungo
            edsu
            Artur Czechowski
            Peter Mauriusz
            guru\@unixtech.be
            Alan S. Young
            Bernhard Egger
            Nikolay Fetisov
            Daniel Hinder
ABOUT
1;

    my $ap = $cui->add('about', 'Window',
                       -border   => 1,
                       -bfg      => 'blue',
                       -title    => 'About Olive',
                       -height   => 24,
                       -width    => 58,
                       -centered => 1,
        );
    $ap->{txt} = $ap->add('atxt', 'TextViewer',
                          -text       => $aboutmsg,
                          -border     => 1,
                          -height     => 21,
                          -width      => 56,
                          -vscrollbar => 1,
                          -x          => 0,
                          -y          => 0,
        );
    $ap->{hkb} = $ap->add('abok', 'Buttonbox',
                          -y       => -1,
                          -x       => 50,
                          -buttons => [ { -label   => '< OK >',
                                          -value   => 1,
                                          -onpress => sub { $ap->loose_focus;
                                                            $cui->delete('about');
                                                            $cui->enable_timer('clock');
                                                            $cui->draw },
                                        } 
                          ],
        );
    $cui->disable_timer('clock');
    $ap->draw;
    $ap->focus;
}

#-------------------------------------------------------------

sub helppop {
    my $cui = shift;
    if($cui->getobj('help')) {
        $cui->getobj('help')->focus;
        $cui->getobj('help')->draw;
        return;
    }

    my $keys = $cui->userdata->{keys};

    my $helpmsg = <<HELP;
---- GLOBAL KEYS -------------------------------------
 TAB  Move between UI elements
 Q    Quit
 C-a  Add a new feed
 C-e  Edit feeds
 C-r  Remove feeds
 C-o  Options panel

 $keys->{prev}  Previous story       $keys->{next}  Next story
 $keys->{mark}  Mark as read         $keys->{unmark}  Mark as unread
 $keys->{markall}  Mark all read        $keys->{unmarkall}  Mark all unread

 $keys->{star}  Toggle story status (star/unstar)
 $keys->{filters}  Toggle starred story filter
    (show only starred stories/show all)
 $keys->{filterf}  Toggle flagged feeds filter

 $keys->{poll}  Refresh news list      $keys->{force}  Refresh forced feeds
 $keys->{link}  Pass link to browser   $keys->{focus}  Switch pane focus
 $keys->{linklist}  Show story text linklist

 h,?  Show this message
 C-n  Read manual (if extermal browser is defined)
 C-t  Show About box

---- STORY LIST KEYS ---------------------------------
 Up,Dn  Move story selector
 PgUp   Scroll list one screen up
 PgDn   Scroll list one screen down
 ENTER  Read story

---- STORY VIEW KEYS ---------------------------------
 Up,k      Scroll text one line up
 Dn,j      Scroll text one line down
 PgUp      Scroll text one screen up
 PgDn      Scroll text one screen down

---- SEARCH KEYS -------------------------------------
 /     Start new search (works in all lists and in
                         the story pane)
 n     Repeat last search forward
 N     Repeat last search backward
 ENTER Select current match; exit search
 q     Exit search without selection

------------------------------------------------------

  Still having problems? Email me:
     <sboyette\@cpan.org>
HELP
1;

    my $help = $cui->add('help', 'Window',
                         -border   => 1,
                         -bfg      => 'blue',
                         -title    => 'Help',
                         -height   => 20,
                         -width    => 61,
                         -centered => 1,
        );
    $help->{txt} = $help->add('htxt', 'TextViewer',
                              -text       => $helpmsg,
                              -border     => 1,
                              -height     => 14,
                              -width      => 57,
                              -vscrollbar => 1,
                              -x          => 1,
                              -y          => 1,
        );
    $help->{hkb} = $help->add('hbok', 'Buttonbox',
                              -y       => -2,
                              -x       => 52,
                              -buttons => [ { -label   => '< OK >',
                                              -value   => 1,
                                              -onpress => sub { $help->loose_focus;
                                                                $cui->delete('help');
                                                                $cui->enable_timer('clock');
                                                                $cui->draw },
                                            } 
                              ],
        );
    $cui->disable_timer('clock');
    $help->draw;
    $help->focus;
}

=head1 COPYRIGHT & LICENSE

Copyright 2005 Shawn Boyette, All Rights Reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;