Formatere dato fra amerikansk til dansk (helt blank på perl)

Prøv med denne variant i stedet:

sub GetDate {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

    return sprintf ('%02d-%02d-%04d %02d:%02d:%02d', $mday, $mon+1, $year+1900, $hour, $min, $sec);
}

Den siger lidt mere om hvad det er som foregår.

et første skud:

installer Date::Format



sub GetDate {
use Date::Format;
  return time2str("%c", time);
  #return time2str("%m/%d/%Y %h:%mi:%s", time);
}

Jeg har nok ikke været detaljeret nok, for ingen af ovennævnte dur. Der skabes både en html fil og en dat fil, hvor cgi læser fra, så I får begyndelsen af
updatestats.pl

#!c:/perl/bin/perl.exe

$| = 1;

require path/teamstats.cfg';

require "$CONFIG{'work_dir'}/teamstatslib.pl";

my $date = &GetDate;
my $html_file = "$CONFIG{'work_dir'}/$date.html";
my $data_file = "$CONFIG{'work_dir'}/$date.dat";

Ved nielle's forslag får jeg: can't save file file 02-10-2005 10:16:00.html invalid argument (ovenstående filer bliver typisk til 51002275.html og 51002275.dat)

Ved mfalck's forslag får jeg Can't locate Date/format.pm in (efterfulgt af stien i perl/lib/, og der findes altså heller ingen format.pm (der findes en autoformat.pm)

Øhm, rødme, rødme:

$CONFIG
i teamstats.cfg lyder:

%CONFIG = (
  'page_url'  => 'url'en',
  'work_dir'  => 'path',
  'countries_file' => 'countries.dat', (data med landekoder med medlemmers landekoder)
  'save_html' => 1,
  'stat_days' => 8, (hvor mange dage stats gemmes
  'team_stat_file' => 'teamstat.dat'
);

Se evt. output på

http://83.89.26.154/cgi-bin/teamstats.cgi

(jeg kan ikke huske, hvordan jeg gør ovenstående klikbart)

Mvh. Kirsten

Det var dig selv som bad om at få datoen i formatet 02-10-2005 10:16:00 - det er korrekt at dette ikke er lovligt som et filnavn. Du bliover derfor nødt til at vælge et andet datoformat. Hvad kan du bruge i stedet?

Dette her burde kunne fungere sammen med dit filsystem:

sub GetDate {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    return sprintf ('%02d-%02d-%04d %02d.%02d.%02d', $mday, $mon+1, $year+1900, $hour, $min, $sec);
}

Jeg skal formentlig tilføje scriptets vars (jeg sagde jo, jeg var HELT blank), så udtrykket bliver til hvad?

sub GetDate {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    return sprintf ('%02d-%02d-%04d %02d.%02d.%02d', $mday, $mon+1, $year+1900, $hour, $min, $sec, $vars[5]-100, $vars[4]+1, $vars[3], $vars[7]+1);
}

eller hur?

Det er nok mig, der er helt galt på, hvor datoen der vises i teamstats.cgi hentes fra i teamstatslib.pl.

Nu dannes der en fil, der hedder '02-10-2005 12.29.57.dat' og (02-10-2005 12.29.57.html), men datoen inden i den genererede fil '02-10-2005 12.19.57.dat' er stadig væk i amerikansk format Sun Oct  2 10:30:08 2005.

Det nytter nok ikke noget at være så blank som jeg og forsøge at hente hjælp (ellers må jeg vise hele teamstatslib.pl, og det bliver vel for omfattende?)

skriv lige svar nielle, så du kan få de 100 point for arbejdet med en på før-begynder stadiet :-D

Mvh. Kirsten

Det må jo så være noget andet kode som udskriver den dato som er inde i DAT-filen. Hvis du finder den frem så kan vi sagtens tilrettet den på samme måde.

... og et svar in dtil videre :^)

...

Hvis du ikke kan finde den, så må du jo bare poste hele filen ... men jeg ville da klart foretrække noget mere specifikt.

Okay. der genereres en .dat fil på basis af opdaterings-filen 'updatestats.pl', som kalder på teamstatslib.pl.

Opdateringsgtidspunkt er det samme, som filens tidsstempel hos på min computer, der naturligvis er i dansk format.

I teamstats.cgi, som jeg har editeret heftigt er der nogle 'kald' (hvis det hedder det?). De to datoer, der vises på html-siden er

$now og $updated - så måske er det her datoerne skal formateres? (for ikke at ulejlige dig med et alenlangt biblioteks-script)

Her står i begyndelsen af teamstats.cgi det sædvanlige for at kunne danne en html-side:

!c:/perl/bin/perl.exe

# Turn buffering off for faster output
$| = 1;

# Load configurations
require 'path/teamstats.cfg';

# Define stats data file
my $statsFile = "$CONFIG{'work_dir'}/$CONFIG{'team_stat_file'}";

# Get HTTP parameters
use CGI qw/:standard/;
my $targetid = param('userid');
my $sortby = lc param('sortby');
if ($sortby eq 'total') {
  $sortby = '';
}

my $now = localtime();

# Print page header

print <<"EOT";
Content-type: text/html
----
efter en masse html-koder fortsættes der

----

EOT

# Open stats data file
unless (open IN, "<$statsFile") {
  print "Failed to read data file!\n";
  goto __END_HTML;
}

# Read first line
my $line = <IN>;
$line =~ s/[\r\n]+$//;

# Read team-based data

my ($updated, $dataLine) = split (/\t/, $line);

print<<"EOT";
----

derefter sætter jeg bare $now og $updated ind passende steder i html-koderne på siden.

Uff, ovenstående er vist en masse sludder, du ikke kan bruge til noget. Hvad med dette her fra biblioteket, som jeg lige har fundet:

  # Get the update time from the html file date
  my $update_time = localtime ((stat $html_file)[9]);

  my $data_file = $html_file;
  $data_file =~ s/\.html$/\.dat/;

  unless (open OUT, ">$data_file") {
    $ERROR = "Can't write to data file '$data_file': $!";
    return;
  }

Jeg kan ikke sige noget om $updated da jeg jo ikke ved hvad der står i din fil. Det kan jo tænkes at det allerede står med engelsk format der.

Mht. $now, så skal du nemlig ikke bare udskrive $now i din fil. Hvis du vil have datoen ud på formatet så skal du skrive dette:

sprintf('%02d-%02d-%04d %02d:%02d:%02d', $now[3], $now[4]+1, $now[5]+1900, $now[2], $now[1], $now[0]);

Hvis du skal gøre det flere steder kan det bedst betale sig at lave det som en funktion som du så kan kalde.

Og her er hele biblioteket, som jeg håber, du ikke behøver læse fra A-Z, der er i hvert fald nogle overskrifter:

# Library for BOINC team stats

#################################################################

sub GetDate {

  my @vars  = localtime();

  return sprintf ('%d%02d%02d%03d', $vars[5]-100, $vars[4]+1, $vars[3], $vars[7]+1);
}

#################################################################

sub LoadCountryCodes {

  open (IN, "<$CONFIG{'work_dir'}/$CONFIG{'countries_file'}") || die "Can't read countries file '$CONFIG{'work_dir'}/$CONFIG{'countries_file'}': $!";

  while (<IN>) {
    s/[\r\n]+//;
    my ($name, $code) = split /\t/;
    $country_code{$name} = $code;
  }

  close IN;

  1;
}

#################################################################

sub RetrieveTeamPage {

  my ($base_url, $html_file) = @_;

  unless ($ua) {
    use LWP::UserAgent;
    $ua = new LWP::UserAgent (agent => 'BoincBot/1.0', timeout => 60);
  }

  my $url = $base_url;
  my $html;
  my $more;

  undef $ERROR;

  while (1) {

    my $ok;
    my $res;

    foreach my $try (1..3) {

      $res = $ua->get($url);
      unless ($res->code == 200) {
        $ERROR = $res->code;
        sleep $try*5;
      }

      if ($res->content eq "Can't find team in database") {
        $ERROR = 'NOTEAM';
        return;
      }

      if ($res->content =~ /<title>Not avilable</) {
        $ERROR = 'NOTAVILABLE';
        return;
      }

      if ($res->content =~ /^can't read/) {
        $ERROR = 'CANTREAD';
        return;
      }

      unless ($res->content =~ /Total credit/) {
        $ERROR = 'WRONGPAGE';
        next;
      }

      if ($res->content =~ /(&sort_by=expavg_credit&offset=\d+)>Next \d+/) {
        $url = $base_url . $1;
        $more = 1;
      } else {
        $more = 0;
      }

      $html .= $res->content;
      $ok = 1;

      last;
    }

    if ($ok) {
      undef $ERROR;
    } else {
      return;
    }

    $more || last;
  }

  if ($html_file) {
    if (open OUT, ">$html_file") {
      print OUT $html;
      close OUT;
      unless (chmod 0666, $html_file) {
        print "Can't chmod html file '$html_file': $!\n";
      }

    } else {
      $ERROR = "Can't save html file '$html_file': $!";
      print $ERROR, "\n";
      return;
    }
  }

  1;
}

#################################################################

sub GenTeamData {

  my $html_file = shift;

  unless (open IN, "<$html_file") {
    $ERROR = "Can't read file '$html_file': $!";
    return;
  }

  my $html;

  { local $/;
    $html = <IN>;
  }

  close IN;

  # Remove returns and line feeds
  $html =~ s/[\r\n]+\s*//g;

  my ($header) = $html =~ m!<table border=1 cellpadding=5 width=100%><tr><td class=heading colspan=2>Team info</td></tr>(.+?)<tr><th>Name</th>!;

  unless ($header) {
    $ERROR = 'Failed to parse page correctly';
    return;
  }

  my ($team_members) = $header =~ m!<tr><td width=40% class=fieldname>Members[^<]*</td><td class=fieldvalue>(.*?)</td></tr><tr><td width=40% class=fieldname>!;
  $team_members =~ s/,//g;

  unless ($team_members) {
    $ERROR = 'Number of member is zero?!!!';
    return;
  }

  my ($team_total_credit) = $header =~ m!<tr><td width=40% class=fieldname>Total credit</td><td class=fieldvalue>(.*?)</td></tr><tr><td width=40% class=fieldname>!;
  $team_total_credit =~ s/,//g;

  my ($team_expavg_credit) = $header =~ m!<tr><td width=40% class=fieldname>Recent average credit</td><td class=fieldvalue>(.*?)</td></tr><tr><td width=40% class=fieldname>!;
  $team_expavg_credit =~ s/,//g;

  my @lines;
  unless (@lines = ParseTeamPage($html)) {
    return;
  }

  undef $html;

  # Sort by total credits

  my (%sort_list, %data_line);
  my $active_members = 0;

  foreach my $line (@lines) {
    my ($userid, $ignored, $ignored, $total_credit, $expavg_credit) = split /\t/, $line;
    if ($expavg_credit > 0) {
      $active_members++;
    }
    $sort_list{sprintf('%09d:%06d', 999999999-$total_credit*10, $userid)} = $userid;
    $data_line{$userid} = $line;
  }

  # Output

  # Get the update time from the html file date
  my $update_time = localtime ((stat $html_file)[9]);

  my $data_file = $html_file;
  $data_file =~ s/\.html$/\.dat/;

  unless (open OUT, ">$data_file") {
    $ERROR = "Can't write to data file '$data_file': $!";
    return;
  }

  print OUT join ("\t", $update_time, join ('|', $active_members, $team_members, $team_total_credit, $team_expavg_credit)), "\n";

  my $rank = 1;
  foreach my $key (sort keys %sort_list) {
    my $userid = $sort_list{$key};
    print OUT join ("\t", $rank, $data_line{$userid}), "\n";
    $rank++;
  }

  close OUT;

  unless (chmod 0666, $data_file) {
    $ERROR = "Can't chmod data file '$data_file': $!";
    return;
  }

  1;
}

#################################################################

sub ParseTeamPage {

  my $html = shift;

  my @lines;

  my @rows = $html =~ m!<tr class=row1><td align=left>(.+?)</td></tr>!g;

  foreach my $row (@rows) {
    $row =~ s!</td>!!g;
    my ($user, $total_credit, $expavg_credit, $country) = @cols = split m!<td[^>]*>!, $row;
    unless (@cols == 4) {
      $ERROR = "Unexpected number of columns in [$row]";
      return;
    }
    my ($userid, $username) = $user =~ m!userid=(\d+)>([^<]+)</a>!;
    my $profile = ($user =~ /view_profile/) ? 1 : 0;
    $total_credit =~ s/,//g;
    $expavg_credit =~ s/,//g;
    my $countryCode = $country_code{$country};
    $countryCode ||= '00';
    push @lines, join ("\t", $userid, $username, $profile, $total_credit, $expavg_credit, $countryCode);
  }

  @lines;
}

#################################################################

sub GenTeamStat {

  my @infiles = @_;

  my (%team, %user, @dates, @userlist, $update, @newusers, $lastUpdated);

  for (my $i=$#infiles; $i>=0; $i--) {

    my $file = $infiles[$i];

    my ($date) = $file =~ /(\d+)\.dat$/;
    push @dates, $date;

    unless (open IN, "<$file") {
      $ERROR = "Can't read file '$file': $!";
      return;
    }

    # Read the first line - team based stats

    my $line = <IN>;
    $line =~ s/[\r\n]+$//;

    my ($updated, $statsLine) = split /\t/, $line;

    if ($i == $#infiles) {
      $lastUpdated = $updated;
    }

    ($team{'boincUsers'}->{$date}, $team{'allUsers'}->{$date}, $team{'total_credit'}->{$date}, $team{'expavg_credit'}->{$date}) = split (/\|/, $statsLine);

    while ($line = <IN>) {

      $line =~ s/[\r\n]+$//;

      my ($tot_rank, $userid, $username, $profile, $total_credit, $expavg_credit, $country) = split /\t/, $line;

      if ($i == $#infiles) {
        $user{$userid}->{'username'} = $username;
        $user{$userid}->{'profile'} = $profile;
        $user{$userid}->{'total_credit'} = $total_credit;
        $user{$userid}->{'expavg_credit'} = $expavg_credit;
        $user{$userid}->{'country'} = $country;

        push @userlist, $userid;

      } elsif (! defined $user{$userid}->{'total_credit'}) {
        next;
      }

      $user{$userid}->{'rank'}->{$date} = $tot_rank;
      $user{$userid}->{'credit'}->{$date} = $total_credit;
    }

    close IN;

    # New users file

    my $newfile = $file;
    $newfile =~ s/\.dat$/\.new/;

    if (-e $newfile) {

      unless (open IN, "<$newfile") {
        $ERROR = "Can't read new user file '$newfile': $!";
        return;
      }

      while ($line = <IN>) {
        $line =~ s/[\r\n]+$//;

        my ($userid, $total_credit) = split /\t/, $line;

        $user{$userid}->{'credit'}->{'00000000'} = $total_credit;
      }

      close IN;
    }
  }

  @dates = reverse @dates;

  # Output to stats file
  my @output;
  my @teamData;
 
  for (my $i=1; $i<@dates; $i++) {
    my $boincUsersChg = sprintf('%5.3f', $team{'boincUsers'}->{$dates[$i]} - $team{'boincUsers'}->{$dates[$i-1]});
    $boincUsersChg =~ s/\.?0+$//;
    $boincUsersChg ||= 0;
    my $allUsersChg = sprintf('%5.3f', $team{'allUsers'}->{$dates[$i]} - $team{'allUsers'}->{$dates[$i-1]});
    $allUsersChg =~ s/\.?0+$//;
    $allUsersChg ||= 0;
    my $totalCreditChg = sprintf('%5.3f', $team{'total_credit'}->{$dates[$i]} - $team{'total_credit'}->{$dates[$i-1]});
    $totalCreditChg =~ s/\.?0+$//;
    $totalCreditChgChg ||= 0;
    my $expavgCreditChg = sprintf('%5.3f', $team{'expavg_credit'}->{$dates[$i]} - $team{'expavg_credit'}->{$dates[$i-1]});
    $expavgCreditChg =~ s/\.?0+$//;
    $expavgCreditChg ||= 0;
    push @teamData, join (':', $dates[$i], $team{'boincUsers'}->{$dates[$i]}, $boincUsersChg, $team{'allUsers'}->{$dates[$i]}, $allUsersChg, $team{'total_credit'}->{$dates[$i]}, $totalCreditChg, $team{'expavg_credit'}->{$dates[$i]}, $expavgCreditChg);
  }
 
  push @output, join("\t", $lastUpdated, join ('|', @teamData)) . "\n";

  my @newusers;

  foreach my $userid (@userlist) {

    my @userdates = sort keys %{$user{$userid}->{'credit'}};

    # New user
    if (@userdates == 1) {

      $userdates[1] = $userdates[0];
      $userdates[0] = '00000000';
      $user{$userid}->{'rank'}->{'00000000'} = $user{$userid}->{'tot_rank'}->{$userdates[1]};

      if (defined $newuser{$userid}) {
        $user{$userid}->{'credit'}->{'00000000'} = $newuser{$userid};
      } else {
        $user{$userid}->{'credit'}->{'00000000'} = $user{$userid}->{'credit'}->{$userdates[1]};
        push @newusers, $userid;
      }
    }

    my $subtotal = 0;
    my $sum = 0;
   
    for (my $i=1; $i<@userdates; $i++) {
      my $chg = sprintf ('%4.2f', $user{$userid}->{'credit'}->{$userdates[$i]} - $user{$userid}->{'credit'}->{$userdates[$i-1]});
      $chg =~ s/\.?0+$//;
      $user{$userid}->{'change'}->{$userdates[$i]} = $chg;
      $subtotal += $chg;
      if ($i < $#userdates) {
        $sum += $chg;
      }
    }
   
    $subtotal = sprintf('%5.3f', $subtotal);
    $subtotal =~ s/\.?0+$//;

    my $rank_chg = 0;
    if ($userdates[$#userdates-1] ne '00000000') {
      $rank_chg = $user{$userid}->{'rank'}->{$userdates[$#userdates]} - $user{$userid}->{'rank'}->{$userdates[$#userdates-1]};
    }

    my @changes;
    for (my $i=1; $i<@dates; $i++) {
      if (defined $user{$userid}->{'change'}->{$dates[$i]}) {
        push @changes, $user{$userid}->{'change'}->{$dates[$i]};
      } else {
        push @changes, '-';
      }
    }

    $user{$userid}->{'history'} = join '|', @changes;

    my $user_avg;

    if (@userdates > 2) {
      my ($y0, $yday0) = $userdates[0] =~ /^(.)....(...)$/;
      my ($y1, $yday1) = $userdates[1] =~ /^(.)....(...)$/;
      my ($y2, $yday2) = $userdates[$#userdates] =~ /^(.)....(...)$/;

      my $leap_year_offset = ($y0 % 4) ? 1 : 0;
      my $days1 = ($y2-$y0)*(365 + $leap_year_offset) + $yday2 - $yday0;
      $days1 ||= 1;

      my $days2 = ($y2-$y1)*(365 + $leap_year_offset) + $yday2 - $yday1;
      $days2 ||= 1;

      my $avg1 = $subtotal / $days1;
      my $avg2 = $sum / $days2;

      if ($avg1 > $avg2) {
        $user_avg = $avg1;
      } else {
        $user_avg = $avg2;
      }
    } else {
      $user_avg = $user{$userid}->{'change'}->{$userdates[$#userdates]};
    }

    $user_avg = sprintf('%5.3f', $user_avg);
    $user_avg =~ s/\.?0+$//;

    push @output, join ("\t",
                        $user{$userid}->{'rank'}->{$dates[$#dates]},
                        $rank_chg,
                        $userid,
                        $user{$userid}->{'username'},
                        $user{$userid}->{'profile'},
                        $user{$userid}->{'history'},
                        $subtotal,
                        $user{$userid}->{'total_credit'},
                        $user{$userid}->{'expavg_credit'},
                        $user_avg,
                        $user{$userid}->{'country'}) . "\n";
    $rank++;
  }

  unless (open OUT, ">$CONFIG{'work_dir'}/$CONFIG{'team_stat_file'}") {
    $ERROR = "Can't write to stat file '$CONFIG{'work_dir'}/$CONFIG{'team_stat_file'}': $!";
    return;
  }
  print OUT @output;
  close OUT;

  # If any new user

  if (@newusers) {

    my $new_file = $infiles[$#infiles];
    $new_file =~ s/\.dat$/\.new/;

    unless (open OUT, ">$new_file") {
      $ERROR = "Can't write to file '$new_file': $!";
      return;
    }

    foreach my $userid (@newusers) {
      print OUT join ("\t",
                      $userid,
                      $user{$userid}->{'total_credit'},
                      $user{$userid}->{'expavg_credit'}), "\n";
    }

    close OUT;

    unless (chmod 0666, $new_file) {
      $ERROR = "Can't chmod new user file '$new_file': $!";
      return;
    }
  }

  1;
}

1;

Hvilken funktion kalder du når du vil udskrive en dato i din tekst?

$ now  - udskriver datoen nu
$ updated - udskriver seneste opdatering

Det er de to datoer, jeg gerne vil ændre fra

  Sun Oct 2 14:33:08 2005
  Senest opdateret Sun Oct 2 14:00:10 2005

til dansk standard af en slags.

uden mellemrum

$now
$updated

Hver gang du udskriver $now skal du i stedet udskrive:

sprintf('%02d-%02d-%04d %02d:%02d:%02d', $now[3], $now[4]+1, $now[5]+1900, $now[2], $now[1], $now[0]);

- og hver gang du udskriver $updated skal du gøre det samme, selvfølgeligt med $updatet i stedet for $now.

Nøh, desværre ikke (se resultat på http://83.89.26.154/cgi-bin/cpdn/teamstats.cgi )

$now eller $updated står jo midt inde i noget html-kode. Jeg har blot lagt alm. koder ind mellem EOT.

Jeg kan sige, at på et tidspunkt duede $update ikke, og da flyttede jeg (ret bevidstløst, men det lykkedes altså..) rundt på noget kode i teamstats.cgi, så det endte med at se ud som nedenfor, og SÅ virkede $updated (hvis det er til nogen hjælp

EOT

# Open stats data file
unless (open IN, "<$statsFile") {
  print "Failed to read data file!\n";
  goto __END_HTML;
}

# Read first line
my $line = <IN>;
$line =~ s/[\r\n]+$//;

# Read team-based data

my ($updated, $dataLine) = split (/\t/, $line);

print<<"EOT";

Jeg giver dig lige pointene for dit store - og tålmodige - arbejde. Jeg ved selv, hvordan det er at forklare new-newbies noget.

Du får udskrevet dette på din side:

sprintf('%02d-%02d-%04d %02d:%02d:%02d', , +1, +1900, , , );

Hvordan ser den linje ud som går dette?

Normalt ser linjen sådan ud (en celle midt i en tabel)

    <td>
      <p>&nbsp;&nbsp;&nbsp;$now <br>
        &nbsp;&nbsp;&nbsp;Senest opdateret $updated</p>
    </td>

Og når jeg skifter now ud med dit forslag, ser den sådan ud

  <td>
    <p>&nbsp;&nbsp;&nbsp;sprintf('%02d-%02d-%04d %02d:%02d:%02d', $now[3], $now[4]+1, $now[5]+1900, $now[2], $now[1], $now[0]);
<br>
        &nbsp;&nbsp;&nbsp;Senest opdateret $updated</p>
  </td>

Når du inkludere den på denne måde:

<p>&nbsp;&nbsp;&nbsp;sprintf('%02d-%02d-%04d %02d:%02d:%02d', $now[3], $now[4]+1, $now[5]+1900, $now[2], $now[1], $now[0]);
<br>

- altså midt i HTML-koden, så er det heller ikke perl som udskriver den. Du skal afslutte din HTML-streng og gå tilbage til perl først.

Well, jeg kan da skrive $now midt i en HTML-streng, men jeg kan da prøve dit forslag.

Hvorfor kan jeg ikke definere

$my now = en_eller_anden_kode

Nu hedder den bare

$my now = localtime()

Det kan du da også sagtens:

my $now = localtime()
my $nowDkStr = sprintf('%02d-%02d-%04d %02d:%02d:%02d', $now[3], $now[4]+1, $now[5]+1900, $now[2], $now[1], $now[0]);

- og så er det bare $nowDkStr du udkriver i stedet for $now :^)