#! package NewsSurfer; use strict; use warnings; use Net::NNTP; use Date::Parse; use Date::Format; use Convert::UU qw(uuencode); use Convert::BulkDecoder; use Tk::ResizeButton; use Tk::ProgressBar; use Tk::ItemStyle; use Tk::ROText; use Tk::HList; use Tk; #Optional Modules# #Declarations# my $VERSION = 1.0; dbmopen(my %OPT, "settings", 0600) or warn "Cannot create settings $!"; dbmopen(my %SBSCRIBE, "sbscribe", 0600) or warn "Cannot create sbscribe $!"; my (%multi, $grp, $atch,); my $sort_cnt = 3; my $mw = MainWindow->new(); $mw->title("NewsSurfer"); $mw->geometry("+0+16"); news_gui(); Tk::MainLoop(); dbmclose(%SBSCRIBE); dbmclose(%OPT); 1; #Subroutines# sub news_gui #---------------------------------------------------------- { #Widget Initialization my $b1_scan = $mw->Button(-activeforeground => '#ffff00', -text => 'Scan', -width => '5', -borderwidth => .5,); my $b2_grab = $mw->Button(-activeforeground => '#ffff00', -text => 'Grab', -width => '5', -borderwidth => .5,); my $b3_read = $mw->Button(-activeforeground => '#ffff00', -text => 'Read', -width => '5', -borderwidth => .5,); my $b4_post = $mw->Button(-activeforeground => '#ffff00', -text => 'Post', -width => '5', -borderwidth => .5,); my $b5_reset = $mw->Button(-activeforeground => '#ffff00', -text => 'Reset', -width => '5', -borderwidth => .5,); our $b6_grp = $mw->Button(-activeforeground => '#ffff00', -text => 'Groups', -width => '5', -borderwidth => .5,); my $b7_opt = $mw->Button(-activeforeground => '#ffff00', -text => 'Options', -width => '5', -borderwidth => .5,); my $b8_help = $mw->Button(-activeforeground => '#ffff00', -text => 'Help', -width => '5', -borderwidth => .5,); my $b9_exit = $mw->Button(-activeforeground => '#ffff00', -text => 'Exit', -width => '5', -borderwidth => .5,); my $lab1 = $mw->Label(-font => '{Courier New} 16', -text => 'NewsSurfer',); our $lb1_grp = $mw->Scrolled('HList', -scrollbars => 'osoe', -columns => 2, -header => 1, -indicator => 1, -indicatorcmd => sub {}, -background => '#ffffff', -foreground => '#000000', -selectbackground => '#000000', -selectforeground => '#fff000', -selectmode => 'single',); our $lb2_msg = $mw->Scrolled('HList', -scrollbars => 'osoe', -columns => 6, -header => 1, -indicator => 1, -indicatorcmd => sub {}, -background => '#ffffff', -foreground => '#000000', -selectbackground => '#000000', -selectforeground => '#fff000', -selectmode => 'extended',); my $h1 = $lb2_msg->ResizeButton(-text => 'Headers', -font => '{Arial} 7', -relief => 'flat', -borderwidth => 0, -command => sub {&lb2_msg_sort1(0)}, -widget => \$lb2_msg, -column => 0, -anchor => 'w', -takefocus => 0,); my $h2 = $lb2_msg->ResizeButton(-text => 'From', -font => '{Arial} 7', -relief => 'flat', -borderwidth => 0, -command => sub {&lb2_msg_sort1(1)}, -widget => \$lb2_msg, -column => 1, -anchor => 'w', -takefocus => 0,); my $h3 = $lb2_msg->ResizeButton(-text => 'Parts', -font => '{Arial} 7', -relief => 'flat', -borderwidth => 0, -command => sub {&lb2_msg_sort2(6)}, -widget => \$lb2_msg, -column => 2, -anchor => 'w', -takefocus => 0,); my $h4 = $lb2_msg->ResizeButton(-text => 'Bytes', -font => '{Arial} 7', -relief => 'flat', -borderwidth => 0, -command => sub {&lb2_msg_sort2(5)}, -widget => \$lb2_msg, -column => 3, -anchor => 'w', -takefocus => 0,); my $h5 = $lb2_msg->ResizeButton(-text => 'Date', -font => '{Arial} 7', -relief => 'flat', -borderwidth => 0, -command => sub {&lb2_msg_sort3(2)}, -widget => \$lb2_msg, -column => 4, -anchor => 'w', -takefocus => 0,); our $tl1 = $mw->Toplevel(); $tl1->title('NewsSurfer'); $tl1->focusmodel('active'); $tl1->resizable(0, 0); $tl1->transient($mw); $tl1->withdraw; $tl1->geometry("300x60+220+260"); my $lab1_Pbar = $tl1->Label(-text => 'Working...',); my $f1_Pbar = $tl1->Frame(-borderwidth => 2, -relief => 'sunken',); my $pb1_Pbar = $f1_Pbar->ProgressBar(-width => 20, -length => 300, -from => 0, -to => 100, -blocks => 50, -colors => [0, 'green'], -variable => \our $pb,); our $tl2 = $mw->Toplevel(); $tl2->title('Post Message'); $tl2->resizable(0, 0); $tl2->transient($mw); $tl2->withdraw; my $lab1_post = $tl2->Label(-text => 'From:', -width => 5,); my $lab2_post = $tl2->Label(-text => 'Subject:', -width => 5,); my $ent1_post = $tl2->Entry(-width => 60, -textvariable => \our $from); my $ent2_post = $tl2->Entry(-width => 60, -textvariable => \our $subj); our $txt_post = $tl2->Scrolled('Text', -scrollbars => 'osoe', -background => '#ffffff', -foreground => '#000000', -height => 30, -width => 80, -wrap => 'none'); my $b1_post = $tl2->Button(-text => 'Cancel', -activeforeground => '#fff000',); my $b2_post = $tl2->Button(-text => 'Attach', -activeforeground => '#fff000',); my $b3_post = $tl2->Button(-text => ' Post ', -activeforeground => '#fff000',); our $tl3 = $mw->Toplevel(); $tl3->title('Groups'); $tl3->geometry("+105+70"); $tl3->resizable(0, 0); $tl3->transient($mw); $tl3->withdraw; our $lb_grp = $tl3->Scrolled('HList', -scrollbars => 'osoe', -columns => 2, -header => 1, -indicator => 1, -indicatorcmd => sub {}, -background => '#000000', -foreground => '#ffffff', -selectbackground => '#fff000', -selectforeground => '#000000', -selectmode => 'extended', -height => 30,); our $b1_grp = $tl3->Button(-text => 'Close', -width => 10, -activeforeground => '#fff000',); our $b2_grp = $tl3->Button(-text => 'Update', -width => 10, -activeforeground => '#fff000',); our $b3_grp = $tl3->Button(-text => 'Subscribe', -width => 10, -activeforeground => '#fff000',); our $b4_grp = $tl3->Button(-text => 'UnSubscribe', -width => 10, -activeforeground => '#fff000',); our $tl4 = $mw->Toplevel(); $tl4->title('Read Message'); $tl4->transient($mw); $tl4->withdraw; our $txt_read = $tl4->Scrolled('ROText', -scrollbars => 'osoe', -background => '#ffffff', -foreground => '#000000', -wrap => 'none', -width => 80, -height => 30,); my $b1_read = $tl4->Button(-text => 'Close', -width => 10, -activeforeground => '#fff000',); my $b2_read = $tl4->Button(-text => 'Reply', -width => 10, -activeforeground => '#fff000',); our $tl5 = $mw->Toplevel(-background => '#000000'); $tl5->title('Options'); $tl5->geometry("+105+70"); $tl5->resizable(0, 0); $tl5->transient($mw); $tl5->withdraw; my $l1_conf = $tl5->Label(-text => 'Server: ', -width => 15, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $l2_conf = $tl5->Label(-text => 'Port: ', -width => 5, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $l3_conf = $tl5->Label(-text => 'Username: ', -width => 15, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $l4_conf = $tl5->Label(-text => 'Password: ', -width => 15, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $l5_conf = $tl5->Label(-text => 'EMail: ', -width => 15, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $l6_conf = $tl5->Label(-text => "Download Dir: ", -width => 15, -background => '#000000', -foreground => '#ffffff', -anchor => 'e',); my $e1_conf = $tl5->Entry(-width => 30, -textvariable => \$OPT{Serv},); my $e2_conf = $tl5->Entry(-width => 5, -textvariable => \$OPT{Port},); my $e3_conf = $tl5->Entry(-width => 30, -textvariable => \$OPT{User},); my $e4_conf = $tl5->Entry(-width => 30, -show => '*', -textvariable => \$OPT{Pass},); my $e5_conf = $tl5->Entry(-width => 30, -textvariable => \$OPT{Mail},); my $e6_conf = $tl5->Entry(-width => 60, -textvariable => \$OPT{DDir},); my $b1_conf = $tl5->Button(-text => 'Close', -width => 5, -borderwidth => 0, -relief => 'flat', -foreground => '#ffffff', -background => '#000000', -activeforeground => '#fff000', -activebackground => '#000000',); our $tl6 = $mw->Toplevel(); $tl6->title('Help'); $tl6->geometry("+105+70"); $tl6->resizable(0, 0); $tl6->transient($mw); $tl6->withdraw; our $txt_help = $tl6->Scrolled('ROText', -scrollbars => 'e', -background => '#000000', -foreground => '#ffffff', -wrap => 'none', -width => 80, -height => 20,); my $b1_help = $tl6->Button(-activeforeground => '#ffff00', -text => 'Close', -width => 10,); my $b2_help = $tl6->Button(-activeforeground => '#ffff00', -text => 'About', -width => 10,); #Widget Configuration $tl1->protocol(WM_DELETE_WINDOW => sub {$tl1->withdraw}); $tl2->protocol(WM_DELETE_WINDOW => \&b1_post_cancel); $tl3->protocol(WM_DELETE_WINDOW => \&b1_grp_close); $tl4->protocol(WM_DELETE_WINDOW => \&b1_read_close); $tl5->protocol(WM_DELETE_WINDOW => sub {$tl5->withdraw}); $tl6->protocol(WM_DELETE_WINDOW => sub {$tl6->withdraw}); $b1_scan ->configure(-command => \&b1_scan_cmd); $b2_grab ->configure(-command => \&b2_grab_cmd); $b3_read ->configure(-command => \&b3_read_cmd); $b4_post ->configure(-command => \&b4_post_cmd); $b5_reset ->configure(-command => \&b5_reset_cmd); $b6_grp ->configure(-command => \&b6_grp_cmd); $b7_opt ->configure(-command => \&b7_opt_cmd); $b8_help ->configure(-command => \&b8_help_cmd); $b9_exit ->configure(-command => \&b9_exit_cmd); $b1_grp ->configure(-command => \&b1_grp_close); $b2_grp ->configure(-command => \&b2_grp_update); $b3_grp ->configure(-command => \&b3_grp_subscribe); $b4_grp ->configure(-command => \&b4_grp_unsubscribe); $b1_read->configure(-command => \&b1_read_close); $b2_read->configure(-command => \&b2_read_reply); $b1_post->configure(-command => \&b1_post_cancel); $b2_post->configure(-command => \&b2_post_attach); $b3_post->configure(-command => \&b3_post_post); $b1_conf->configure(-command => sub {$tl5->withdraw;}); $b1_help->configure(-command => sub {$tl6->withdraw;}); $b2_help->configure(-command => \&help_about); $lb_grp ->columnWidth (0, -char => '70'); $lb_grp ->columnWidth (1, -char => '20'); $lb_grp ->headerCreate(0, -text => "Newsgroups",); $lb_grp ->headerCreate(1, -text => "Message Count",); $lb1_grp->columnWidth (0, -char => '88'); $lb1_grp->columnWidth (1, -char => '28'); $lb1_grp->headerCreate(0, -text => "Group",); $lb1_grp->headerCreate(1, -text => "Last Scanned",); $lb2_msg->columnWidth (0, -char => '70'); $lb2_msg->columnWidth (1, -char => '10'); $lb2_msg->columnWidth (2, -char => '7'); $lb2_msg->columnWidth (3, -char => '10'); $lb2_msg->columnWidth (4, -char => '22'); $lb2_msg->columnWidth (5, -char => ''); $lb2_msg->header('create', 0, -itemtype => 'window', -widget => $h1, -borderwidth => 1,); $lb2_msg->header('create', 1, -itemtype => 'window', -widget => $h2, -borderwidth => 1); $lb2_msg->header('create', 2, -itemtype => 'window', -widget => $h3, -borderwidth => 1); $lb2_msg->header('create', 3, -itemtype => 'window', -widget => $h4, -borderwidth => 1); $lb2_msg->header('create', 4, -itemtype => 'window', -widget => $h5, -borderwidth => 1); $lb2_msg->header('create', 5, -borderwidth => 1,); #Bindings $lb1_grp->bind('' => \&Tk::HList::Button1); $lb1_grp->bind('' => \&Tk::HList::ButtonRelease_1); $lb2_msg->bind('' => \&Tk::HList::Button1); $lb2_msg->bind('' => \&b3_read_cmd); $lb1_grp->bind('' => \&b1_scan_cmd); $lb2_msg->bind('' => \&message_delete); $lb1_grp->bind('' => sub {&b4_grp_unsubscribe('X')}); $lb2_msg->bind('' => \&lb2_msg_select_all); $lb2_msg->bind('' => \&lb2_msg_select_all); $lb2_msg->bind('' => \&message_delete); $lb2_msg->bind('' => \&message_delete); &BindMouseWheel($lb1_grp); &BindMouseWheel($lb2_msg); &BindMouseWheel($lb_grp); &BindMouseWheel($txt_read); &BindMouseWheel($txt_post); #Widget Placement $b1_scan->grid(-in => $mw, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => ''); $b2_grab->grid(-in => $mw, -columnspan => '1', -column => '4', -rowspan => '1', -row => '1', -sticky => ''); $b3_read->grid(-in => $mw, -columnspan => '1', -column => '6', -rowspan => '1', -row => '1', -sticky => ''); $b4_post->grid(-in => $mw, -columnspan => '1', -column => '8', -rowspan => '1', -row => '1', -sticky => ''); $b5_reset ->grid(-in => $mw, -columnspan => '1', -column => '10', -rowspan => '1', -row => '1', -sticky => ''); $b6_grp ->grid(-in => $mw, -columnspan => '1', -column => '12', -rowspan => '1', -row => '1', -sticky => ''); $b7_opt ->grid(-in => $mw, -columnspan => '1', -column => '14', -rowspan => '1', -row => '1', -sticky => ''); $b8_help->grid(-in => $mw, -columnspan => '1', -column => '16', -rowspan => '1', -row => '1', -sticky => ''); $b9_exit->grid(-in => $mw, -columnspan => '1', -column => '18', -rowspan => '1', -row => '1', -sticky => ''); $lab1 ->grid(-in => $mw, -columnspan => '3', -column => '19', -rowspan => '1', -row => '1', -sticky => 'news'); $lb1_grp->grid(-in => $mw, -columnspan => '19', -column => '2', -rowspan => '1', -row => '2', -sticky => 'news'); $lb2_msg->grid(-in => $mw, -columnspan => '19', -column => '2', -rowspan => '1', -row => '3', -sticky => 'news'); $lab1_Pbar ->grid(-in => $tl1, -columnspan => '3', -column => '1', -rowspan => '1', -row => '1', -sticky => 'sw'); $f1_Pbar ->grid(-in => $tl1, -columnspan => '1', -column => '2', -rowspan => '1', -row => '2', -sticky => 'new'); $pb1_Pbar ->grid(-in => $f1_Pbar, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'new'); $lab1_post ->grid(-in => $tl2, -columnspan => '1', -column => '2', -rowspan => '1', -row => '2', -sticky => 'w'); $lab2_post ->grid(-in => $tl2, -columnspan => '1', -column => '2', -rowspan => '1', -row => '3', -sticky => 'w'); $ent1_post ->grid(-in => $tl2, -columnspan => '4', -column => '3', -rowspan => '1', -row => '2', -sticky => 'w'); $ent2_post ->grid(-in => $tl2, -columnspan => '4', -column => '3', -rowspan => '1', -row => '3', -sticky => 'w'); $txt_post ->grid(-in => $tl2, -columnspan => '5', -column => '2', -rowspan => '1', -row => '5', -sticky => ''); $b1_post ->grid(-in => $tl2, -columnspan => '1', -column => '2', -rowspan => '1', -row => '7', -sticky => 'w'); $b2_post ->grid(-in => $tl2, -columnspan => '1', -column => '3', -rowspan => '1', -row => '7', -sticky => 'w'); $b3_post ->grid(-in => $tl2, -columnspan => '1', -column => '4', -rowspan => '1', -row => '7', -sticky => 'w'); $lb_grp ->grid(-in => $tl3, -columnspan => '9', -column => '2', -rowspan => '1', -row => '2', -sticky => 'news'); $b1_grp ->grid(-in => $tl3, -columnspan => '1', -column => '3', -rowspan => '1', -row => '4', -sticky => 'n'); $b2_grp ->grid(-in => $tl3, -columnspan => '1', -column => '5', -rowspan => '1', -row => '4', -sticky => 'n'); $b3_grp ->grid(-in => $tl3, -columnspan => '1', -column => '7', -rowspan => '1', -row => '4', -sticky => 'n'); $b4_grp ->grid(-in => $tl3, -columnspan => '1', -column => '9', -rowspan => '1', -row => '4', -sticky => 'n'); $txt_read ->grid(-in => $tl4, -columnspan => '3', -column => '2', -rowspan => '1', -row => '2', -sticky => 'news'); $b1_read ->grid(-in => $tl4, -columnspan => '1', -column => '2', -rowspan => '1', -row => '4', -sticky => 'n'); $b2_read ->grid(-in => $tl4, -columnspan => '1', -column => '4', -rowspan => '1', -row => '4', -sticky => 'n'); $l1_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => 'e'); $l2_conf ->grid(-in => $tl5, -columnspan => '1', -column => '4', -rowspan => '1', -row => '1', -sticky => 'e'); $l3_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '2', -sticky => 'e'); $l4_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '3', -sticky => 'e'); $l5_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '4', -sticky => 'e'); $l6_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '6', -sticky => 'e'); $e1_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '1', -sticky => 'w'); $e2_conf ->grid(-in => $tl5, -columnspan => '1', -column => '5', -rowspan => '1', -row => '1', -sticky => 'w'); $e3_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '2', -sticky => 'w'); $e4_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '3', -sticky => 'w'); $e5_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '4', -sticky => 'w'); $e6_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '6', -sticky => 'w'); $b1_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '8', -sticky => 'news'); $txt_help ->grid(-in => $tl6, -columnspan => '3', -column => '2', -rowspan => '1', -row => '1', -sticky => 'news'); $b1_help ->grid(-in => $tl6, -columnspan => '1', -column => '2', -rowspan => '1', -row => '3', -sticky => 'n'); $b2_help ->grid(-in => $tl6, -columnspan => '1', -column => '4', -rowspan => '1', -row => '3', -sticky => 'n'); #Grid Configuration $mw->gridRowconfigure(1, -weight => 0, -minsize => 40,); $mw->gridRowconfigure(2, -weight => 0, -minsize => 100,); $mw->gridRowconfigure(3, -weight => 1, -minsize => 326,); $mw->gridRowconfigure(4, -weight => 0, -minsize => 8,); $mw->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $mw->gridColumnconfigure(2, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(3, -weight => 0, -minsize => 10,); $mw->gridColumnconfigure(4, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(5, -weight => 0, -minsize => 2,); $mw->gridColumnconfigure(6, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(7, -weight => 0, -minsize => 2,); $mw->gridColumnconfigure(8, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(9, -weight => 0, -minsize => 2,); $mw->gridColumnconfigure(10, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(11, -weight => 0, -minsize => 10,); $mw->gridColumnconfigure(12, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(13, -weight => 0, -minsize => 2,); $mw->gridColumnconfigure(14, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(15, -weight => 0, -minsize => 10,); $mw->gridColumnconfigure(16, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(17, -weight => 0, -minsize => 2,); $mw->gridColumnconfigure(18, -weight => 0, -minsize => 40,); $mw->gridColumnconfigure(19, -weight => 1, -minsize => 10,); $mw->gridColumnconfigure(20, -weight => 0, -minsize => 340,); $mw->gridColumnconfigure(21, -weight => 0, -minsize => 8,); $tl1->gridRowconfigure(1, -weight => 0, -minsize => 8, ); $tl1->gridRowconfigure(2, -weight => 1, -minsize => 40, ); $tl1->gridColumnconfigure(1, -weight => 0, -minsize => 16,); $tl1->gridColumnconfigure(2, -weight => 1, -minsize => 40,); $tl1->gridColumnconfigure(3, -weight => 0, -minsize => 16,); $tl2->gridRowconfigure(1, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(2, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(3, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(4, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(5, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(6, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(7, -weight => 0, -minsize => 8,); $tl2->gridRowconfigure(8, -weight => 0, -minsize => 8,); $tl2->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $tl2->gridColumnconfigure(2, -weight => 0, -minsize => 40,); $tl2->gridColumnconfigure(3, -weight => 0, -minsize => 40,); $tl2->gridColumnconfigure(4, -weight => 0, -minsize => 40,); $tl2->gridColumnconfigure(5, -weight => 0, -minsize => 400,); $tl2->gridColumnconfigure(6, -weight => 0, -minsize => 40,); $tl2->gridColumnconfigure(7, -weight => 0, -minsize => 8,); $tl3->gridRowconfigure(1, -weight => 0, -minsize => 8,); $tl3->gridRowconfigure(2, -weight => 0, -minsize => 8,); $tl3->gridRowconfigure(3, -weight => 0, -minsize => 8,); $tl3->gridRowconfigure(4, -weight => 0, -minsize => 8,); $tl3->gridRowconfigure(5, -weight => 0, -minsize => 8,); $tl3->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $tl3->gridColumnconfigure(2, -weight => 0, -minsize => 140,); $tl3->gridColumnconfigure(3, -weight => 0, -minsize => 20,); $tl3->gridColumnconfigure(4, -weight => 0, -minsize => 2,); $tl3->gridColumnconfigure(5, -weight => 0, -minsize => 20,); $tl3->gridColumnconfigure(6, -weight => 0, -minsize => 2,); $tl3->gridColumnconfigure(7, -weight => 0, -minsize => 20,); $tl3->gridColumnconfigure(8, -weight => 0, -minsize => 2,); $tl3->gridColumnconfigure(9, -weight => 0, -minsize => 20,); $tl3->gridColumnconfigure(10, -weight => 0, -minsize => 152,); $tl3->gridColumnconfigure(11, -weight => 0, -minsize => 8,); $tl4->gridRowconfigure(1, -weight => 0, -minsize => 8,); $tl4->gridRowconfigure(2, -weight => 1, -minsize => 8,); $tl4->gridRowconfigure(3, -weight => 0, -minsize => 8,); $tl4->gridRowconfigure(4, -weight => 0, -minsize => 8,); $tl4->gridRowconfigure(5, -weight => 0, -minsize => 8,); $tl4->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $tl4->gridColumnconfigure(2, -weight => 0, -minsize => 20,); $tl4->gridColumnconfigure(3, -weight => 1, -minsize => 300,); $tl4->gridColumnconfigure(4, -weight => 0, -minsize => 20,); $tl4->gridColumnconfigure(5, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(1, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(2, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(3, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(4, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(5, -weight => 0, -minsize => 10,); $tl5->gridRowconfigure(6, -weight => 0, -minsize => 8,); $tl5->gridRowconfigure(7, -weight => 0, -minsize => 202,); $tl5->gridRowconfigure(8, -weight => 0, -minsize => 8,); $tl5->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $tl5->gridColumnconfigure(2, -weight => 0, -minsize => 20,); $tl5->gridColumnconfigure(3, -weight => 0, -minsize => 220,); $tl5->gridColumnconfigure(4, -weight => 0, -minsize => 50,); $tl5->gridColumnconfigure(5, -weight => 0, -minsize => 50,); $tl5->gridColumnconfigure(6, -weight => 0, -minsize => 8,); $tl6->gridRowconfigure(1, -weight => 0, -minsize => 236,); $tl6->gridRowconfigure(2, -weight => 0, -minsize => 8,); $tl6->gridRowconfigure(3, -weight => 0, -minsize => 10,); $tl6->gridRowconfigure(4, -weight => 0, -minsize => 8,); $tl6->gridColumnconfigure(1, -weight => 0, -minsize => 8,); $tl6->gridColumnconfigure(2, -weight => 0, -minsize => 10,); $tl6->gridColumnconfigure(3, -weight => 0, -minsize => 320,); $tl6->gridColumnconfigure(4, -weight => 0, -minsize => 10,); $tl6->gridColumnconfigure(5, -weight => 0, -minsize => 8,); #Defaults &display_groups(); $lb1_grp->focus(); unless ($OPT{DDir}) {$OPT{DDir} = '.';} unless ($OPT{Port}) {$OPT{Port} = '119';} unless ($OPT{Mail}) {$OPT{Mail} = 'NewsSurfer@domain.invalid';} unless (-e "$OPT{DDir}" && -d "$OPT{DDir}") {$OPT{DDir} = '.';} #Callbacks sub b1_scan_cmd #------------------------------------------------ { my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; #group $lb2_msg->delete('all'); my @xxx = $lb1_grp->selectionGet; unless ($xxx[0]) {goto not_selected;} $grp = $lb1_grp->itemCget($xxx[0], 0, -text); not_selected: warn "Must select a group to scan\a\n" and goto scan_end unless ($grp); $pb = 0; $mw->Busy(-recurse => 1,); $tl1->deiconify(); $tl1->raise(); $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; #login my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); $nntp->authinfo("$OPT{User}", "$OPT{Pass}"); $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; #range my @nfo = $nntp->group($grp); shift @nfo; pop @nfo; my $rng = \@nfo; $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { #remove expired articles $line =~ m/(\d+)~::~/; if ($1){if ($1 < $nfo[0]) {goto expired;}} #load valid articles my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "old"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; expired: } #new range $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; my @keys = (keys %file); @keys = sort {$b <=> $a} @keys; my $last = $keys[0]; $last++; print "last+1 is: $last\n"; print "nfo0 is: $nfo[0] and nfo1 is: $nfo[1]\n"; if ($last <= $nfo[1]) { undef $rng; shift @nfo; unshift (@nfo, "$last"); $rng = \@nfo; } else {$nntp->quit(); print "no new msgs\n"; goto no_new_msgs;} $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; } #overview my $href = $nntp->xover($rng); my %xover = %$href; undef $href; $nntp->quit(); $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; #(%xover is a HoA) $_ is msgnum #$xover{$_}[0] #subject #$xover{$_}[4] #references *new/old* #$xover{$_}[1] #from #$xover{$_}[5] #bytes #$xover{$_}[2] #date #$xover{$_}[6] #lines *parts* #$xover{$_}[3] #message-id #$xover{$_}[7] #xref:full *read* #multipart $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; my $subj_sav = ' '; undef %multi; #(%multi is a HoH) subj->part = msg id for my $k (keys %xover) { if ($xover{$k}[0] =~ m/(.+)[(\[\{]+?(\d+)[\/\-]+?(\d+)[)\]\}]+?(.*)/) { #$1 = subj, $2 = part, $3 = total, $4 = more subj my $newsubj = "$1"."$4"; $multi{$newsubj}{$2} = "$xover{$k}[3]"; if ($1 ne $subj_sav) { $subj_sav = $1; $xover{$k}[6] = $3; $xover{$k}[0] = "$newsubj"; }else {delete $xover{$k};} }else {$xover{$k}[6] = 1;} } #save %multi to file #HoA subj->msgids(in order) open (FH, "> $grp.dat"); for my $k1 (keys %multi) { print FH "$k1"; for my $k2 (sort keys %{$multi{$k1}}) { print FH "~::~$multi{$k1}{$k2}"; }print FH "\n"; }close FH; #duplicates my @dups; for my $k (keys %xover) { if ($xover{$k}) { push (@dups, "$k:^:$xover{$k}[0]$xover{$k}[1]$xover{$k}[6]") } } my %seen = ( ); my @remove; foreach my $line (@dups) { $line =~ m/(.+):\^:(.+)/; $line = $2; push(@remove, $1) if $seen{$line}++; }undef %seen; undef @dups; foreach (@remove) {delete $xover{$_};} #time/date $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; for (keys %xover) { my $epoch = str2time($xover{$_}[2]); chomp($xover{$_}[2] = ctime($epoch)); } $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; #populate new messages my $lb2_b1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); my $lb2_b2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); my $time; my @xkey = keys %xover; @xkey = sort{$b <=> $a} @xkey; foreach (@xkey) { if ($pb >= 100) {$pb = 0;} if (!defined $time || Tk::timeofday()-$time > 7) {$pb += 5; $mw->update; $time = Tk::timeofday();} $lb2_msg->add($_); $lb2_msg->itemCreate($_, 0, -itemtype => 'text', -style => $lb2_b2, -text => "$xover{$_}[0]"); $lb2_msg->itemCreate($_, 1, -itemtype => 'text', -style => $lb2_b2, -text => "$xover{$_}[1]"); $lb2_msg->itemCreate($_, 2, -itemtype => 'text', -style => $lb2_b1, -text => "$xover{$_}[6]"); $lb2_msg->itemCreate($_, 3, -itemtype => 'text', -style => $lb2_b1, -text => "$xover{$_}[5]"); $lb2_msg->itemCreate($_, 4, -itemtype => 'text', -style => $lb2_b1, -text => "$xover{$_}[2]"); }undef @xkey; #populate old messages no_new_msgs: my $t; my @fkey = keys %file; @fkey = sort{$b <=> $a} @fkey; my $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); my $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); foreach (@fkey) { if ($pb >= 100) {$pb = 0;} if (!defined $t || Tk::timeofday()-$t > 7) {$pb += 5; $mw->update; $t = Tk::timeofday();} $lb2_msg->add($_); $lb2_msg->itemCreate($_, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$_}[0]",); $lb2_msg->itemCreate($_, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$_}[1]"); $lb2_msg->itemCreate($_, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$_}[6]"); $lb2_msg->itemCreate($_, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$_}[5]"); $lb2_msg->itemCreate($_, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$_}[2]"); if ($file{$_}[7] eq 'read') { $lb2_msg->indicator('create', $_, -itemtype => 'image', -image => $chek); } }undef @fkey; #save to group file open (FH, "> $grp.grp") or warn "\aWarning: Cannot create $grp.grp $!"; if (\*FH) { for my $k (keys %xover) { print FH "$k~::~". "$xover{$k}[0]~::~$xover{$k}[1]~::~". "$xover{$k}[2]~::~$xover{$k}[3]~::~". "$xover{$k}[4]~::~$xover{$k}[5]~::~". "$xover{$k}[6]~::~$xover{$k}[7]~::~"; print FH "\n"; } for my $k (keys %file) { print FH "$k~::~". "$file{$k}[0]~::~$file{$k}[1]~::~". "$file{$k}[2]~::~$file{$k}[3]~::~". "$file{$k}[4]~::~$file{$k}[5]~::~". "$file{$k}[6]~::~$file{$k}[7]~::~"; print FH "\n"; }close FH; $pb += 5; $tl1->update; } #update Last Scanned my $stime = ctime(time); chomp $stime; $SBSCRIBE{"$grp"} = "$stime"; &display_groups(); $pb = 100; $mw->update; $tl1->withdraw; scan_end: $mw->Unbusy; $lb2_msg->focus; } sub message_delete #------------------------------------------------ { my @sel = $lb2_msg->selectionGet; #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } } foreach (@sel) {$lb2_msg->hide('entry', $_); delete $file{$_};} $lb2_msg->selectionClear; #update grp file open (FH, "> $grp.grp") or warn "\aCannot open $grp.grp $!"; if (\*FH) { for my $k (keys %file) { print FH "$k~::~". "$file{$k}[0]~::~$file{$k}[1]~::~". "$file{$k}[2]~::~$file{$k}[3]~::~". "$file{$k}[4]~::~$file{$k}[5]~::~". "$file{$k}[6]~::~$file{$k}[7]~::~"; print FH "\n"; }close FH; } } sub b2_grab_cmd #------------------------------------------------ { my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; $pb = 0; $mw->Busy; $tl1->deiconify(); $tl1->raise(); #connect my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); $nntp->authinfo("$OPT{User}", "$OPT{Pass}"); $pb += 5; $mw->update; #get selection(s) my @grabs = $lb2_msg->selectionGet; foreach my $msgnum (@grabs) { #read subject my $subje = $lb2_msg->itemCget($msgnum, 0, -text); my $parts = $lb2_msg->itemCget($msgnum, 2, -text); #lookup subject my (@art, $aref,); if ($parts > 1) { #load %multipart from file #(%multipart) is a HoA subj->msgids(in order) my %multipart; open (FH, "< $grp.dat") or warn "\aCannot open $grp.dat.\n$!"; my @multpart = (); close FH; foreach (@multpart) { my @multi = split('~::~', "$_"); my $k1 = shift @multi; $multipart{$k1} = [@multi]; } foreach my $msgid (@{$multipart{$subje}}) { #download msg ids for subject $pb++;$mw->update;$pb++;$mw->update; $pb++;$mw->update;$pb++;$mw->update; $pb++;$mw->update;$pb++;$mw->update; $pb = 0 if ($pb > 99); $aref = $nntp->article("$msgid"); push (@art, @$aref); }}else { $nntp->group($grp); $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $pb += 5; $tl1->update; $aref = $nntp->article("$msgnum"); push (@art, @$aref); } #convert $pb += 5; $mw->update; my $cvt = new Convert::BulkDecoder(destdir => "$OPT{DDir}", crc => 0,); my $res = $cvt->decode(\@art); if ($res eq 'DUP') {warn "\aFile already exists. $!\n";} if ($res ne "OK") { warn "\aUnable to decode attachment. $res $!\," }else{ print "Extracted ", $cvt->{size}, " bytes to file ", $cvt->{file}, "\n"; } #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } }$file{$msgnum}[7] = 'read'; #update grp file open (FH, "> $grp.grp") or warn "\aCannot open $grp.grp $!"; if (\*FH) { for my $k (keys %file) { print FH "$k~::~". "$file{$k}[0]~::~$file{$k}[1]~::~". "$file{$k}[2]~::~$file{$k}[3]~::~". "$file{$k}[4]~::~$file{$k}[5]~::~". "$file{$k}[6]~::~$file{$k}[7]~::~"; print FH "\n"; }close FH; } #mark read if ($file{$msgnum}[7] eq 'read') { $lb2_msg->indicator('create', $msgnum, -itemtype => 'image', -image => $chek); }$pb = 100; $mw->update; }$nntp->quit(); $tl1->withdraw; $mw->Unbusy; } sub b3_read_cmd #------------------------------------------------ { my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; $tl4->deiconify(); $tl4->raise(); $tl4->Busy; my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); $nntp->authinfo("$OPT{User}", "$OPT{Pass}"); $nntp->group($grp); my @sel = $lb2_msg->selectionGet; my $msg = $nntp->article($sel[0]); $nntp->quit(); $tl4->Unbusy; foreach (@$msg) {$txt_read->insert('end', "$_");} undef $msg; $txt_read->focus; $tl4->update; #load grp file my (%file, $time,); if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { if (!defined $time || Tk::timeofday()-$time > .5) {$pb += 5; $mw->update; $time = Tk::timeofday();} my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } }$file{$sel[0]}[7] = 'read'; #update grp file open (FH, "> $grp.grp") or warn "\aCannot open $grp.grp $!"; if (\*FH) { for my $k (keys %file) { if (!defined $time || Tk::timeofday()-$time > .5) {$pb += 5; $mw->update; $time = Tk::timeofday();} print FH "$k~::~". "$file{$k}[0]~::~$file{$k}[1]~::~". "$file{$k}[2]~::~$file{$k}[3]~::~". "$file{$k}[4]~::~$file{$k}[5]~::~". "$file{$k}[6]~::~$file{$k}[7]~::~"; print FH "\n"; }close FH; } #mark read if ($file{$sel[0]}[7] eq 'read') { $lb2_msg->indicator('create', $sel[0], -itemtype => 'image', -image => $chek); }$mw->update; } sub b1_read_close #------------------------------------------------ {$txt_read->delete("1.0", 'end'); $tl4->withdraw;} sub b2_read_reply #------------------------------------------------ { my $txt = $txt_read->get("1.0", 'end'); $txt_read->delete("1.0", 'end'); $tl4->withdraw; open (FH, "> nstemp.tmp"); print FH "$txt"; close FH; open (FH, "< nstemp.tmp"); my @tmp = (); close FH; unlink "nstemp.tmp" or warn "\aCannot delete nstemp.tmp $!"; undef $txt; my $counter = 0; foreach (@tmp) { my $a; $_ =~ m/(.*)/; unless ($1) {$counter++;} $_ =~ m/(Subject:\s+?)(.*)/; if ($2) {$a = $2; if ($a =~ m/[Rr][Ee]:.*/) {$subj = $a;} else {$subj = "Re: $a";}} if ($counter >= 1) {$txt .= ">$_";} } $txt_post->insert('end', "$txt"); &b4_post_cmd(); } sub b4_post_cmd #------------------------------------------------ { unless ($grp) {warn "Must select a group to post to.\a\n"; goto post_end;} $tl2->deiconify(); $tl2->raise(); $txt_post->focus; $from = $OPT{Mail}; post_end: } sub b1_post_cancel #------------------------------------------------ {$txt_post->delete("1.0", 'end'); undef $subj; $tl2->withdraw();} sub b2_post_attach #------------------------------------------------ { undef $atch; my $file = $mw->getOpenFile(); if (defined $file) { open (FH, "$file") or warn "\aCannot open $file $!"; $file =~ m/.+\/(.+)/; my $filename = $1; $atch = uuencode(\*FH, $filename); close FH; } } sub b3_post_post #------------------------------------------------ { my $hdr = 'Newsgroups: '."$grp\n". 'Distribution: '."world\n". 'X-NNTPclient: '."Just another Perl hacker..\n". 'From: '."$from\n". 'Subject: '."$subj\n\n\n"; my $bdy = $txt_post->get("1.0", 'end'); my $msg = "$hdr"."$bdy\n\n"; if ($atch) {$msg .= $atch; undef $atch;} open (FH, '> posttemp.tmp') or warn "\aCant create posttemp.tmp $!"; print FH "$msg"; close FH; open (FH, '< posttemp.tmp') or warn "\aCant open posttemp.tmp $!"; my @msg_array = (); close FH; unlink 'posttemp.tmp'; my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); $nntp->authinfo("$OPT{User}", "$OPT{Pass}"); print "msg_array has $#msg_array elements\n"; print "$msg"; undef $msg; $nntp->post(@msg_array); $nntp->quit; &b1_post_cancel(); } sub b5_reset_cmd #------------------------------------------------ { $lb2_msg->delete('all'); my $sel = $lb1_grp->selectionGet; my $rem = $lb1_grp->itemCget($sel, 0, -text); if (-e "$rem.grp") { unlink "$rem.grp" or warn "\aUnable to delete $rem.grp $!" and goto b5_reset_end; } if (-e "$rem.dat") { unlink "$rem.dat" or warn "\aUnable to delete $rem.grp $!" and goto b5_reset_end; } $SBSCRIBE{$rem} = 'Never'; &display_groups(); b5_reset_end: } sub b6_grp_cmd #------------------------------------------------ { $tl1->deiconify(); $tl1->raise(); $pb = 0; $mw->update; $tl3->deiconify(); $tl3->raise(); $tl1->focus; $tl3->Busy; $b1_grp->configure(-state => 'disabled'); $b2_grp->configure(-state => 'disabled'); $b3_grp->configure(-state => 'disabled'); $b4_grp->configure(-state => 'disabled'); my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA8Km48'. 'K2srF2UmE18oE2MeB2EtFW82IHI3LVIsJToAAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAEhAW0xDYT44TDcyQj'. 'UxPzMvPDg0Qj81V05FZsO72gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKyosLi0y'. 'RURHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABISEQAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; if (-e 'groups') { open (FH, '< groups') or warn "Cannot open groups\n$!" and goto cant_open; my @groups = (); close FH; $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; $pb++; $tl1->update; my $counter = 0; my $time; foreach my $line (@groups) { if ($pb >= 100) {$pb = 0;} if (!defined $time || Tk::timeofday()-$time > 7) {$pb += 5; $mw->update; $time = Tk::timeofday();} #(@row) groupname, last, first my @row = split('~::~', $line); my $tot = $row[1] - $row[2]; $lb_grp->add($counter); $lb_grp->itemCreate($counter, 0, -text => "$row[0]"); $lb_grp->itemCreate($counter, 1, -text => "$tot"); if ($SBSCRIBE{$row[0]}) { $lb_grp->indicator('create', $counter, -itemtype => 'image', -image => $chek); }$counter++; }$pb = 100; }else{ cant_open: $lb_grp->add(0); $lb_grp->itemCreate(0, 0, -text => 'Press the Update button'. ' to retrieve groups from server.'); }$mw->update; $tl1->withdraw; $lb_grp->focus; $tl3->Unbusy; $b1_grp->configure(-state => 'normal'); $b2_grp->configure(-state => 'normal'); $b3_grp->configure(-state => 'normal'); $b4_grp->configure(-state => 'normal'); } sub b1_grp_close #------------------------------------------------- {$lb_grp->delete('all'); $tl3->withdraw; $mw->update;} sub b2_grp_update #------------------------------------------------- { $tl3->Busy; $lb_grp->delete('all'); my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); $nntp->authinfo("$OPT{User}", "$OPT{Pass}"); my $listref = $nntp->list(); $nntp->quit(); open (FH, '> groups') or warn "\aCant create local groups\n$!"; my %HoA = %$listref; undef $listref; #(HoA) groupname = last, first, moderated #pl.misc.telefonia.gsm: 0000339959 0000307277 y #mvis.lists.apache.talk: 0000003574 0000003322 m for (sort keys %HoA) {print FH "$_~::~$HoA{$_}[0]~::~$HoA{$_}[1]\n"; undef $_;} close FH; $tl3->Unbusy; &b1_grp_close(); $b6_grp->invoke; } sub b3_grp_subscribe #-------------------------------------------- { my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA8Km48'. 'K2srF2UmE18oE2MeB2EtFW82IHI3LVIsJToAAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAEhAW0xDYT44TDcyQj'. 'UxPzMvPDg0Qj81V05FZsO72gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKyosLi0y'. 'RURHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABISEQAAAAAAAAAAAAAAA'. 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; my @sel = $lb_grp->selectionGet; foreach (@sel) {my $a = $lb_grp->itemCget($_, 0, -text); $lb_grp->indicator('create', $_, -itemtype => 'image', -image => $chek); $SBSCRIBE{$a} = 'Never';} &display_groups(); } sub b4_grp_unsubscribe #-------------------------------------------- { my $opt = $_[0]; if ($opt) { my $sel = $lb1_grp->selectionGet; my $a = $lb1_grp->itemCget($sel, 0, -text); delete $SBSCRIBE{$a}; if (-e "$a.grp") {unlink "$a.grp" or warn "\aUnable to delete $a.grp\n$!";} if (-e "$a.dat") {unlink "$a.dat" or warn "\aUnable to delete $a.dat\n$!";} goto b4_grp_unsubscribe_end; } my @sel = $lb_grp->selectionGet; foreach (@sel) { my $a = $lb_grp->itemCget($_, 0, -text); $lb_grp->indicator('delete', $_,); delete $SBSCRIBE{$a}; if (-e "$a.grp") {unlink "$a.grp" or warn "\aUnable to delete $a.grp\n$!";} if (-e "$a.dat") {unlink "$a.dat" or warn "\aUnable to delete $a.dat\n$!";} }b4_grp_unsubscribe_end: &display_groups(); } sub b7_opt_cmd #------------------------------------------------ {$tl5->deiconify(); $tl5->raise();} sub b8_help_cmd #------------------------------------------------ { $tl6->deiconify(); $tl6->raise(); $txt_help->focus; $txt_help->delete("1.0", 'end'); $txt_help->insert('end', "See About.\n\n". "More help in next version.\n"); } sub help_about #------------------------------------------------ { $txt_help->delete("1.0", 'end'); $txt_help->insert('end', "NewsSurfer - Copyright 2004\n\n". "Created by: Jason David McManus\n". 'Contact : QoS@'."cpan.org\n". 'Or : $_@_.%_'." on c.l.p.tk\n"); } sub b9_exit_cmd #------------------------------------------------ {exit;} sub lb2_msg_select_all #-------------------------------------------- { #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; } } #select all my @paths = sort(keys %file); my $last = $#paths; $lb2_msg->selectionSet($paths[0], $paths[$last]); $mw->update; } sub BindMouseWheel #------------------------------------------------ { my($w) = @_; if ($^O eq 'MSWin32') { $w->bind('' => [sub { $_[0]->yview('scroll', -($_[1]/120)*3,'units')}, Ev('D')]); $w->bind('' => sub {$w->focus}); }else{ $w->bind('<4>' => sub {$_[0]->yview('scroll', -3, 'units') unless $Tk::strictMotif;}); $w->bind('<5>' => sub {$_[0]->yview('scroll', +3, 'units') unless $Tk::strictMotif;}); } } sub lb2_msg_sort1 #------------------------------------------------- { $mw->Busy(-recurse => 1,); my $col = $_[0]; my $t; $sort_cnt++; my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } } $lb2_msg->delete('all'); if ($sort_cnt % 2) { foreach my $k (sort {$file{$b}[$col] cmp $file{$a}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}else{ foreach my $k (sort {$file{$a}[$col] cmp $file{$b}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}$mw->Unbusy; } sub lb2_msg_sort2 #------------------------------------------------- { $mw->Busy(-recurse => 1,); my $col = $_[0]; my $t; $sort_cnt++; my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } } $lb2_msg->delete('all'); if ($sort_cnt % 2) { foreach my $k (sort {$file{$b}[$col] <=> $file{$a}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}else{ foreach my $k (sort {$file{$a}[$col] <=> $file{$b}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}$mw->Unbusy; } sub lb2_msg_sort3 #------------------------------------------------- { $mw->Busy(-recurse => 1,); my $col = $_[0]; my $t; $sort_cnt++; my $chek_enc = 'Qk0YAgAAAAAAADYAAAAoAAAACgAAAA8AAAABABgAAAAAAAAAAAASCwAAEgsAAA'. 'AAAAAAAAAA/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+AAD+/v7+/v7+'. '/v7+/v7+/v7+/v7+/v7+/v7+/v7+/v4AAP7+/v7+/v7+/v7+/v7+/v7+/v7+/v'. '7+/v7+/v7+/gAA/vv///z///z///z//vv//vv//vv//vv//vv+/vz+AABmR7po'. 'S7k5HoUxGHo0GYAkCHM7G5FPL6asjP/DpP8AAHVdvNS9/8Ov/4p3xpSB0r+p/8'. 'Go/31jx7KZ+72l/wAAe2+r4df/+PH/SUVpNjFYmpLBwrbydmioo5bUtanlAACM'. 'hbDX0/fDxNkWGSggIjQ9PVVNSWxPSnF9eZ2Pi64AAIl/rt7W/nNwiQAADXh5h0'. 'BAUAAAFl9cdnBthpSSqAAAmInC3tP/e3OYR0Ng19PseXaPEg0qTkpnpqK7tLLI'. 'AACYgsqkktWlk9CqnNLRw/OglcN2aZc1K1aqn8e+ttsAAJmIwZB/uKyc0rmp3r'. 'mq3bms2rGlz0c8Yk5FZsO72gAA//v///n/+vL/7eT+//b///f/7ej3ubXAMC40'. 'cG9zAAD9/fr//f3/+//++f//+v//+////P///P7k5OFwcWsAAP75//7+/v7+/v'. '7+/v7+/v7+/v7+/v7+/v7+/v7+/gAAAAA='; my $chek = $mw->Photo(-format => 'bmp', -data => $chek_enc); undef $chek_enc; #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or warn "\aCannot open $grp.grp $!"; my @msgs = (); close FH; foreach my $line (@msgs) { my @a = split ('~::~', $line); my $k = shift @a; $a[2] = str2time($a[2]); $file{$k}[0] = "$a[0]"; $file{$k}[1] = "$a[1]"; $file{$k}[2] = "$a[2]"; $file{$k}[3] = "$a[3]"; $file{$k}[4] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; } } $lb2_msg->delete('all'); if ($sort_cnt % 2) { foreach my $k (sort {$file{$b}[$col] <=> $file{$a}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); chomp($file{$k}[2] = ctime($file{$k}[2])); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}else{ foreach my $k (sort {$file{$a}[$col] <=> $file{$b}[$col]} keys %file) { #re-populate my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue',); } if (!defined $t || Tk::timeofday()-$t > 7) {$mw->update; $t = Tk::timeofday();} $lb2_msg->add($k); $lb2_msg->itemCreate($k, 0, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[0]",); $lb2_msg->itemCreate($k, 1, -itemtype => 'text', -style => $lb2_k2, -text => "$file{$k}[1]"); $lb2_msg->itemCreate($k, 2, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[6]"); $lb2_msg->itemCreate($k, 3, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[5]"); chomp($file{$k}[2] = ctime($file{$k}[2])); $lb2_msg->itemCreate($k, 4, -itemtype => 'text', -style => $lb2_k1, -text => "$file{$k}[2]"); if ($file{$k}[7] eq 'read') { $lb2_msg->indicator('create', $k, -itemtype => 'image', -image => $chek); }}}$mw->Unbusy; } sub display_groups #------------------------------------------------ { my $counter = 1; $lb1_grp->delete('all'); for my $k (sort keys %SBSCRIBE) { $lb1_grp->add($counter); $lb1_grp->itemCreate($counter, 0, -text => "$k"); $lb1_grp->itemCreate($counter, 1, -text => "$SBSCRIBE{$k}"); $counter++; } } } #POD Section# =head1 NAME NewsSurfer =head1 DESCRIPTION Surf Newsgroups. =head1 README NewsSurfer A GUI based NNTP client with yEnc support. This is a very early beta release, much more to follow. =head1 PREREQUISITES Net-NNTP Date-Parse Convert-UU Convert-BulkDecoder Tk-ResizeButton Tk =head1 COREQUISITES =head1 Copyright NewsSurfer Copyright (C) 2004 Jason David McManus This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 History NewsSurfer v1 - Initial release. =head1 Contact Please send comments/suggestions/bugs to: QoS@cpan.org or contact $_.@_.%_ on c.l.p.tk Thank you. =pod OSNAMES any? =pod SCRIPT CATEGORIES Networking Web =cut