bagder: curl-www nicedate.pm,NONE,1.1 last20threads.pl,NONE,1.1

[email protected]
Newsgroups gmane.comp.web.curl.www.cvs
Message-ID <[email protected]>
Update of /cvsroot/curl/curl-www
In directory labb.contactor.se:/tmp/cvs-serv28196

Added Files:
	nicedate.pm last20threads.pl 
Log Message:
new scripts for the front page recent mailing list mails box


--- NEW FILE: last20threads.pl ---
#!/usr/bin/perl

require "dl/pbase.pm";
require "nicedate.pm";
require "CGI.pm";

my $tree="mail/";

my %listnames = ('archive' => 'Users',
                 'lib' => 'Library',
                 'curlphp' => 'PHP',
                 'curlpython' => 'Python');

opendir(DIR, $tree) || die "can't opendir $tree: $!";
my @archives = grep { /^(.*)-(\d\d\d\d)-(\d\d)$/ && -d "$tree/$_" } readdir(DIR);
closedir DIR;

my $numberoutput=10;

my %d;

my %log; # {$file}=$date
my %name; # {$file}=$name
my %email; # {$file}=$email
my %subject; # {$file}=$subject
my %inreplyto; # {$file}=$subject

my %store; # subject counter {$subject)=$num
my %start; # thread start {$subject}=$file
my %last; # thread end {$subject}=$file

for $f (sort @archives) {
    if($f =~ /^(.*)-(\d\d\d\d-\d\d)$/) {
        $d{$2}.="$f ";
    }
    #print "$f\n";
}

my $numscannedmails;

for $date (reverse sort keys %d) {
    if($date =~ /^(\d\d\d\d)-(\d\d)$/) {
        my ($y, $m) = ($1, $2);
        # now we have a year and date to scan

        my @check = split(/ /, $d{$date});
        for(@check) {
            #print "$tree$_\n";
            getthreads("$tree$_");
        }

        if($numscannedmails > 1000) {
            last;
        }
    }
}

my $c;
my %shown;

print <<MOO
<table class=\"latestmail\" cellpadding=\"2\" cellspacing=\"0\" 
 summary=\"lists several recent curl mailing list postings\">
<caption>Recent Mails on the Mailing Lists</caption>
<tr class="tabletop">
<th>Subject</th>
<th>GMT</th>
<th>Author</th>
<th>Thread</th>
<th>List</th>
</tr>
MOO
    ;

for(reverse sort { $log{$a} cmp $log{$b} } keys %log) {


    my $s = $subject{$_};
 
    my $thr;
    my $numthr = $store{$subject{$_}};

    if($start{$s} eq $_) {
        if($numthr > 1) {
            $thr="($numthr) först";
        }
        else {
            $thr="(1)";
        }
    }
    else {
        my $st = $start{$s};      
        my $s = file2url($start{$s});

        $thr = "($numthr)";
        if($st) {
            $thr .= " <a href=\"$s\">thread</a>";
        }
    }

    if(!$shown{$s}) {
        my $short = $name{$_};

        my $line=$c&1?"odd":"even";

        my $subj = $subject{$_};
        if(length($subj) > 50) {
            $subj = substr($subj, 0, 50)."...";
        }

        my $subjectline=sprintf("<tr class=\"%s\"><td<a href=\"%s\">%s</a></td>\n",
                                $line,
                                file2url($_),
                                $subj?$subj:"(tom)");

        #20041105 11:05:25
        my $da = $log{$_};
        my $stamp;
        if($da =~ /^(\d\d\d\d\d\d\d\d)(\d\d)(\d\d)(\d\d)/) {
            $stamp=`date -u -d "$1 $2:$3:4 +0100" +%s`;
            chomp $stamp;
            $stamp=reltime($stamp);
        }

        my $list=file2list($_);
        my $listdesc = listname2desc($list);
        my $listurl="http://curl.haxx.se/mail/";

        my $infoline=sprintf("<td>%s</td><td>%s</td><td>%s</td><td><a href=\"%s\">%s</a></td></tr>\n",
                             $stamp,
                             $short,
                             $thr,
                             $listurl,
                             $listdesc);

        print $subjectline, $infoline;

        if($c++>=$numberoutput) {
            last;
        }
        $shown{$s}++;
    }
}
print "</table>\n";

sub file2url {
    my ($file)=@_;
    $file =~ s!^$tree!http://curl.haxx.se/mail/!;
    return $file;
}

sub file2list {
    my ($file)=@_;
    $file =~ s!^$tree!!;
    $file =~ s/-([0-9\/-]*)\.html//;
    return $file;
}

#<!-- isoreceived="20041102134857" -->
#<!-- sent="Tue, 2 Nov 2004 14:48:55 +0100 (CET)" -->
#<!-- isosent="20041102134855" -->
#<!-- name="Daniel Stenberg" -->
#<!-- email="[email protected]" -->
#<!-- subject="Re: Nyligen publicerat - ska allt finnas där?" -->

sub parsehtmlfile {
    my ($file) = @_;

    open(FILE, "<$file");
    my ($date, $name, $email, $subject, $inreplyto);
    while(<FILE>) {
        if(/^<!-- isoreceived=\"([^\"]*)\"/) {
            $date = $1;
        }
        elsif(/^<!-- name=\"([^\"]*)\"/) {
            $name = $1;
        }
        elsif(/^<!-- email=\"([^\"]*)\"/) {
            $email = $1;
        }
        elsif(/^<!-- subject=\"([^\"]*)\"/) {
            $subject = $1;
        }
        elsif(/^<!-- inreplyto=\"([^\"]*)\"/) {
            $inreplyto = $1;
        }
        elsif(/^<!-- body=\"start\" -->/) {
            last;
        }
    }
    close(FILE);
    return $date, $name, $email, $subject, $inreplyto;
}


sub getthreads {
    my ($dir) = @_;

    opendir(DIR, $dir) || die "can't opendir $dir: $!";
    my @mails = grep { /^(\d+)\.html$/ && -f "$dir/$_" } readdir(DIR);
    closedir DIR;

    for $m (reverse sort @mails) {
        #print " $dir/$m\n";
        my $file = "$dir/$m";
        my ($date, $name, $email, $subject, $inreplyto)= parsehtmlfile($file);

        $numscannedmails++;

        my $s= $subject;

        $s =~ s/^((Sv|Re): *)*//i;

        $store{$s}++;

        if(!$inreplyto) {
            # thread-starter
            $start{$s}=$file;
        }
        else {
            if(!$last{$s}) {
                $last{$s} = $file;
            }
        }

        $log{$file}=$date;
        $name{$file}=$name;
        $email{$file}=$email;
        $subject{$file}=$s;
        $inreplyto{$file}=$inreplyto;

    }

}

sub listname2desc {
    my ($short)= @_;

    my $n = $listnames{$short};

    if($n) {
        return $n;
    }

    return $short;
}

--- NEW FILE: nicedate.pm ---
use POSIX qw/strftime/;

my @mname = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
             'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
my @dname = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday',
             'Saturday','Sunday');
my @ord = ( "th", "st", "nd", "rd", "th",
            "th", "th", "th", "th", "th",
            "th", "th", "th", "th", "th",
            "th", "th", "th", "th", "th" );
 
my %mnum = ( Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
             Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11 );

sub reltime {
    my $then_t  = $_[0];

    my $now_t = time();
    my @now = localtime( $now_t );
    my @yday = localtime( $now_t - 86400 );
    my @then = localtime( $then_t );
    my $diff = $now_t - $then_t;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @then;

    if ( $diff > 200*86400 ) {
        # another year
        $str = strftime( "%Y-%m-%d", @then );
    }
    elsif ( $diff > 5*86400 ) {
        # not last week
        $str = sprintf( "%d%s %s %02d:%02d", 
                        $mday, $ord[ $mday % 20 ], $mname[$mon],
                        $hour, $min);
    }
    elsif ($mday != $now[3]) {
        if ( $mday == $yday[3] ) {
            # yesterday
            $str = sprintf( "yday %02d:%02d", $hour, $min );
        }
        else {
            # last week
            $str = sprintf( "%s %02d:%02d", $dname[$wday], $hour, $min );
        }
    }
    else {
        # same day
        $str = strftime( "%H:%M", @then );
    }
    
    return $str;
}

sub reldate {
    my $then_t  = $_[0];

    my $now_t = time();
    my @now = localtime( $now_t );
    my @yday = localtime( $now_t - 86400 );
    my @nday = localtime( $now_t + 86400 );
    my @then = localtime( $then_t );
    my $diff = abs($now_t - $then_t);
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @then;

    if ( $diff > 200*86400 ) {
        # another year
        $str = strftime( "%Y-%m-%d", @then );
    }
    elsif ( $diff > 5*86400 ) {
        # not last week
        $str = sprintf( "%d%s %s", $mday, $ord[ $mday % 20 ], $mname[$mon] );
    }
    elsif ($mday != $now[3]) {
        if ( $mday == $yday[3] ) {
            # yesterday
            $str = "yesterday";
        }
        elsif ( $mday == $nday[3] ) {
            # yesterday
            $str = "tomorrow";
        }
        else {
            # last week
            $str = $dname[$wday];
        }
    }
    else {
        # same day
        $str = "today";
    }
    
    return $str;
}

sub nicedate {
    my $indate = $_[0]; # format YYYY-MM-DD
    my $thisyear = $_[1];

    ($tyear, $tmonth, $tday)=split("-", $indate);

    $nice = sprintf("%d %s", $tday, $mname[$tmonth-1]);

#    if($tyear != $thisyear) {
#        $tyear =~ s/^19//g;
#        $nice="$nice $tyear";
#    }
    return $nice;
}

_______________________________________________
http://cool.haxx.se/mailman/listinfo/curl-www-commits
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.