view release on metacpan or  search on metacpan

eg/screen  view on Meta::CPAN

    print "</LISTING>\n";
  }
  print $query->goto_screen($query->last_screen);
}

sub media_screen {
  my $query = shift;

  print
    $query->p('You choose:',
              $query->img({src => $query->url_to_screen('gif')})),
    $query->link_to_screen('gif', 'GIF only');

  print $query->p("All font sizes:\n");
  for my $font (qw(Large MediumBold Small)) {
    print
      $query->TR
        ($query->td
         ($query->img ({src => $query->url_to_screen('gif', 'Foo',
                                                     'font' => $font)})));
  }
 }

sub gif_data {
  my $query = shift;
  
  print $query->header(
                       -type    => 'image/gif',
                       -status  => '200 OK',
                       -expires => '+120s',
                      );
  eval { require GD };
  if ($@ ne '') {               # no GD
    my $sorry = <<'EOF'
begin 644 GD.gif
M1TE&.#EAX  0 *$  /____\          "'Y! $     +     #@ !    +^
MA(^IR^T/EQ"QVHLSF+I#;H#>2(JD,YDI%7'4RK9J?(:F16_UGN],_P "%2Q0
M;)@X\B0WW 'INT"C.JGD@R@^6]1JLEE1=CW3:#EY#:9#6*H0S&4_172HJWC,
MOS:P8&K.1_/WTC?7)*2VYD4$@U='F.42^&>($; EN"6W222GI9FGZ03H2;K(
MF8.(\I/5UAE9:B,:>780<,LF!MK*6O49NUD[F[FHVSN+_#I9[(K&Z_L\) R 
MB\O,2YSV22R-D0VM:'BCVI"*VOS,J9Z\_G![>8Z=[KP=3=F^.BP^?\T^9=ZO
MW+%V*_CA<P OWBYVL7Z="N8M'3F R,@-!'>0(<5K8]U&?,/X<*'#/=$8.CM'
M4<G&D&6XF31X:J6N:>AFFGI53Y8*46>^0>*)"9;!EG@@HJOXI61&*04KT<)W
MAX^-HDV=_FC4M&#5J?NP>KUW54<A%%F_9EWV%.:8M6S;NGTK@R;<N73KVLW'
$H   .TV=
 
end
EOF
  ;
    for (split /\n/, $sorry) {
      print unpack 'u', $_;
    }
  } else {
    my $font  = $query->param('font');
    my $w     = GD::Font->$font()->width;
    my $h     = GD::Font->$font()->height;
    my $im    = GD::Image->new((length($query->param('foo'))+2)*$w,$h);
    my $white = $im->colorAllocate(255,255,255);
    my $red   = $im->colorAllocate(255,0,0);
    my $black = $im->colorAllocate(0,0,0);
    $im->transparent($white);
    $im->arc(8,8,5,5,0,360,$red);
    $im->string(GD::Font->$font(),10,0,$query->param('foo'),$black);
    print $im->gif;
  }
}

sub manual_screen {
  my $query = shift;
  
  require Pod::Text;
  require IO::File;

  my $fh = new IO::File "> /tmp/screen.$$" or die; # hate Pod::Text 

  if ($Pod::Text::VERSION >= 2) { # Thanks Brad ;-(
    $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin'; # Thanks again
    Pod::Text::pod2text($INC{"CGI/Screen.pm"}, $fh);
  } else {
    Pod::Text::pod2text('-72', $INC{"CGI/Screen.pm"}, $fh);
  }
  
  
  $fh = new IO::File "< /tmp/screen.$$" or die;
  print "<LISTING>\n";
  local ($/, $_) = "\n";
  while (defined($_ = <$fh>)) {
    s/</&lt;/g; s/>/&gt;/g; 
    s{\`(.*?)\'}{'<B>$1</B>'}g;
    s{\'(\w)\'}{<B>$1</B>}g;
    s{\*(.*?)\*}{<I>$1</I>}g;
    print;
  }
  print "\n</LISTING>";
  unlink "/tmp/screen.$$";
}