git.maemo.org Git - pkg-perl/blob - deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Overload/Handle.pm

   1 #############################################################################
   2 ## Name:        build/Wx/Overload/Handle.pm
   3 ## Purpose:     builds overload constants
   4 ## Author:      Mattia Barbon
   5 ## Modified by:
   6 ## Created:     17/08/2001
   7 ## RCS-ID:      $Id: Handle.pm 2057 2007-06-18 23:03:00Z mbarbon $
   8 ## Copyright:   (c) 2001-2003, 2005-2006 Mattia Barbon
   9 ## Licence:     This program is free software; you can redistribute it and/or
  10 ##              modify it under the same terms as Perl itself
  11 #############################################################################
  12
  13 package Wx::Overload::Handle;
  14
  15 use strict;
  16
  17 use Wx::build::Utils qw(read_file write_file);
  18
  19 sub TIEHANDLE {
  20   my( $class, $file ) = @_;
  21
  22   return bless { FILE => $file,
  23                  DATA => '' }, $class;
  24 }
  25
  26 sub PRINT {
  27   my( $this ) = shift;
  28   $this->{DATA} .= join '', @_;
  29 }
  30
  31 sub do_write {
  32   my( $this ) = @_;
  33
  34   print "Writing '", $this->{FILE}, "'.\n";
  35   write_file( $this->{FILE}, $this->{DATA} );
  36 }
  37
  38 sub CLOSE {
  39   my( $this ) = @_;
  40
  41   eval {
  42     my $text = read_file( $this->{FILE} );
  43     if( $text eq $this->{DATA} ) {
  44       print "'", $this->{FILE}, "' not modified, skipping\n";
  45     } else {
  46       $this->do_write
  47     }
  48   };
  49   if( $@ ) {
  50     $this->do_write;
  51   };
  52 }
  53
  54 1;