summaryrefslogtreecommitdiffstats
path: root/util/waterball.pl
diff options
context:
space:
mode:
authorin2 <in2@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2002-03-07 23:13:44 +0800
committerin2 <in2@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2002-03-07 23:13:44 +0800
commitae31e19f92e717919ac8e3db9039eb38d2b89aae (patch)
treec70164d6a1852344f44b04a653ae2815043512af /util/waterball.pl
downloadpttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar.gz
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar.bz2
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar.lz
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar.xz
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.tar.zst
pttbbs-ae31e19f92e717919ac8e3db9039eb38d2b89aae.zip
Initial revision
git-svn-id: http://opensvn.csie.org/pttbbs/pttbbs/trunk/pttbbs@1 63ad8ddf-47c3-0310-b6dd-a9e9d9715204
Diffstat (limited to 'util/waterball.pl')
-rw-r--r--util/waterball.pl149
1 files changed, 149 insertions, 0 deletions
diff --git a/util/waterball.pl b/util/waterball.pl
new file mode 100644
index 00000000..7f49d3c5
--- /dev/null
+++ b/util/waterball.pl
@@ -0,0 +1,149 @@
+#!/usr/bin/perl
+use lib '/home/bbs/bin/';
+use LocalVars;
+use Time::Local;
+use POSIX;
+use FileHandle;
+use strict;
+use Mail::Sender;
+
+my($fndes, $fnsrc, $userid, $mailto, $outmode);
+foreach $fndes ( <$JOBSPOOL/water.des.*> ){ #des: userid, mailto, outmode
+ (open FH, "< $fndes") or next;
+ chomp($userid = <FH>);
+ chomp($mailto = <FH>);
+ chomp($outmode= <FH>);
+ close FH;
+ next if( !$userid );
+ print "$userid, $mailto, $outmode\n";
+ `rm -Rf $TMP/water`;
+ `mkdir $TMP/water`;
+
+ $fnsrc = $fndes;
+ $fnsrc =~ s/\.des\./\.src\./;
+ eval{
+ process($fnsrc, "$TMP/water/", $outmode, $userid);
+ };
+ if( $@ ){
+ print "$@\n";
+ }
+ else{
+ chdir "$TMP/water";
+ if( $mailto eq '.' || $mailto =~ /\.bbs/ ){
+ $mailto = "$userid.bbs\@$hostname" if( $mailto eq '.' );
+ foreach my $fn ( <$TMP/water/*> ){
+ my $who = substr($fn, rindex($fn, '/') + 1);
+ my $content = '';
+ open FH, "< $fn";while( <FH> ){chomp;$content .= "$_\n";}
+ if( !MakeMail({mailto => $mailto,
+ subject => "和 $who 的水球記錄",
+ body => $content,
+ }) ){ print "fault\n"; }
+ }
+ unlink $fnsrc;
+ unlink $fndes;
+ }
+ else{
+ if( MakeMail({tartarget => "$TMP/$userid.waterball.tgz",
+ tarsource => "*",
+ mailto => "$userid <$mailto>",
+ subject => "水球紀錄",
+ body =>
+ "\n ptt2 站長群 ". POSIX::ctime(time())}
+ ) ){
+ unlink $fnsrc;
+ unlink $fndes;
+ }
+ }
+ }
+}
+
+sub process
+{
+ my($fn, $outdir, $outmode, $me) = @_;
+ my($cmode, $who, $time, $say, $orig, %FH, %LAST, $len);
+ open DIN, "< $fn";
+ while( <DIN> ){
+ chomp;
+ next if( !(($cmode, $who, $time, $say, $orig) = parse($_)) );
+ next if( !$who );
+
+ if( ! $FH{$who} ){
+ $FH{$who} = new FileHandle "> $outdir/$who";
+ }
+ if( $outmode == 0 ){
+ next if( $say =~ /<<下站通知>> -- 我走囉!/ ||
+ $say =~ /<<上站通知>> -- 我來啦!/ );
+ if( $time - $LAST{$who} > 1800 ){
+ if( $LAST{$who} != 0 ){
+ ($FH{$who})->print( POSIX::ctime($LAST{$who}) , "\n");
+ }
+ ($FH{$who})->print( POSIX::ctime($time) );
+ $LAST{$who} = $time;
+ }
+ $len = (length($who) > length($me) ? length($who) : length($me))+1;
+ ($FH{$who})->printf("%-${len}s %s\n", ($cmode?$who:$me).':', $say);
+ }
+ elsif( $outmode == 1 ){
+ ($FH{$who})->print("$orig\n");
+ }
+ }
+ if( $outmode == 0 ){
+ foreach( keys %FH ){
+ ($FH{$_})->print( POSIX::ctime($LAST{$_}) );
+ }
+ }
+ foreach( keys %FH ){
+ ($FH{$_})->close();
+ }
+ close DIN;
+}
+
+sub parse
+{
+ my $dat = $_[0];
+ my($cmode, $who, $year, $month, $day, $hour, $min, $sec, $say);
+ if( $dat =~ /^To/ ){
+ $cmode = 0;
+ ($who, $say, $month, $day, $year, $hour, $min, $sec) =
+ $dat =~ m|^To (\w+):\s*(.*)\[(\d+)/(\d+)/(\d+) (\d+):(\d+):(\d+)\]|;
+ }
+ else{
+ $cmode = 1;
+ ($who, $say, $month, $day, $year, $hour, $min, $sec) =
+ $dat =~ m|★(\w+?)\[37;45m\s*(.*)\[m \[0m\[(\w+)/(\w+)/(\w+) (\w+):(\w+):(\w+)\]|;
+
+ }
+# $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+
+ return undef if( $month == 0 );
+ return ($cmode, $who, timelocal($sec, $min, $hour, $day, $month - 1, $year), $say, $_[0]);
+}
+
+sub MakeMail
+{
+ my($arg) = @_;
+ my $sender;
+ `$TAR zcf $arg->{tartarget} $arg->{tarsource}`
+ if( $arg->{tarsource} );
+ $sender = new Mail::Sender{smtp => $SMTPSERVER,
+ from => "$hostname水球整理程式 <in2\@ptt2.csie.ntu.edu.tw>"};
+ foreach( 0..3 ){
+ if( (!$arg->{tartarget} &&
+ $sender->MailMsg({to => $arg->{mailto},
+ subject => $arg->{subject},
+ msg => $arg->{body}
+ }) ) ||
+ ($arg->{tartarget} &&
+ $sender->MailFile({to => $arg->{mailto},
+ subject => $arg->{subject},
+ msg => $arg->{body},
+ file => $arg->{tartarget}})) ){
+ unlink $arg->{tartarget} if( $arg->{tartarget} );
+ return 1;
+ }
+ }
+ print "fault\n";
+ unlink $arg->{tartarget} if( $arg->{tartarget} );
+ return 0;
+}