#!/usr/bin/perl $| = 1; 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 Cwd; use Tk; #Optional Modules# if ($^O eq 'MSWin32') { eval { require Win32::Console; Win32::Console::Free() }; if ($@) { warn "Win32::Console is not installed.\n$@"; } } #Declarations# my $VERSION = 2.9; dbmopen(my %OPT, "settings", 0600) or warn "Cannot create settings.\a\n$!" and exit; dbmopen(my %SBSCRIBE, "sbscribe", 0600) or warn "Cannot create sbscribe.\a\n$!" and exit; my ($grp,$subjsave,$typed,$Mlimit,$last,$refs,$mid,$search,); my $sort_cnt = 3; my $cwd = cwd; my $sblabel = 'Ready'; my $totmsgs = ' '; #Main# if ($OPT{Log} == 1) { open STDERR, ">NewsSurfer.log" or warn "Cannot create NewsSurfer.log\a\n$!"; } my $mw = MainWindow->new(-relief => 'groove', -colormap => 'new', -bd => 2,); $mw->geometry("792x578+0+0"); $mw->setPalette(background => '#a1a1a1', activebackground => '#a1a1a1', activeforeground => '#000fff',); $mw->withdraw; my $sys_bg = $mw->cget(-background); my $sys_fg = $mw->cget(-foreground); &splash(); &news_gui(); &Tk::MainLoop(); #Subroutines# sub splash #---------------------------------------------------------- { my $imagedata = &load_image(1); my $image = $mw->Photo(-format => 'gif', -data => $imagedata); undef $imagedata; my $splash = $mw->Toplevel(-takefocus => 1,); $splash->overrideredirect(1); $splash->geometry("500x288+150+150"); $splash->resizable(0, 0); my $canvas = $splash->Canvas() ->pack(-expand => 1, -fill => 'both',); $canvas->createImage(0,0, -image => $image, -anchor => 'nw',); $mw->after(12000, sub { $splash->destroy; $mw->deiconify; $mw->raise; $mw->update; }); } sub news_gui #---------------------------------------------------------- { #Widget Initialization my $f1_main = $mw->Frame(); my $f2_main = $mw->Frame(-relief => 'groove', -bd => 4,); our $b1_scan = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b1_scan_cmd); our $b2_grab = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b2_grab_cmd); our $b3_read = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b3_read_cmd); our $b4_post = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b4_post_cmd); our $b5_bros = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b5_bros_cmd); our $b6_grp = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b6_grp_cmd); our $b7_opt = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b7_opt_cmd); our $b8_help = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b8_help_cmd); our $b9_exit = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&b9_exit_cmd); my $b10_log = $mw->Button(-bd => 0, -highlightthickness => 0, -command => \&view_log); my $lab1 = $mw->Label(-text => 'NewsSurfer', -font => '{Courier New} 16',); my $pw1 = $f2_main->Panedwindow(-orient => 'vertical', -relief => 'groove', -bd => 2,); our $lb1_grp = $pw1->Scrolled('HList', -highlightthickness => 1, -columns => 3, -header => 1, -height => 3, -indicator => 1, -indicatorcmd => sub {}, -font => '{Ariel} 8', -highlightcolor => '#000000', -scrollbars => 'ose', -background => '#ffffff', -foreground => '#000000', -selectbackground => '#000000', -selectforeground => '#fff000', -selectmode => 'single',); $lb1_grp->columnWidth (0, -char => '95'); $lb1_grp->columnWidth (1, -char => '25'); $lb1_grp->columnWidth (2, -char => ''); $lb1_grp->headerCreate(0, -text => "Group", -headerbackground => '#a1a1a1',); $lb1_grp->headerCreate(1, -text => "Last Scanned", -headerbackground => '#a1a1a1',); $lb1_grp->headerCreate(2, -headerbackground => '#a1a1a1',); our $lb2_msg = $pw1->Scrolled('HList', -highlightthickness => 1, -columns => 6, -header => 1, -indicator => 1, -indicatorcmd => sub {}, -separator => '^', -scrollbars => 'ose', -highlightcolor => '#000000', -background => '#ffffff', -foreground => '#000000', -selectbackground => '#000000', -selectforeground => '#fff000', -selectmode => 'extended',); my $h1 = $lb2_msg->ResizeButton(-text => 'Headers', -relief => 'flat', -font => '{Ariel} 8', -activebackground => '#a1a1a1', -activeforeground => '#000fff', -borderwidth => 0, -command => sub { &lb2_msg_sort(0, 1) }, -widget => \$lb2_msg, -column => 0, -anchor => 'w', -takefocus => 0,); my $h2 = $lb2_msg->ResizeButton(-text => 'From', -relief => 'flat', -font => '{Ariel} 8', -activebackground => '#a1a1a1', -activeforeground => '#000fff', -borderwidth => 0, -command => sub { &lb2_msg_sort(1, 1) }, -widget => \$lb2_msg, -column => 1, -anchor => 'w', -takefocus => 0,); my $h3 = $lb2_msg->ResizeButton(-text => 'Parts', -relief => 'flat', -font => '{Ariel} 8', -activebackground => '#a1a1a1', -activeforeground => '#000fff', -borderwidth => 0, -command => sub { &lb2_msg_sort(6, 2) }, -widget => \$lb2_msg, -column => 2, -anchor => 'w', -takefocus => 0,); my $h4 = $lb2_msg->ResizeButton(-text => 'Bytes', -relief => 'flat', -font => '{Ariel} 8', -activebackground => '#a1a1a1', -activeforeground => '#000fff', -borderwidth => 0, -command => sub { &lb2_msg_sort(5, 2) }, -widget => \$lb2_msg, -column => 3, -anchor => 'w', -takefocus => 0,); my $h5 = $lb2_msg->ResizeButton(-text => 'Date', -relief => 'flat', -font => '{Ariel} 8', -activebackground => '#a1a1a1', -activeforeground => '#000fff', -borderwidth => 0, -command => sub { &lb2_msg_sort(2, 3) }, -widget => \$lb2_msg, -column => 4, -anchor => 'w', -takefocus => 0,); $lb2_msg->columnWidth (0, -char => '68'); $lb2_msg->columnWidth (1, -char => '10'); $lb2_msg->columnWidth (2, -char => '7'); $lb2_msg->columnWidth (3, -char => '10'); $lb2_msg->columnWidth (4, -char => '25'); $lb2_msg->columnWidth (5, -char => ''); $lb2_msg->header('create', 0, -itemtype => 'window', -widget => $h1, -borderwidth => 1, -headerbackground => '#a1a1a1',); $lb2_msg->header('create', 1, -itemtype => 'window', -widget => $h2, -borderwidth => 1, -headerbackground => '#a1a1a1',); $lb2_msg->header('create', 2, -itemtype => 'window', -widget => $h3, -borderwidth => 1, -headerbackground => '#a1a1a1',); $lb2_msg->header('create', 3, -itemtype => 'window', -widget => $h4, -borderwidth => 1, -headerbackground => '#a1a1a1',); $lb2_msg->header('create', 4, -itemtype => 'window', -widget => $h5, -borderwidth => 1, -headerbackground => '#a1a1a1',); $lb2_msg->header('create', 5, -borderwidth => 1, -headerbackground => '#a1a1a1',); my $f1 = $mw->Frame(); our $sb_lab = $mw->Label(-text => " $sblabel", -anchor => 'w', -relief => 'sunken', -bd => 2,); my $sb_pb = $mw->ProgressBar(-length => 270, -relief => 'sunken', -bd => 2, -from => 0, -to => 100, -blocks => 50, -colors => [0, 'green'], -variable => \our $pb,); our $tl2 = $mw->Toplevel(-relief => 'groove', -bd => 2,); $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, -background => '#ffffff', -foreground => '#000000', -textvariable => \our $from); my $ent2_post = $tl2->Entry(-width => 60, -background => '#ffffff', -foreground => '#000000', -textvariable => \our $subj); our $txt_post = $tl2->Scrolled('Text', -scrollbars => 'se', -background => '#ffffff', -foreground => '#000000', -selectforeground => '#fff000', -selectbackground => '#000000', -wrap => 'none', -height => 30, -width => 80,); my $post_menu = $txt_post->menu; $post_menu->delete('File'); $post_menu->delete('Search'); $post_menu->delete('View'); undef $post_menu; our $b1_post = $tl2->Button(-text => 'Cancel', -width => 11, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b1_post_cancel); our $b2_post = $tl2->Button(-text => 'Attach & Post', -width => 11, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b2_post_attach); our $b3_post = $tl2->Button(-text => ' Post ', -width => 11, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b3_post_post); my $cb1_post = $tl2->Checkbutton(-variable => \$OPT{UseSig}, -text => 'Attach Signature', -background => '#a1a1a1', -foreground => '#000000', -activebackground => '#a1a1a1', -activeforeground => '#000000', -selectcolor => '#ffffff',); our $tl3 = $mw->Toplevel(-relief => 'groove', -bd => 2,); $tl3->title('Groups'); $tl3->geometry("+90+35"); $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,); $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",); our $e1_grp = $tl3->Entry(-background => '#ffffff', -foreground => '#000000', -textvariable => \$search,); our $b1_grp = $tl3->Button(-text => 'Close', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b1_grp_close); our $b2_grp = $tl3->Button(-text => 'Update', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b2_grp_update); our $b3_grp = $tl3->Button(-text => 'Subscribe', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b3_grp_subscribe); our $b4_grp = $tl3->Button(-text => 'UnSubscribe', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b4_grp_unsubscribe); our $b5_grp = $tl3->Button(-text => 'Search', -relief => 'flat', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => sub{ &search($lb_grp); }); our $tl4 = $mw->Toplevel(-relief => 'groove', -bd => 2,); $tl4->title('Read Message'); $tl4->transient($mw); $tl4->withdraw; our $txt_read = $tl4->Scrolled('ROText', -scrollbars => 'se', -background => '#ffffff', -foreground => '#000000', -selectforeground => '#fff000', -selectbackground => '#000000', -wrap => 'none', -width => 80, -height => 30,); $txt_read->tagConfigure('Blue', -foreground => '#000fff'); $txt_read->tagConfigure('Red', -foreground => '#ff0000'); my $read_menu = $txt_read->menu; $read_menu->configure(-bg => $sys_bg, -fg => $sys_fg, -activeforeground => '#000fff', -activebackground => '#a1a1a1',); $read_menu->delete('File'); $read_menu->delete('Search'); $read_menu->delete('View'); undef $read_menu; my $b1_read = $tl4->Button(-text => 'Close', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b1_read_close); our $b2_read = $tl4->Button(-text => 'Reply', -width => 10, -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => \&b2_read_reply); our $tl5 = $mw->Toplevel(-background => '#000000', -takefocus => 1,); $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 $l7_conf = $tl5->Label(-text => 'Download messages '. 'older than 30 days '. '(May be slow).', -background => '#000000', -foreground => '#ffffff',); my $l8_conf = $tl5->Label(-text => 'Always download all messages'. ' when scanning newsgroups'. ' (Not recommended).', -background => '#000000', -foreground => '#ffffff',); my $l9_conf = $tl5->Label(-text => 'Beep on errors.', -background => '#000000', -foreground => '#ffffff',); my $l10_conf = $tl5->Label(-text => 'Turn on logging.', -background => '#000000', -foreground => '#ffffff',); my $e1_conf = $tl5->Entry(-width => 30, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{Serv},); my $e2_conf = $tl5->Entry(-width => 5, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{Port},); my $e3_conf = $tl5->Entry(-width => 30, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{User},); my $e4_conf = $tl5->Entry(-width => 30, -show => '*', -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{Pass},); my $e5_conf = $tl5->Entry(-width => 30, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{Mail},); our $e6_conf = $tl5->Entry(-width => 60, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{DDir},); our $e7_conf = $tl5->Entry(-width => 60, -background => '#ffffff', -foreground => '#000000', -textvariable => \$OPT{Sig},); my $cb1_conf = $tl5->Checkbutton(-background => '#000000', -foreground => '#000000', -activebackground => '#000000', -activeforeground => '#ffffff', -selectcolor => '#ffffff', -variable => \$OPT{MAge},); my $cb2_conf = $tl5->Checkbutton(-background => '#000000', -foreground => '#000000', -activebackground => '#000000', -activeforeground => '#ffffff', -selectcolor => '#ffffff', -offvalue => '1', -onvalue => '0', -variable => \$OPT{Vk},); my $cb3_conf = $tl5->Checkbutton(-background => '#000000', -foreground => '#000000', -activebackground => '#000000', -activeforeground => '#ffffff', -selectcolor => '#ffffff', -offvalue => '0', -onvalue => '1', -variable => \$OPT{Bp},); my $cb4_conf = $tl5->Checkbutton(-background => '#000000', -foreground => '#000000', -activebackground => '#000000', -activeforeground => '#ffffff', -selectcolor => '#ffffff', -offvalue => '0', -onvalue => '1', -variable => \$OPT{Log},); my $b1_conf = $tl5->Button(-text => 'C l o s e', -width => 5, -relief => 'flat', -foreground => '#ffffff', -background => '#000000', -activeforeground => '#fff000', -activebackground => '#000000', -command => sub {$tl5->withdraw;}); my $b2_conf = $tl5->Button(-text => 'Download Dir: ', -anchor => 'e', -width => 15, -relief => 'flat', -bg => '#000000', -fg => '#ffffff', -activeforeground => '#fff000', -activebackground => '#000000', -command => \&conf_browse_dir); my $b3_conf = $tl5->Button(-text => 'Signature File: ', -anchor => 'e', -width => 15, -relief => 'flat', -bg => '#000000', -fg => '#ffffff', -activeforeground => '#fff000', -activebackground => '#000000', -command => \&conf_sig_file); our $tl6 = $mw->Toplevel(-relief => 'groove', -bd => 2,); $tl6->title('Help'); $tl6->geometry("+93+70"); $tl6->resizable(0, 0); $tl6->transient($mw); $tl6->withdraw; our $txt_help = $tl6->Scrolled('ROText', -scrollbars => 'oe', -background => '#000000', -foreground => '#ffffff', -selectbackground => '#000000', -selectforeground => '#fff000', -wrap => 'none', -width => 80, -height => 20,); $txt_help->menu(undef); my $b1_help = $tl6->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -text => 'Close', -width => 10, -command => sub {$tl6->withdraw;}); my $b2_help = $tl6->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -text => 'About', -width => 10, -command => \&help_about); our $tl7 = $mw->Toplevel(-relief => 'raised', -borderwidth => 2.5,); $tl7->overrideredirect(1); $tl7->resizable(0, 0); $tl7->transient($mw); $tl7->withdraw; our $f1_menu1 = $tl7->Frame(-relief => 'sunken', -bd => '1.5', -takefocus => '1',); my $f2_menu1 = $tl7->Frame(-relief => 'groove', -bd => '2',); my $f3_menu1 = $tl7->Frame(-relief => 'groove', -bd => '2',); my $b1_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Scan', -width => 10, -command => \&b1_scan_cmd); my $b2_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Load', -width => 10, -command => \&message_load); my $b3_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Search', -width => 10, -command => \&search_popup); my $b4_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Clear', -width => 10, -command => \&message_clear); my $b5_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Reset', -width => 10, -command => sub { $lb1_grp->focus; &rset_cmd(); }); my $b6_menu1 = $tl7->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Remove', -width => 10, -command => sub { $lb1_grp->focus; &b4_grp_unsubscribe('X'); }); our $tl8 = $mw->Toplevel(-relief => 'raised', -borderwidth => 2.5,); $tl8->overrideredirect(1); $tl8->resizable(0, 0); $tl8->transient($mw); $tl8->withdraw; our $f1_menu2 = $tl8->Frame(-relief => 'sunken', -bd => '1.5', -takefocus => '1',); my $b1_menu2 = $tl8->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Read', -width => 10, -command => \&b3_read_cmd); my $b2_menu2 = $tl8->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Grab', -width => 10, -command => \&b2_grab_cmd); my $b3_menu2 = $tl8->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Grab&Open', -width => 10, -command => sub {&b2_grab_cmd(1);}); my $b4_menu2 = $tl8->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'SelectAll', -width => 10, -command => \&lb2_msg_select_all); my $b5_menu2 = $tl8->Button(-activeforeground => '#000fff', -activebackground => '#a1a1a1', -relief => 'flat', -anchor => 'w', -text => 'Delete', -width => 10, -command => sub { $lb2_msg->focus; &message_delete(); }); our $tl9 = $mw->Toplevel(-takefocus => 1,); $tl9->title('Download Messages'); $tl9->geometry("+220+160"); $tl9->resizable(0, 0); $tl9->transient($mw); $tl9->withdraw; my $f1_msgs = $tl9->Frame(); my $f2_msgs = $tl9->Frame(); our $l1_msgs = $tl9->Label(-text => 'There are more than ' . "$totmsgs unread messages in this " . "group.",); my $l2_msgs = $tl9->Label(-text => 'Enter the number of ' . 'messages to be downloaded: ',); my $l3_msgs = $tl9->Label(-text => 'Newest messages only ' . '(mark the rest read).',); our $e1_msgs = $tl9->Entry(-textvariable => our $maxdl, -bg => '#ffffff', -fg => '#000000', -selectbackground => '#000000', -selectforeground => '#fff000', -width => 6,); my $c1_msgs = $tl9->Checkbutton(-variable => \our $dlnew, -activeforeground => '#000000', -activebackground => '#a1a1a1', -foreground => '#000000', -selectcolor => '#ffffff',); my $b1_msgs = $tl9->Button(-text => 'Ok', -activeforeground => '#000fff', -activebackground => '#a1a1a1', -width => 10, -command => \&dlmsgs_ok); my $b2_msgs = $tl9->Button(-text => 'All', -activeforeground => '#000fff', -activebackground => '#a1a1a1', -width => 10, -command => \&dlmsgs_all); my $b3_msgs = $tl9->Button(-text => 'Cancel', -activeforeground => '#000fff', -activebackground => '#a1a1a1', -width => 10, -command => \&dlmsgs_cancel); our $tla = $mw->Toplevel(); $tla->title('Search Group'); $tla->geometry("+300+200"); $tla->resizable(0, 0); $tla->transient($mw); $tla->withdraw; my $l1_sea = $tla->Label(-text => 'Search for:'); my $f1_sea = $tla->Frame(-relief => 'sunken', -bd => 1,); our $e1_sea = $tla->Entry(-textvariable => \$search, -bg => '#ffffff', -fg => '#000000',); our $b1_sea = $tla->Button(-text => 'Ok', -font => '{Arial} 6', -activeforeground => '#000fff', -activebackground => '#a1a1a1', -command => sub {&search($lb2_msg);}); $pw1->add($lb1_grp, $lb2_msg,); #Widget Placement $f1_main ->grid(-in => $mw, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => 'news'); $b1_scan ->grid(-in => $f1_main, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => ''); $b2_grab ->grid(-in => $f1_main, -columnspan => '1', -column => '3', -rowspan => '1', -row => '1', -sticky => ''); $b3_read ->grid(-in => $f1_main, -columnspan => '1', -column => '4', -rowspan => '1', -row => '1', -sticky => ''); $b4_post ->grid(-in => $f1_main, -columnspan => '1', -column => '5', -rowspan => '1', -row => '1', -sticky => ''); $b5_bros ->grid(-in => $f1_main, -columnspan => '1', -column => '6', -rowspan => '1', -row => '1', -sticky => ''); $b6_grp ->grid(-in => $f1_main, -columnspan => '1', -column => '8', -rowspan => '1', -row => '1', -sticky => ''); $b7_opt ->grid(-in => $f1_main, -columnspan => '1', -column => '9', -rowspan => '1', -row => '1', -sticky => ''); $b8_help ->grid(-in => $f1_main, -columnspan => '1', -column => '12', -rowspan => '1', -row => '1', -sticky => ''); $b9_exit ->grid(-in => $f1_main, -columnspan => '1', -column => '13', -rowspan => '1', -row => '1', -sticky => ''); $b10_log ->grid(-in => $f1_main, -columnspan => '1', -column => '10', -rowspan => '1', -row => '1', -sticky => ''); $lab1 ->grid(-in => $f1_main, -columnspan => '1', -column => '14', -rowspan => '1', -row => '1', -sticky => 'news'); $f2_main ->grid(-in => $mw, -columnspan => '1', -column => '2', -rowspan => '2', -row => '2', -sticky => 'news'); $pw1 ->grid(-in => $f2_main, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'news'); $f1 ->grid(-in => $mw, -columnspan => '1', -column => '2', -rowspan => '1', -row => '5', -sticky => 'news'); $sb_lab ->grid(-in => $f1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'ew'); $sb_pb ->grid(-in => $f1, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => 'news'); $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 => 'nws'); $b1_post ->grid(-in => $tl2, -columnspan => '1', -column => '2', -rowspan => '1', -row => '7', -sticky => 'w'); $b2_post ->grid(-in => $tl2, -columnspan => '1', -column => '4', -rowspan => '1', -row => '7', -sticky => 'w'); $b3_post ->grid(-in => $tl2, -columnspan => '1', -column => '3', -rowspan => '1', -row => '7', -sticky => 'w'); $cb1_post ->grid(-in => $tl2, -columnspan => '1', -column => '5', -rowspan => '1', -row => '7', -sticky => 'e'); $lb_grp ->grid(-in => $tl3, -columnspan => '9', -column => '2', -rowspan => '1', -row => '3', -sticky => 'news'); $e1_grp ->grid(-in => $tl3, -columnspan => '7', -column => '2', -rowspan => '1', -row => '2', -sticky => 'ew'); $b1_grp ->grid(-in => $tl3, -columnspan => '1', -column => '3', -rowspan => '1', -row => '5', -sticky => 'n'); $b2_grp ->grid(-in => $tl3, -columnspan => '1', -column => '5', -rowspan => '1', -row => '5', -sticky => 'n'); $b3_grp ->grid(-in => $tl3, -columnspan => '1', -column => '7', -rowspan => '1', -row => '5', -sticky => 'n'); $b4_grp ->grid(-in => $tl3, -columnspan => '1', -column => '9', -rowspan => '1', -row => '5', -sticky => 'n'); $b5_grp ->grid(-in => $tl3, -columnspan => '1', -column => '9', -rowspan => '1', -row => '2', -sticky => 'w'); $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'); $l7_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '9', -sticky => 'w'); $l8_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '10', -sticky => 'nw'); $l9_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '11', -sticky => 'nw'); $l10_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '12', -sticky => 'nw'); $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'); $e7_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '7', -sticky => 'w'); $cb1_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '9', -sticky => 'e'); $cb2_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '10', -sticky => 'ne'); $cb3_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '11', -sticky => 'ne'); $cb4_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '12', -sticky => 'ne'); $b1_conf ->grid(-in => $tl5, -columnspan => '1', -column => '3', -rowspan => '1', -row => '13', -sticky => 'news'); $b2_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '6', -sticky => 'e'); $b3_conf ->grid(-in => $tl5, -columnspan => '1', -column => '2', -rowspan => '1', -row => '7', -sticky => 'e'); $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'); $f1_menu1 ->grid(-in => $tl7, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'news'); $b1_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'n'); $b2_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '2', -sticky => 'n'); $f2_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '3', -sticky => 'news'); $b3_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '4', -sticky => 'n'); $f3_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '5', -sticky => 'news'); $b4_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '6', -sticky => 'n'); $b5_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '7', -sticky => 'n'); $b6_menu1 ->grid(-in => $f1_menu1, -columnspan => '1', -column => '1', -rowspan => '1', -row => '8', -sticky => 'n'); $f1_menu2 ->grid(-in => $tl8, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'news'); $b1_menu2 ->grid(-in => $f1_menu2, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'n'); $b2_menu2 ->grid(-in => $f1_menu2, -columnspan => '1', -column => '1', -rowspan => '1', -row => '2', -sticky => 'n'); $b3_menu2 ->grid(-in => $f1_menu2, -columnspan => '1', -column => '1', -rowspan => '1', -row => '3', -sticky => 'n'); $b4_menu2 ->grid(-in => $f1_menu2, -columnspan => '1', -column => '1', -rowspan => '1', -row => '4', -sticky => 'n'); $b5_menu2 ->grid(-in => $f1_menu2, -columnspan => '1', -column => '1', -rowspan => '1', -row => '5', -sticky => 'n'); $l1_msgs ->grid(-in => $tl9, -columnspan => '3', -column => '2', -rowspan => '1', -row => '1', -sticky => 'w'); $l2_msgs ->grid(-in => $tl9, -columnspan => '2', -column => '2', -rowspan => '1', -row => '3', -sticky => 'w'); $l3_msgs ->grid(-in => $f1_msgs, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => 'w'); $c1_msgs ->grid(-in => $f1_msgs, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'e'); $e1_msgs ->grid(-in => $tl9, -columnspan => '1', -column => '4', -rowspan => '1', -row => '3', -sticky => 'w'); $f1_msgs ->grid(-in => $tl9, -columnspan => '5', -column => '1', -rowspan => '1', -row => '5', -sticky => 'news', -padx => '0', -pady => '5'); $f2_msgs ->grid(-in => $f1_msgs, -columnspan => '2', -column => '1', -rowspan => '1', -row => '3', -sticky => 'news',); $b1_msgs ->grid(-in => $f2_msgs, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => ''); $b2_msgs ->grid(-in => $f2_msgs, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => ''); $b3_msgs ->grid(-in => $f2_msgs, -columnspan => '1', -column => '3', -rowspan => '1', -row => '1', -sticky => ''); $l1_sea ->grid(-in => $tla, -columnspan => '1', -column => '2', -rowspan => '1', -row => '2', -sticky => 'e'); $f1_sea ->grid(-in => $tla, -columnspan => '1', -column => '3', -rowspan => '1', -row => '2', -sticky => 'news'); $e1_sea ->grid(-in => $f1_sea, -columnspan => '1', -column => '1', -rowspan => '1', -row => '1', -sticky => 'w'); $b1_sea ->grid(-in => $f1_sea, -columnspan => '1', -column => '2', -rowspan => '1', -row => '1', -sticky => '',); #Grid $mw->gridRowconfigure(1, -minsize => 40,); #Main $mw->gridRowconfigure(2, -minsize => 8,); $mw->gridRowconfigure(3, -minsize => 8, -weight => 1,); $mw->gridRowconfigure(4, -minsize => 2,); $mw->gridRowconfigure(5, -minsize => 2,); $mw->gridRowconfigure(6, -minsize => 4,); $mw->gridColumnconfigure(1, -minsize => 8,); $mw->gridColumnconfigure(2, -minsize => 774, -weight => 1,); $mw->gridColumnconfigure(3, -minsize => 8,); $f1_main->gridRowconfigure(1, -minsize => 8,); $f1_main->gridColumnconfigure(1, -minsize => 2,); $f1_main->gridColumnconfigure(2, -minsize => 8,); $f1_main->gridColumnconfigure(3, -minsize => 2,); $f1_main->gridColumnconfigure(4, -minsize => 2,); $f1_main->gridColumnconfigure(5, -minsize => 2,); $f1_main->gridColumnconfigure(6, -minsize => 2,); $f1_main->gridColumnconfigure(7, -minsize => 8,); $f1_main->gridColumnconfigure(8, -minsize => 2,); $f1_main->gridColumnconfigure(9, -minsize => 2,); $f1_main->gridColumnconfigure(10, -minsize => 2,); $f1_main->gridColumnconfigure(11, -minsize => 8,); $f1_main->gridColumnconfigure(12, -minsize => 2,); $f1_main->gridColumnconfigure(13, -minsize => 2,); $f1_main->gridColumnconfigure(14, -minsize => 8, -weight => 1,); $f2_main->gridRowconfigure(1, -minsize => 256, -weight => 1,); $f2_main->gridColumnconfigure(1, -minsize => 8, -weight => 1); $f1->gridRowconfigure(1, -minsize => 2, -weight => 1,); $f1->gridColumnconfigure(1, -minsize => 2, -weight => 1,); for (1..8) { $tl2->gridRowconfigure($_, -minsize => 8,); #Post Message } $tl2->gridColumnconfigure(1, -minsize => 8,); $tl2->gridColumnconfigure(2, -minsize => 40,); $tl2->gridColumnconfigure(3, -minsize => 40,); $tl2->gridColumnconfigure(4, -minsize => 40,); $tl2->gridColumnconfigure(5, -minsize => 304,); $tl2->gridColumnconfigure(6, -minsize => 40,); $tl2->gridColumnconfigure(7, -minsize => 8,); for (1..6) { $tl3->gridRowconfigure($_, -minsize => 8,); #Groups } $tl3->gridColumnconfigure(1, -minsize => 8,); $tl3->gridColumnconfigure(2, -minsize => 140,); $tl3->gridColumnconfigure(3, -minsize => 20,); $tl3->gridColumnconfigure(4, -minsize => 2,); $tl3->gridColumnconfigure(5, -minsize => 20,); $tl3->gridColumnconfigure(6, -minsize => 2,); $tl3->gridColumnconfigure(7, -minsize => 20,); $tl3->gridColumnconfigure(8, -minsize => 2,); $tl3->gridColumnconfigure(9, -minsize => 20,); $tl3->gridColumnconfigure(10, -minsize => 152,); $tl3->gridColumnconfigure(11, -minsize => 8,); $tl4->gridRowconfigure(1, -minsize => 8,); #Read Message $tl4->gridRowconfigure(2, -minsize => 8, -weight => 1,); $tl4->gridRowconfigure(3, -minsize => 8,); $tl4->gridRowconfigure(4, -minsize => 8,); $tl4->gridRowconfigure(5, -minsize => 8,); $tl4->gridColumnconfigure(1, -minsize => 8,); $tl4->gridColumnconfigure(2, -minsize => 20,); $tl4->gridColumnconfigure(3, -minsize => 300, -weight => 1,); $tl4->gridColumnconfigure(4, -minsize => 20,); $tl4->gridColumnconfigure(5, -minsize => 8,); $tl5->gridRowconfigure(1, -minsize => 8,); #Options $tl5->gridRowconfigure(2, -minsize => 8,); $tl5->gridRowconfigure(3, -minsize => 8,); $tl5->gridRowconfigure(4, -minsize => 8,); $tl5->gridRowconfigure(5, -minsize => 10,); $tl5->gridRowconfigure(6, -minsize => 8,); $tl5->gridRowconfigure(7, -minsize => 10,); $tl5->gridRowconfigure(8, -minsize => 8,); $tl5->gridRowconfigure(9, -minsize => 8,); $tl5->gridRowconfigure(10, -minsize => 8,); $tl5->gridRowconfigure(11, -minsize => 8,); $tl5->gridRowconfigure(12, -minsize => 120,); $tl5->gridRowconfigure(13, -minsize => 8,); $tl5->gridColumnconfigure(1, -minsize => 8,); $tl5->gridColumnconfigure(2, -minsize => 20,); $tl5->gridColumnconfigure(3, -minsize => 220,); $tl5->gridColumnconfigure(4, -minsize => 50,); $tl5->gridColumnconfigure(5, -minsize => 50,); $tl5->gridColumnconfigure(6, -minsize => 8,); $tl6->gridRowconfigure(1, -minsize => 236,); #Help $tl6->gridRowconfigure(2, -minsize => 8,); $tl6->gridRowconfigure(3, -minsize => 10,); $tl6->gridRowconfigure(4, -minsize => 8,); $tl6->gridColumnconfigure(1, -minsize => 8,); $tl6->gridColumnconfigure(2, -minsize => 10,); $tl6->gridColumnconfigure(3, -minsize => 320,); $tl6->gridColumnconfigure(4, -minsize => 10,); $tl6->gridColumnconfigure(5, -minsize => 8,); $tl7->gridRowconfigure(1, -minsize => 8,); #Menu1 $tl7->gridColumnconfigure(1, -minsize => 8,); $f1_menu1->gridRowconfigure(1, -minsize => 8,); $f1_menu1->gridRowconfigure(2, -minsize => 8,); $f1_menu1->gridRowconfigure(3, -minsize => 2,); $f1_menu1->gridRowconfigure(4, -minsize => 8,); $f1_menu1->gridRowconfigure(5, -minsize => 2,); $f1_menu1->gridRowconfigure(6, -minsize => 8,); $f1_menu1->gridRowconfigure(7, -minsize => 8,); $f1_menu1->gridRowconfigure(8, -minsize => 8,); $f1_menu1->gridColumnconfigure(1, -minsize => 8,); $tl8->gridRowconfigure(1, -minsize => 8,); #Menu2 $tl8->gridColumnconfigure(1, -minsize => 8,); for (1..5) { $f1_menu2->gridRowconfigure($_, -minsize => 8,); } $f1_menu2->gridColumnconfigure(1, -minsize => 8,); for (1..5) { #Dl Messages $tl9->gridRowconfigure($_, -minsize => 8,); } for (1..5) { $tl9->gridColumnconfigure($_, -minsize => 8,); } $f1_msgs->gridRowconfigure(1, -minsize => 8,); $f1_msgs->gridRowconfigure(2, -minsize => 8,); $f1_msgs->gridRowconfigure(3, -minsize => 8,); $f1_msgs->gridColumnconfigure(1, -minsize => 8,); $f1_msgs->gridColumnconfigure(2, -minsize => 8,); $f2_msgs->gridRowconfigure(1, -minsize => 8,); $f2_msgs->gridColumnconfigure(1, -minsize => 8,); $f2_msgs->gridColumnconfigure(2, -minsize => 8, -weight => 1,); $f2_msgs->gridColumnconfigure(3, -minsize => 8,); for (1..3) { $tla->gridRowconfigure($_, -minsize => 8,); } for (1..4) { $tla->gridColumnconfigure($_, -minsize => 8,); } $f1_sea->gridRowconfigure(1, -minsize => 8,); $f1_sea->gridColumnconfigure(1, -minsize => 8,); $f1_sea->gridColumnconfigure(2, -minsize => 2,); #Bindings $tl2->protocol(WM_DELETE_WINDOW => \&b1_post_cancel); $tl3->protocol(WM_DELETE_WINDOW => \&b1_grp_close); $tl4->protocol(WM_DELETE_WINDOW => \&b1_read_close); $tl9->protocol(WM_DELETE_WINDOW => \&dlmsgs_cancel); $tl5->protocol(WM_DELETE_WINDOW => sub {$tl5->withdraw;}); $tl6->protocol(WM_DELETE_WINDOW => sub {$tl6->withdraw;}); $tla->protocol(WM_DELETE_WINDOW => sub {$tla->withdraw;}); $lab1->bind('' => sub { $lab1->configure(-text=>'');$mw->update;$mw->after(152); $lab1->configure(-text=>'N');$mw->update;$mw->after(141); $lab1->configure(-text=>'Ne');$mw->update;$mw->after(133); $lab1->configure(-text=>'New');$mw->update;$mw->after(129); $lab1->configure(-text=>'News');$mw->update;$mw->after(148); $lab1->configure(-text=>'NewsS');$mw->update;$mw->after(200); $lab1->configure(-text=>'NewsSu');$mw->update;$mw->after(106); $lab1->configure(-text=>'NewsSur');$mw->update;$mw->after(113); $lab1->configure(-text=>'NewsSurf');$mw->update;$mw->after(105); $lab1->configure(-text=>'NewsSurfe');$mw->update;$mw->after(121); $lab1->configure(-text=>'NewsSurfer');$mw->update;$mw->after(107); }); $f1_menu1->bind('' => sub {$tl7->withdraw;}); $f1_menu2->bind('' => sub {$tl8->withdraw;}); $e1_grp ->bind('' => sub {&search($lb_grp);}); $lb1_grp ->bind('' => \&lb1_grp_menu); $lb1_grp ->bind('' => \&Tk::HList::ButtonRelease_1); $lb2_msg ->bind('' => sub { my @sel = $lb2_msg->selectionGet; if ($sel[1]) { &lb2_msg_menu('Y'); }else{ $lb2_msg->Tk::HList::ButtonRelease_1; &lb2_msg_menu(); } }); $lb2_msg ->bind('' => \&b3_read_cmd); $lb1_grp ->bind('' => \&message_load); $lb1_grp ->bind('' => sub {&b4_grp_unsubscribe('X');}); $lb2_msg ->bind('' => \&message_delete); $lb2_msg ->bind('' => \&lb2_msg_select_all); $lb2_msg ->bind('' => \&lb2_msg_select_all); $lb2_msg ->bind('' => \&lb2_msg_select_end); $lb2_msg ->bind('' => \&lb2_msg_select_hom); $lb2_msg ->bind('' => \&message_delete); $lb2_msg ->bind('' => \&message_delete); $e1_msgs ->bind('' => \&dlmsgs_ok); $e1_sea ->bind('' => sub {&search($lb2_msg);}); &MainButtons($b1_scan,10,101,102);&MainButtons($b2_grab,11,111,112); &MainButtons($b3_read,12,121,122);&MainButtons($b4_post,13,131,132); &MainButtons($b5_bros,14,141,142);&MainButtons($b6_grp, 15,151,152); &MainButtons($b7_opt, 16,161,162);&MainButtons($b10_log,17,171,172); &MainButtons($b8_help,18,181,182);&MainButtons($b9_exit,19,191,192); &FlashButton($b5_grp, '#00ff00', "$sys_fg"); &FlashButton($b1_conf, '#00ff00', '#ffffff'); &FlashButton($b2_conf, '#00ff00', '#ffffff'); &FlashButton($b3_conf, '#00ff00', '#ffffff'); &BindMouseWheel($lb1_grp); &BindMouseWheel($lb2_msg); &BindMouseWheel($lb_grp); &BindMouseWheel($txt_read); &BindMouseWheel($txt_post); #Defaults &display_groups(); $lb1_grp->focus(); $mw->update; unless ($pb) { $pb = 0; } unless ($OPT{DDir}) { $OPT{DDir} = '.'; } unless ($OPT{MAge}) { $OPT{MAge} = '0'; } unless ($OPT{Port}) { $OPT{Port} = '119'; } unless ($OPT{Mail}) { $OPT{Mail} = 'NewsSurfer@domain.invalid'; } unless (-e "$OPT{DDir}" and -d "$OPT{DDir}") { $OPT{DDir} = '.'; } print STDERR 'NewsSurfer has started. (' . localtime() . "}\n"; #Callbacks sub b1_scan_cmd #------------------------------------------------ { $sblabel = 'Scanning newsgroup...'; $sb_lab->configure(-text => " $sblabel"); $mw->Busy; $lb2_msg->focus; $mw->update; my (%multi, $dlmsg, $new,); #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: unless ($grp and $xxx[0]) { &error('scan_1'); goto scan_end; } for (1..4) { $pb++; $mw->update; } #login my $nntp; my $rtry; login: $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); unless ($nntp) { if (!defined $rtry) { $rtry++; goto login; }else{ &error('connect'); goto scan_end; } } if ($OPT{User} && $OPT{Pass}) { eval {$nntp->authinfo($OPT{User}, $OPT{Pass})}; if ($@) { &error('login'); goto scan_end; } }for (1..2) { $pb++; $mw->update; } my $imagedata = &load_image(2); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; #range my @nfo = $nntp->group($grp); shift @nfo; pop @nfo; $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++; $dlmsg = $nfo[1] - $nfo[0]; $dlmsg++; unless(-e "$grp.grp") { #Newly subscribed or reset group. if ($OPT{Vk} == 1) { unless($nfo[1] - $nfo[0] < 5000) { #popup d/l messages my $r = &msglimit(); if ($r eq 'X') { $nntp->quit(); goto scan_end; } elsif ($dlnew == 1) { $nfo[0] = $nfo[1] - $r; } else { $nfo[1] = $nfo[0] + $r; } $dlmsg = $nfo[1] - $nfo[0]; } } } my $rng = \@nfo; #load group file $sblabel = 'Removing expired articles...'; $sb_lab->configure(-text => " $sblabel"); for (1..2) { $pb++; $mw->update; } my (%file,); if (-e "$grp.grp") { #load existing group information into %file open (FH, "< $grp.grp") or &error('scan_2'); 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] = "$a[4]"; $file{$k}[5] = "$a[5]"; $file{$k}[6] = "$a[6]"; $file{$k}[7] = "$a[7]"; $file{$k}[8] = "old"; expired: } #new range for (1..2) { $pb++; $mw->update; } my @keys = (keys %file); @keys = sort {$b <=> $a} @keys; $last = $keys[0]; $last++; if ($last <= $nfo[1]) { undef $rng; unless($last == 1) { shift @nfo; unshift (@nfo, "$last"); } $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++; $dlmsg = $nfo[1] - $nfo[0]; $dlmsg++; if ($OPT{Vk} == 1) { unless($nfo[1] - $nfo[0] < 5000) { my $r = &msglimit(); if ($r eq 'X') { $nntp->quit(); goto scan_end; } elsif ($dlnew == 1) { $nfo[0] = $nfo[1] - $r; } else { $nfo[1] = $nfo[0] + $r; } $dlmsg = $nfo[1] - $nfo[0]; } }$rng = \@nfo; }else{ $nntp->quit(); $sblabel = 'No new messages...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; goto no_new_msgs; } } #overview $sblabel = "Downloading $dlmsg of $totmsgs new messages..."; $sb_lab->configure(-text => " $sblabel"); for (1..4) { $pb++; $mw->update; } my $href = $nntp->xover($rng); my %xover = %$href; undef $href; $nntp->quit(); #(%xover is a HoA) $_ is msgnum #$xover{$_}[0] #subject #$xover{$_}[4] #references #$xover{$_}[1] #from #$xover{$_}[5] #bytes #$xover{$_}[2] #date #$xover{$_}[6] #lines *parts* #$xover{$_}[3] #message-id #$xover{$_}[7] #xref:full *read* #multipart $sblabel = 'Combining articles...'; $sb_lab->configure(-text => " $sblabel"); for (1..6) { $pb++; $mw->update; } my $subj_sav = ' '; undef %multi; #(%multi is a HoH) subj->part = msg id while (my $k = each %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; } } #multipart / save %multi to file for (1..4) { $pb++; $mw->update; } open (FH, ">> $grp.dat"); while (my $k1 = each %multi) { print FH "$k1"; for my $k2 (sort keys %{$multi{$k1}}) { print FH "~::~$multi{$k1}{$k2}"; }print FH "\n"; }close FH; for (1..4) { $pb++; $mw->update; } #multipart / duplicates my @dups; while (my $k = each %xover) { if ($xover{$k}) { push (@dups, "$k:^:$xover{$k}[0]$xover{$k}[1]$xover{$k}[6]") unless($xover{$k}[6] == 1); } } 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 if ($OPT{MAge} == 0) { $sblabel = 'Removing articles older than 30 days...'; $sb_lab->configure(-text => " $sblabel"); for (1..4) { $pb++; $mw->update; } my $now = time; while (my $k = each %xover) { my $epoch = str2time($xover{$k}[2]); my $age = $now - $epoch; if ($age < 2592000 or $k == $nfo [1]) { chomp($xover{$k}[2] = ctime($epoch)); }else{ delete $xover{$k} } } }else{ while (my $k = each %xover) { my $epoch = str2time($xover{$k}[2]); chomp($xover{$k}[2] = ctime($epoch)); } } #populate new messages $sblabel = 'Displaying messages...'; $sb_lab->configure(-text => " $sblabel"); for (1..4) { $pb++; $mw->update; } my $lb2_b1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue', -font => '{Arial} 8',); my $lb2_b2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => 'blue', -font => '{Arial} 8',); my @xkey = keys %xover; @xkey = sort{$b <=> $a} @xkey; $last = $xkey[0]; $last++; $new = 1; my $c = 0; foreach (@xkey) { if ($pb >= 100) { $pb = 0; } if ($c > 1000) { $pb += 10; $mw->update; $c = 0; } else { $c++; } $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 @fkey = keys %file; @fkey = sort{$b <=> $a} @fkey; unless ($new) { $last = $fkey[0]; $last++; } my $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); my $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); $c = 0; foreach (@fkey) { if ($pb >= 100) { $pb = 0; } if ($c > 1000) { $pb += 10; $mw->update; $c = 0; } else { $c++; } $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 for (1..4) { $pb++; $mw->update; } open (FH, "> $grp.grp") or &error('scan_3'); if (\*FH) { while (my $k = each %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"; } while (my $k = each %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]~::~". "$file{$k}[8]~::~"; print FH "\n"; }close FH; } #update Last Scanned my $stime = ctime(time); chomp $stime; $SBSCRIBE{"$grp"} = "$stime"; &display_groups(); while($pb <= 100){ $pb += 2; $mw->update; } scan_end: $pb = 0; $lb2_msg->focus; $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $mw->update; $mw->Unbusy; } sub msglimit #------------------------------------------------ { if (!defined $Mlimit) { $e1_msgs->insert(1.0, '5000'); }elsif ($maxdl eq 'X') { $e1_msgs->delete(0, 'end'); $e1_msgs->insert(1.0, '5000'); } undef $maxdl; $Mlimit = 1; $dlnew = 0; $l1_msgs->configure(-text => "There are more than $totmsgs " . 'unread messages in this group.'); $tl9->deiconify(); $tl9->raise(); $e1_msgs->focus; $mw->update; loop_start: unless ($maxdl) { $mw->update; goto loop_start; } return($maxdl); } sub dlmsgs_ok #------------------------------------------------ { $maxdl = $e1_msgs->get; unless ($maxdl) { $maxdl = 'X'; } if ($maxdl == 0) { $maxdl = 'X'; } elsif ($maxdl =~ m/\D/) { $maxdl = 'X'; } elsif ($maxdl > $totmsgs) { $maxdl = $totmsgs; } $tl9->withdraw; } sub dlmsgs_all #------------------------------------------------ { $maxdl = $totmsgs; $tl9->withdraw; } sub dlmsgs_cancel #------------------------------------------------ { $maxdl = 'X'; $tl9->withdraw; } sub message_load #------------------------------------------------ { $sblabel = 'Loading newsgroup...'; $sb_lab->configure(-text => " $sblabel"); $mw->Busy(-recurse => 1); $lb2_msg->focus; $mw->update; my $imagedata = &load_image(2); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; #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: unless ($grp and $xxx[0]) { &error('scan_1'); goto message_load_end; }for (1..4) { $pb++; $mw->update; } #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('scan_2'); 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{$k}[8] = "old"; }while($pb <= 25) { $pb += 1; $mw->update; } }else{ goto message_load_end; } #populate old messages my @fkey = keys %file; @fkey = sort{$b <=> $a} @fkey; $last = $fkey[0]; $last++; my $lb2_k1 = $lb2_msg->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); my $lb2_k2 = $lb2_msg->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); my $c = 0; foreach (@fkey) { if ($pb >= 100) { $pb = 0; } if ($c > 2000) { $pb += 10; $mw->update; $c = 0; } else { $c++; } $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; message_load_end: while($pb <= 100) { $pb += 2; $mw->update; } $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $pb = 0; $lb2_msg->focus; $mw->Unbusy; $mw->update; } sub message_clear #------------------------------------------------ { $mw->Busy(-recurse => 1,); $sblabel = 'Clearing previously scanned messages from group...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; #make sure the group clicked has been loaded or scanned. my $group; my @xxx = $lb1_grp->selectionGet; eval {$group = $lb1_grp->itemCget($xxx[0], 0, -text)}; if ($@) { warn "Error - No valid group selected to clear.\n"; goto message_clear_end; } unless ($group eq $grp) { &message_load(); } $mw->Busy(-recurse => 1,); #get a list of paths for the message hlist &lb2_msg_select_all(); my @paths = $lb2_msg->infoSelection; unless ($paths[0]) { goto message_clear_end; } #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('msg_del_1'); 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]"; } } #clear group $last--; #the value of $last should be obtained from previous #scan or load operation. foreach (@paths) { unless ($_ == $last) { $lb2_msg->delete('entry', $_); delete $file{$_}; } }$mw->update; $last++; #update grp file open (FH, "> $grp.grp") or die "Cannot open $grp.grp\n\a$!"; if (\*FH) { while (my $k = each %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; } #update dat file open (FH, "> $grp.dat") or die "Cannot open $grp.dat\n\a$!"; close FH; print STDERR "The group $grp.grp has been cleared.\n"; message_clear_end: $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $lb1_grp->focus; $mw->update; $mw->Unbusy; } sub message_delete #------------------------------------------------ { $mw->Busy(-recurse => 1,); $sblabel = 'Deleting selected messages...'; $sb_lab->configure(-text => " $sblabel"); my @sel = $lb2_msg->selectionGet; $lb2_msg->focus; unless ($sel[0]) { goto message_delete_end; } #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('msg_del_1'); 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; $mw->update; #update grp file open (FH, "> $grp.grp") or &error('msg_del_1'); if (\*FH) { while (my $k = each %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; } message_delete_end: $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $mw->update; $mw->Unbusy; } sub b2_grab_cmd #------------------------------------------------ { my $open = $_[0]; unless ($open) { $open = 0; } $mw->Busy(-recurse => 1); $lb2_msg->focus; $pb = 0; #Grab what? my @grabs = $lb2_msg->selectionGet; unless ($grp and @grabs) { goto b2_grab_cmd_end; } #Connect my $nntp; $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); unless ($nntp) { &error('connect'); goto b2_grab_cmd_end; } if ($OPT{User} && $OPT{Pass}) { eval {$nntp->authinfo($OPT{User}, $OPT{Pass})}; if ($@) { warn "Error - Could not login.\n"; } } for(1..6) { $pb++; $mw->update; } my $imagedata = &load_image(2); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; #get selection(s) foreach my $msgnum (@grabs) { $sb_lab->configure(-text => " $sblabel"); #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 &error('grab_1'); my @multpart = (); close FH; foreach (@multpart) { my @multi = split('~::~', "$_"); my $k1 = shift @multi; $multipart{$k1} = [@multi]; }my $x = 0; foreach my $msgid (@{$multipart{$subje}}) { $x++; $sblabel = "Downloading... ($x of $parts)"; $sb_lab->configure(-text => " $sblabel"); for(1..6) { $pb++; $mw->update; } #download msg ids for subject $aref = $nntp->article("$msgid"); unless($aref) { &error('grab_4'); goto grab_end; } if ($pb > 99) { $pb = 0; $mw->update; } push (@art, @$aref); } }else{ $sblabel = 'Downloading... (1 of 1)'; $sb_lab->configure(-text => " $sblabel"); $mw->update; $nntp->group($grp); for(1..10) { $pb += 5; $mw->update; } $aref = $nntp->article("$msgnum"); unless($aref) { &error('grab_4'); goto grab_end; } push (@art, @$aref); } #convert my $res; $sblabel = 'Decoding attachment...'; $sb_lab->configure(-text => " $sblabel"); $pb = 0 if ($pb > 99); $pb += 5; $mw->update; my $cvt = new Convert::BulkDecoder(destdir => "$OPT{DDir}", crc => 0,); eval {$res = $cvt->decode(\@art) }; if ($@) { &error('grab_2b'); goto grab_end; } elsif ($res eq "DUP") { &error('grab_2a'); goto grab_end; } elsif ($res ne "OK") { &error('grab_2b'); goto grab_end; } #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('grab_3'); 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'; for(1..4) { $pb += 5; $mw->update; } #update grp file open (FH, "> $grp.grp") or &error('grab_3'); if (\*FH) { while (my $k = each %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 for (1..2) { $pb += 5; $mw->update; } if ($file{$msgnum}[7] eq 'read') { $lb2_msg->indicator('create', $msgnum, -itemtype => 'image', -image => $chek); } #open it? if ($res eq "OK") { print STDERR "Extracted ", $cvt->{size}, " bytes to file ", $cvt->{file}, "\n"; my $cvtfile = $cvt->{file}; $cvtfile =~ m#(\b.+)\/(.+\..{3,4})#; $cvtfile =~ m#(.+)\/(.+\..{3,4})# unless ($2); if ($open == 1) { if ($^O eq 'MSWin32') { chdir "$1"; system('start', '/B', "$2"); chdir "$cwd"; }else{ #text nix/nux/mac chdir "$1"; system("$2"); chdir "$cwd"; } } } grab_end: while ($pb < 100) { $pb += 2; $mw->update; } $pb = 0; $mw->update; } $nntp->quit(); b2_grab_cmd_end: $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $pb = 0; $mw->update; $mw->Unbusy; } sub b3_read_cmd #------------------------------------------------ { $mw->Busy(-recurse => 1,); $sblabel = 'Downloading message...'; $sb_lab->configure(-text => " $sblabel"); #Read what? my @sel = $lb2_msg->selectionGet; $lb2_msg->focus; unless ($grp && $sel[0]) { $mw->Unbusy; goto b3_read_cmd_end; } #Login my $nntp; $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); unless ($nntp) { &error('connect'); goto b3_read_cmd_end; } if ($OPT{User} && $OPT{Pass}) { eval {$nntp->authinfo($OPT{User}, $OPT{Pass})}; if ($@) { warn "Error - Could not login.\n"; } } #Download message $nntp->group($grp); my $msg = $nntp->article($sel[0]); $nntp->quit(); unless($msg) { &error('grab_4'); goto b3_read_cmd_end; }$tl4->deiconify(); $tl4->raise(); $mw->update; my $imagedata = &load_image(2); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; #Parse MIME my (@a, $qp,); foreach (@$msg) { $_ =~ m/Content-Transfer-Encoding:\s+(.+)/; if ($1) { $qp = 1; last; } } if ($qp) { foreach my $res (@$msg) { #The following altered code is borrowed from the module #MIME::QuotedPrint::Perl created by: Gisle Aas $res =~ s/\r\n/\n/g; # normalize newlines $res =~ s/[ \t]+\n/\n/g; # rule #3 (trailing space deleted) $res =~ s/=\n//g; # rule #5 (soft line breaks) if (ord('A') == 193) { # EBCDIC style machine if (ord('[') == 173) { $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047', Encode::decode('iso-8859-1',pack("C", hex($1))))/gex; } elsif (ord('[') == 187) { $res =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc', Encode::decode('iso-8859-1',pack("C", hex($1))))/gex; } elsif (ord('[') == 186) { $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp37', Encode::decode('iso-8859-1',pack("C", hex($1))))/gex; } }else{ # ASCII style machine $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; }push(@a, $res); }undef $msg; $msg = \@a; } #populate text undef $typed; $typed = $lb2_msg->itemCget($sel[0], 1, -text); $typed .= " wrote in message-id:\n"; foreach (@$msg) { $txt_read->insert('end', "$_"); } undef $msg; $mw->Unbusy; $txt_read->focus; $tl4->update; #load grp file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('read_1'); 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{$sel[0]}[7] = 'read'; $typed .= $file{$sel[0]}[3]; $mw->update; #update grp file open (FH, "> $grp.grp") or &error('read_1'); if (\*FH) { while (my $k = each %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{$sel[0]}[7] eq 'read') { $lb2_msg->indicator('create', $sel[0], -itemtype => 'image', -image => $chek); }b3_read_cmd_end: $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $mw->Unbusy; $mw->update; } sub b1_read_close #------------------------------------------------ { $txt_read->delete("1.0", 'end'); $tl4->withdraw; $b2_read ->configure(-text => 'Reply', -command => \&b2_read_reply); $tl4 ->configure(-title => 'Read Message'); $mw->update; } sub b2_read_reply #------------------------------------------------ { $mw->Busy(-recurse => 1); my $counter = 0; my $gotsubj = 0; my $gotref = 0; my $txt = $txt_read->get('1.0', 'end'); $txt_read->delete("1.0", 'end'); $tl4->withdraw; my @tmp = split('\n', $txt); undef $txt; undef $mid; undef $refs; undef $subj; foreach my $line (@tmp) { my $a; $line =~ m/(.*)/; unless ($1) { $counter++; } unless ($gotref == 1) { if ($line =~ m/References:\s+?(.*)/) { if ($1) { $gotref = 1; $refs = $1; } } elsif ($line =~ m/Message-ID:\s+?(.*)/) { if ($1) { $mid = $1; } } } unless ($gotsubj == 1) { if ($line =~ m/(Subject:\s+?)(.*)/) { if ($2) { $a = $2; $gotsubj = 1; if ($a =~ m/[Rr][Ee]:.*/) { $subj = $a; } else { $subj = "Re: $a"; } } } }if ($counter >= 1) { $txt .= ">$line\n"; } } if ($refs && $mid) { $refs .= $mid }; $txt_post->insert('end', "$typed\n"); undef $typed; $txt_post->insert('end', "$txt"); $mw->Unbusy; &b4_post_cmd(); } sub b4_post_cmd #------------------------------------------------ { unless ($grp) { &error('post_1'); goto post_end; } $tl2->deiconify(); $tl2->raise(); $txt_post->focus; $from = $OPT{Mail}; post_end: $mw->update; } sub b1_post_cancel #------------------------------------------------ { $txt_post->delete('1.0', 'end'); undef $subj; $tl2->Unbusy; $tl2->withdraw(); } sub b2_post_attach #------------------------------------------------ { my $file = $mw->getOpenFile(); $mw->update; if (defined $file) { #what is the filename? $file =~ m/.+\/(.+)/; my $filename = $1; #how large is the file? my $fsize = -s $file; $fsize /= 1024; #round fsize up to next k $fsize =~ m/(\d+)\./; $fsize = $1; $fsize++; #open the file. open (ATCH, "$file") or &error('post_atch_1'); #if the file is larger than posting limit. #ToDo attachments if ($fsize > 960) { &error('post_attach_tobig'); close ATCH; goto post_attach_end; ##how many parts will this be? #my $tot = $fsize / 400; #$tot =~ m/(\d+)\.(\d+)/; $tot = $1; $tot++ if ($2); ##read 400k chunks of the file into a string. #binmode (ATCH); #my ($buf, $string,); my $cur = 1; #while (sysread(ATCH, $buf, 409600)) { # #uuencode each 400k string. # my $atch = uuencode($buf, $filename); undef $buf; # &b3_post_post($atch, "$cur", "$tot"); undef $atch; # $cur++; #} }else{ my $atch = uuencode(\*ATCH, $filename); close ATCH; &b3_post_post($atch, 1, 1); } }post_attach_end: } sub b3_post_post #------------------------------------------------ { my $atch = $_[0]; my $cur = $_[1]; my $tot = $_[2]; my $msg; $b1_post->configure(-state => 'disabled'); $b2_post->configure(-state => 'disabled'); $b3_post->configure(-state => 'disabled'); $tl2->Busy(-recurse => 1,); $sblabel = 'Formatting message...'; $sb_lab->configure(-text => " $sblabel"); for (1..4) { $pb++; $mw->update; } #if doing multipart, update subj with [x/x] $subjsave = $subj unless ($cur > 1); if ($atch) { $subj = "$subjsave"." [$cur/$tot] "; undef $subjsave; } my $hdr; unless ($subj) { $subj = 'No Subject'; } if ($refs || $mid) { unless ($refs) { $refs = $mid; } $hdr = 'Newsgroups: '."$grp\n". 'Distribution: '."world\n". 'References: '."$refs\n". 'X-NNTPclient: '."NewsSurfer v2.9\n". 'X-CreatedBy: '." Just another Perl hacker...\n". 'From: '."$from\n". 'Subject: '."$subj\n\n\n"; }else{ $hdr = 'Newsgroups: '."$grp\n". 'Distribution: '."world\n". 'X-NNTPclient: '."NewsSurfer v2.9\n". 'X-CreatedBy: '." Just another Perl hacker...\n". 'From: '."$from\n". 'Subject: '."$subj\n\n\n"; } my $bdy = $txt_post->get("1.0", 'end'); for (1..4) { $pb++; $mw->update; } if ($cur > 1) { $msg = "$hdr"."\n\n"; } else { $msg = "$hdr"."$bdy\n\n"; } if ($atch) { $sblabel = 'Attaching file(s)...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; $msg .= $atch; undef $atch; } if ($OPT{UseSig} == 1) { $sblabel = 'Attaching signature...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; open (FH, "< $OPT{Sig}") or &error('sig1') and goto end_sig; my @sig = (); close FH; $msg .= "--\n"; foreach (@sig) { chomp $_; $msg .= "$_\n"; } }end_sig: $sblabel = 'Posting message...'; $sb_lab->configure(-text => " $sblabel"); for (1..4) { $pb += 4; $mw->update; } #login my $connected; my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); unless ($nntp) { &error('connect'); goto b3_post_post_end; } $connected = 1; if ($OPT{User} && $OPT{Pass}) { $nntp->authinfo($OPT{User}, $OPT{Pass}); } #post $nntp->post(["$msg"]); $nntp->quit; while ($pb < 100) { $pb += 2; $mw->update; } $pb = 0; $mw->update; b3_post_post_end: $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $b1_post->configure(-state => 'normal'); $b2_post->configure(-state => 'normal'); $b3_post->configure(-state => 'normal'); $mw->update; if ($connected) { &b1_post_cancel(); } } sub b5_bros_cmd #--------------------------------------------------- { $mw->Busy(-recurse => 1); if ($^O eq 'MSWin32') { my $dir = $OPT{DDir}; $dir =~ s#\/#\\#g; system("explorer.exe", "$dir"); }else{ system("ls", "$OPT{DDir}"); #test } $mw->update; $mw->Unbusy; } sub rset_cmd #--------------------------------------------------- { $lb2_msg->delete('all'); my $sel = $lb1_grp->selectionGet; unless ($sel) { print STDERR "No valid groups selected for reset.\n"; goto b5_reset_end; } my $rem = $lb1_grp->itemCget($sel, 0, -text); if (-e "$rem.grp") { unless (unlink "$rem.grp") { &error('rset_1'); goto b5_reset_end; } } if (-e "$rem.dat") { unless (unlink "$rem.dat") { &error('rset_1'); goto b5_reset_end; } } $SBSCRIBE{$rem} = 'Never'; &display_groups(); b5_reset_end: } sub b6_grp_cmd #------------------------------------------------ { $tl3->deiconify(); $tl3->raise(); $tl3->Busy(-recurse => 1,); $sblabel = 'Loading groups...'; $sb_lab->configure(-text => " $sblabel"); $lb_grp->focus; $mw->update; my $imagedata = &load_image(3); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; $b1_grp ->configure(-state => 'disabled'); $b2_grp ->configure(-state => 'disabled'); $b3_grp ->configure(-state => 'disabled'); $b4_grp ->configure(-state => 'disabled'); $b5_grp ->configure(-state => 'disabled'); $e1_grp ->configure(-state => 'disabled'); $b1_scan->configure(-state => 'disabled'); $b2_grab->configure(-state => 'disabled'); $b3_read->configure(-state => 'disabled'); $b4_post->configure(-state => 'disabled'); $b5_bros->configure(-state => 'disabled'); $b6_grp ->configure(-state => 'disabled'); $b7_opt ->configure(-state => 'disabled'); $b8_help->configure(-state => 'disabled'); $b9_exit->configure(-state => 'disabled'); for (1..4) { $pb++; $mw->update; } if (-e 'groups') { unless (open (FH, '< groups')) { &error('grp_1'); goto cant_open; } my @groups = (); close FH; for (1..6) { $pb++; $mw->update; } my $counter = 0; my $c = 0; my $lb_grp_s1 = $lb_grp->ItemStyle('text', -selectforeground => '#000000', -selectbackground => '#fff000', -bg => '#000000', -fg => '#ffffff', -font => '{Arial} 8', -anchor => 'w',); while (@groups) { #groupname~::~total\n chomp(my $line = shift @groups); my @row = split('~::~', $line); $lb_grp->add($counter); $lb_grp->itemCreate($counter, 0, -text => $row[0], -style => $lb_grp_s1,); $lb_grp->itemCreate($counter, 1, -text => $row[1], -style => $lb_grp_s1,); if ($SBSCRIBE{$row[0]}) { $lb_grp->indicator('create', $counter, -itemtype => 'image', -image => $chek); } if ($pb >= 100) { $pb = 0; $mw->update; } if ($c > 1000) { $pb += 5; $mw->update; $c = 0; } else { $c++; } $counter++; } }else{ cant_open: $lb_grp->add(0); $lb_grp->itemCreate(0,0, -text => 'Press the Update button'. ' to retrieve groups from server.'); } $pb = 100; $mw->update; $b1_grp->configure(-state => 'normal'); $b2_grp->configure(-state => 'normal'); if (-e 'groups') { $b3_grp->configure(-state => 'normal'); $b4_grp->configure(-state => 'normal'); $b5_grp->configure(-state => 'normal'); $e1_grp->configure(-state => 'normal'); } $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $pb = 0; $mw->update; $lb_grp->focus; $tl3->Unbusy; } sub b1_grp_close #------------------------------------------------- { $mw->Busy(-recurse => 1); $mw->update; $lb_grp->delete('all'); $tl3->withdraw; $b1_scan->configure(-state => 'normal'); $b2_grab->configure(-state => 'normal'); $b3_read->configure(-state => 'normal'); $b4_post->configure(-state => 'normal'); $b5_bros->configure(-state => 'normal'); $b6_grp ->configure(-state => 'normal'); $b7_opt ->configure(-state => 'normal'); $b8_help->configure(-state => 'normal'); $b9_exit->configure(-state => 'normal'); $mw->update; $mw->Unbusy; } sub b2_grp_update #------------------------------------------------- { $tl3->Busy(-recurse => 1,); $sblabel = 'Downloading groups...'; $sb_lab->configure(-text => " $sblabel"); $lb_grp->delete('all'); $mw->update; my $nntp = Net::NNTP->new("$OPT{Serv}", Debug => 1, Timeout => 30,); unless ($nntp) { &error('connect'); goto b2_grp_update_end; } if ($OPT{User} && $OPT{Pass}) { $nntp->authinfo($OPT{User}, $OPT{Pass}); } my $listref = $nntp->list(); $nntp->quit(); my %HoA = %$listref; undef $listref; #(HoA) groupname = last, first, moderated #pl.misc.telefonia.gsm: 0000339959 0000307277 y #mvis.lists.apache.talk: 0000003574 0000003322 m $sblabel = 'Creating groups file...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; open (FH, '> groups') or &error('grp_update_1'); for (sort keys %HoA) { my $total = $HoA{$_}[0] - $HoA{$_}[1]; print FH "$_~::~$total\n"; } close FH; b2_grp_update_end: $tl3->Unbusy; &b1_grp_close(); $b6_grp->invoke; $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $mw->update; } sub b3_grp_subscribe #-------------------------------------------- { my $imagedata = &load_image(3); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; 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) { #unsubscribe from main screen my $sel = $lb1_grp->selectionGet; unless ($sel) { print STDERR "No valid group selected to remove.\n\a"; goto b4_grp_unsubscribe_end; } my $a = $lb1_grp->itemCget($sel, 0, -text); delete $SBSCRIBE{$a}; $lb2_msg->delete('all'); if (-e "$a.grp") { unlink "$a.grp" or &error('grp_unsub_1', "$a"); } if (-e "$a.dat") { unlink "$a.dat" or &error('grp_unsub_1', "$a"); } }else{ #unsubscribe from groups screen my @sel = $lb_grp->selectionGet; unless (@sel) { print STDERR "No valid group selected to remove.\n\a"; goto b4_grp_unsubscribe_end; } foreach (@sel) { my $a = $lb_grp->itemCget($_, 0, -text); $lb_grp->indicator('delete', $_,); delete $SBSCRIBE{$a}; if (-e "$a.grp") { unlink "$a.grp" or &error('grp_unsub_1', "$a"); } if (-e "$a.dat") { unlink "$a.dat" or &error('grp_unsub_2', "$a"); } } }b4_grp_unsubscribe_end: &display_groups(); } sub display_groups #------------------------------------------------ { my $counter = 1; $lb1_grp->delete('all'); my $lb1_k1 = $lb1_grp->ItemStyle('text', -anchor => 'w', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); my $lb1_k2 = $lb1_grp->ItemStyle('text', -anchor => 'e', -selectforeground => '#fff000', -background => '#ffffff', -foreground => '#000000', -font => '{Arial} 8',); for my $k (sort keys %SBSCRIBE) { $lb1_grp->add($counter); $lb1_grp->itemCreate($counter, 0, -text => "$k", -style => $lb1_k1,); $lb1_grp->itemCreate($counter, 1, -text => "$SBSCRIBE{$k}", -style => $lb1_k2,); $counter++; } } sub search_popup #-------------------------------------------------- { #make sure the group clicked has been loaded or scanned. my $group; my @xxx = $lb1_grp->selectionGet; eval {$group = $lb1_grp->itemCget($xxx[0], 0, -text)}; if ($@) { print STDERR 'No valid group selected to search.'. "\nEval: $@\a\n"; } unless ($group eq $grp) { &message_load(); } #raise popup $tla->deiconify; $tla->raise; $e1_sea->focus; $mw->update; } sub search #------------------------------------------------------- { my $w = $_[0]; #works for HLists only $w->focus; $mw->Busy(-recurse => 1,); $sblabel = 'Searching groups...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; unless ($search) { &error('grp_search_1'); goto grp_search_end; } $tla->withdraw; my @paths = $w->infoChildren; $search =~ s/([\+ \* \. \? \^ \$]+)/\\$1/; my $c = 0; foreach my $path (@paths) { my $item = $w->itemCget($path, 0, -text); if ($item =~ m/$search/i) { $w->show('entry', $path); } else { $w->hide('entry', $path); } $c++; if ($c >= 1000) { if ($pb >= 100) { $pb = 0; } else { $pb++; } $c = 0; $mw->update; } } grp_search_end: undef $search; while ($pb < 100) { $pb += 2; $mw->update; } $pb = 0; $sblabel = 'Ready'; $sb_lab->configure(-text => " $sblabel"); $mw->update; $mw->Unbusy; } sub b7_opt_cmd #----------------------------------------------- { $tl5->deiconify(); $tl5->raise(); $tl5->focus; } sub conf_browse_dir #----------------------------------------------- { $e6_conf->delete(0, 'end'); $tl5->update; my $dir; eval { $dir = $tl5->chooseDirectory(-title => 'Choose a download '. 'directory.', -initialdir => '.', -mustexist => 1,) }; if ($@) { &error('conf_browse1'); } if ($dir) { $OPT{DDir} = "$dir"; $e6_conf->insert('end', "$dir"); }else{ $OPT{DDIR} = "."; $e6_conf->insert('end', "."); }$tl5->update; } sub conf_sig_file #------------------------------------------------ { $e7_conf->delete(0, 'end'); $tl5->update; my $sig; my $ofile = $tl5->getOpenFile(-title => 'Choose Signature File', -initialdir => '.',); if ($ofile) { $OPT{Sig} = "$ofile"; $e7_conf->insert('end', "$ofile"); }$tl5->update; } sub view_log #------------------------------------------------ { $mw->Busy(-recurse => 1); close STDERR; open FH, '); close FH; open STDERR, '>>NewsSurfer.log' or warn "Cannot open NewsSurfer.log\a\n"; $tl4->configure (-title => "View Log"); $b2_read->configure(-text => 'Save', -command => sub { open FH, '); close FH; my $sf = $tl4->getSaveFile(-title => 'Save Log',); if ($sf) { $mw->Busy(-recurse => 1); open(FH, ">$sf") or warn "Cannot save log.\a\n$!"; foreach (@log) { chomp; print FH "$_\n"; } close FH; $mw->Unbusy; } }); $tl4->deiconify(); $tl4->raise(); $txt_read->focus; $mw->update; foreach (@log) { chomp; s/^Net.*\)(<|>.*)/$1/; if (/^>>>.*/) { $txt_read->insert('end', "$_\n", 'Blue'); }elsif (/Error\s-\s.+/) { $txt_read->insert('end', "$_\n", 'Red'); }else{ $txt_read->insert('end', "$_\n"); } } $mw->update; $mw->Unbusy; } sub b8_help_cmd #------------------------------------------------ { $tl6->deiconify(); $tl6->raise(); $txt_help->focus; $txt_help->delete("1.0", 'end'); $txt_help->insert('end', "NewsSurfer can download binaries and read ". "messages on usenet newsgroups.\n". "You can use NewsSurfer to post messages and ". "attachments.\n\n"); $mw->update; } sub help_about #------------------------------------------------ { $txt_help->delete("1.0", 'end'); $txt_help->insert('end', "NewsSurfer v2.9 - Copyright 2004 - 2005\n\n". "Created by: Jason McManus\n". 'Contact : QoS@'."cpan.org\n"); $mw->update; } sub b9_exit_cmd #------------------------------------------------ { $mw->Busy(-recurse => 1,); dbmclose(%SBSCRIBE); dbmclose(%OPT); print STDERR 'NewsSurfer has closed. (' . localtime() . ")\n"; exit; } sub lb1_grp_menu #------------------------------------------------ { $f1_menu1->focus; my ($x, $y) = $mw->pointerxy; $tl7->geometry('+'."$x".'+'."$y"); $tl7->deiconify(); $tl7->raise(); } sub lb2_msg_menu #------------------------------------------------ { my $opt = $_[0]; my ($x, $y) = $mw->pointerxy; unless ($opt) { my $s = $lb2_msg->nearest($y - $lb2_msg->rooty); $lb2_msg->selectionClear(); $lb2_msg->selectionSet($s); } $y -= 130; $f1_menu2->focus; $tl8->geometry('+'."$x".'+'."$y"); $tl8->deiconify(); $tl8->raise(); } sub lb2_msg_select_all #-------------------------------------------- { $mw->Busy(-recurse => 1); my @paths = $lb2_msg->infoChildren; $lb2_msg->focus; unless (@paths) { goto lb2_msg_select_all_end; } my $count = $#paths; my $home = $paths[0]; my $end = $paths[$count]; $lb2_msg->selectionSet("$home", "$end"); lb2_msg_select_all_end: $mw->update; $mw->Unbusy; } sub lb2_msg_select_end #-------------------------------------------- { my $sel = $lb2_msg->selectionGet; my @paths = $lb2_msg->infoChildren; my $count = $#paths; my $end = $paths[$count]; $lb2_msg->selectionSet($sel, "$end"); $mw->update; } sub lb2_msg_select_hom #-------------------------------------------- { my $sel = $lb2_msg->selectionGet; my @paths = $lb2_msg->infoChildren; my $home = $paths[0]; $lb2_msg->selectionSet($sel, "$home"); $mw->update; } sub lb2_msg_sort #------------------------------------------------- { my $col = $_[0]; my $opt = $_[1]; my @y; $sort_cnt++; $mw->Busy(-recurse => 1,); $lb2_msg->delete('all'); $sblabel = 'Sorting...'; $sb_lab->configure(-text => " $sblabel"); $mw->update; my $imagedata = &load_image(2); my $chek = $mw->Photo(-format => 'bmp', -data => $imagedata); undef $imagedata; #load group file my %file; if (-e "$grp.grp") { open (FH, "< $grp.grp") or &error('sort_1'); 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]"; } } #sort if ($sort_cnt % 2) { if ($opt == 1) { @y = sort{$file{$b}[$col] cmp $file{$a}[$col]} keys %file; }elsif ($opt == 2) { @y = sort{$file{$b}[$col] <=> $file{$a}[$col]} keys %file; }else{ @y = sort{str2time($file{$b}[$col]) <=> str2time($file{$a}[$col])} keys %file; } }else{ if ($opt == 1) { @y = sort{$file{$a}[$col] cmp $file{$b}[$col]} keys %file; }elsif ($opt == 2) { @y = sort{$file{$a}[$col] <=> $file{$b}[$col]} keys %file; }else{ @y = sort{str2time($file{$a}[$col]) <=> str2time($file{$b}[$col])} keys %file; } } #re-populate my $c = 0; foreach my $k (@y) { my ($lb2_k1, $lb2_k2,); if ($file{$k}[4] eq 'old') { $lb2_k1 = $lb2_msg->ItemStyle('text', -selectforeground => '#fff000', -bg => '#ffffff', -fg => '#000000', -anchor => 'e', -font => '{Arial} 8',); $lb2_k2 = $lb2_msg->ItemStyle('text', -selectforeground => '#fff000', -bg => '#ffffff', -fg => '#000000', -anchor => 'w', -font => '{Arial} 8',); }else{ $lb2_k1 = $lb2_msg->ItemStyle('text', -selectforeground => '#fff000', -bg => '#ffffff', -fg => 'blue', -anchor => 'e', -font => '{Arial} 8',); $lb2_k2 = $lb2_msg->ItemStyle('text', -selectforeground => '#fff000', -bg => '#ffffff', -fg => 'blue', -anchor => 'w', -font => '{Arial} 8',); } if ($c > 100) { $mw->update; $c = 0; } else { $c++ } $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); } } $sblabel = 'Ready'; $sb_lab->configure