/[suikacvs]/messaging/manakai/lib/Message/Field/UA.pm
Suika

Diff of /messaging/manakai/lib/Message/Field/UA.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by wakaba, Sat Apr 13 01:33:54 2002 UTC revision 1.6 by wakaba, Sun Jun 16 10:42:06 2002 UTC
# Line 51  sub _init ($;%) { Line 51  sub _init ($;%) {
51      #hook_encode_string ## Inherited      #hook_encode_string ## Inherited
52      #hook_decode_string ## Inherited      #hook_decode_string ## Inherited
53      -prepend    => 1,      -prepend    => 1,
54        -use_Config => 1,
55        -use_Win32  => 1,
56    );    );
57    $self->SUPER::_init (%DEFAULT, %options);    $self->SUPER::_init (%DEFAULT, %options);
58    my @a = ();    my @a = ();
# Line 362  sub clone ($) { Line 364  sub clone ($) {
364    $clone;    $clone;
365  }  }
366    
367    sub add_our_name ($;%) {
368      require Message::Entity;
369      my $ua = shift;
370      my %o = @_;  my %option = %{$ua->{option}};
371      for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
372        $ua->replace ('Message-pm' => $Message::Entity::VERSION, -prepend => 0);
373        my (@os, @os_comment);
374        my @perl_comment;
375        if ($option{use_Config}) {
376          @os_comment = ('');
377          @os = ($^O => \@os_comment);
378          eval q{use Config;
379            @os_comment = ($Config{osvers});
380            push @perl_comment, $Config{archname};
381          };
382          eval q{use Win32;
383            my $build = Win32::BuildNumber;
384            push @perl_comment, "ActivePerl build $build" if $build;
385            my @osv = Win32::GetOSVersion;
386            @os = (
387                $osv[4] == 0? 'Win32s':
388                $osv[4] == 1? 'Windows':
389                $osv[4] == 2? 'WindowsNT':
390                              'Win32',       \@os_comment);
391            @os_comment = (sprintf ('%d.%02d.%d', @osv[1,2], $osv[3] & 0xFFFF));
392            push @os_comment, $osv[0] if $osv[0] =~ /[^\x09\x20]/;
393            if ($osv[4] == 1) {
394              if ($osv[1] == 4) {
395                if ($osv[2] == 0) {
396                  if    ($osv[0] =~ /[Aa]/) { push @os_comment, 'Windows 95 OSR1' }
397                  elsif ($osv[0] =~ /[Bb]/) { push @os_comment, 'Windows 95 OSR2' }
398                  elsif ($osv[0] =~ /[Cc]/) { push @os_comment, 'Windows 95 OSR2.5' }
399                  else                      { push @os_comment, 'Windows 95' }
400                } elsif ($osv[2] == 10) {
401                  if    ($osv[0] =~ /[Aa]/) { push @os_comment, 'Windows 98 SE' }
402                  else                      { push @os_comment, 'Windows 98' }
403                } elsif ($osv[2] == 90) {
404                  push @os_comment, 'Windows Me';
405                }
406              }
407            } elsif ($osv[4] == 2) {
408              push @os_comment, 'Windows 2000' if $osv[1] == 5 && $osv[2] == 0;
409              push @os_comment, 'Windows XP' if $osv[1] == 5 && $osv[2] == 1;
410            }
411            push @os_comment, Win32::GetChipName;
412          } if $option{use_Win32};
413        } else {
414          push @perl_comment, $^O;
415        }
416        if ($^V) {  ## 5.6 or later
417          $ua->replace (Perl => [sprintf ('%vd', $^V), @perl_comment], -prepend => 0);
418        } elsif ($]) {      ## Before 5.005
419          $ua->replace (Perl => [ $], @perl_comment], -prepend => 0);
420        }
421        $ua->replace (@os, -prepend => 0) if $option{use_Config};
422      $ua;
423    }
424    
425  =back  =back
426    
427  =head1 LICENSE  =head1 LICENSE
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24