package App::Asciio ;
$|++ ;
use strict;
use warnings;
use Data::Dumper ;
use Data::TreeDumper ;
use File::Slurp ;
use Readonly ;
#~ use Compress::LZF ':compress';
use Compress::Bzip2 qw(:all :utilities :gzip);
#-----------------------------------------------------------------------------
sub load_file
{
my ($self, $file_name) = @_;
return unless defined $file_name ;
my ($base_name, $path, $extension) = File::Basename::fileparse($file_name, ('\..*')) ;
$extension =~ s/^\.// ;
my $type = $extension ne q{}
? $extension
: 'internal_asciio_format';
my $title ;
if
(
exists $self->{IMPORT_EXPORT_HANDLERS}{$type}{IMPORT}
&& defined $self->{IMPORT_EXPORT_HANDLERS}{$type}{IMPORT}
)
{
my ($saved_self, $handler_data) ;
($saved_self, $title, $handler_data) =
$self->{IMPORT_EXPORT_HANDLERS}{$type}{IMPORT}->
(
$self,
$file_name,
) ;
$self->load_self($saved_self) ; # resurect from momified
$self->{IMPORT_EXPORT_HANDLERS}{HANDLER_DATA} = $handler_data ;
}
else
{
my $serialized_self = decompress(read_file($file_name)) ;
my $VAR1 ;
my $saved_self = eval $serialized_self or die "load_file: can't load file '$file_name': $! $@\n" ;
$self->load_self($saved_self) ; # resurect
delete $self->{IMPORT_EXPORT_HANDLERS}{HANDLER_DATA} ;
$title = $file_name ;
}
return $title ;
}
#-----------------------------------------------------------------------------
# gtk elements memory is handled by Gtk2 module
Readonly my @GTK_ELEMENTS =>
qw
(
widget PIXMAP
ALLOCATED_COLORS
ACTIONS CURRENT_ACTIONS ACTIONS_BY_NAME
HOOKS IMPORT_EXPORT_HANDLERS
TITLE
) ;
sub load_self
{
my ($self, $new_self) = @_;
return unless defined $new_self ;
delete @{$new_self}{@GTK_ELEMENTS} ;
my @keys = keys %{$new_self} ;
@{$self}{@keys} = @{$new_self}{@keys} ;
}
#-----------------------------------------------------------------------------
sub load_elements
{
my ($self, $file_name, $path) = @_;
return unless defined $file_name ;
my $elements = do $file_name or die "can't load file '$file_name': $! $@\n" ;
$path = '' unless defined $path ;
for my $new_element (@{$elements})
{
my $new_element_type = ref $new_element or die "element without type in file '$file_name'!" ;
unless(exists $self->{LOADED_TYPES}{$new_element_type})
{
eval "use $new_element_type" ;
die "Error loading type '$new_element_type' :$@" if $@ ;
$self->{LOADED_TYPES}{$new_element_type}++ ;
}
my $next_element_type_index = @{$self->{ELEMENT_TYPES}} ;
$new_element->{NAME} = "$path/$new_element->{NAME}" ;
$new_element->{NAME} =~ s~/+~/~g ;
$new_element->{NAME} =~ s~^/~~g ;
#~ print $new_element->{NAME} . "\n" ;
if(exists $new_element->{NAME})
{
if(exists $self->{ELEMENT_TYPES_BY_NAME}{$new_element->{NAME}})
{
print "Overriding element type '$new_element->{NAME}'!\n" ;
$self->{ELEMENT_TYPES}[$self->{ELEMENT_TYPES_BY_NAME}{$new_element->{NAME}}]
= $new_element ;
}
else
{
$self->{ELEMENT_TYPES_BY_NAME}{$new_element->{NAME}} = $next_element_type_index ;
push @{$self->{ELEMENT_TYPES}}, $new_element ;
$next_element_type_index++ ;
}
}
if(exists $new_element->{X})
{
push @{$self->{ELEMENTS}}, $new_element ;
}
}
}
#-----------------------------------------------------------------------------
sub save_stencil
{
my ($self) = @_ ;
my $name = $self->display_edit_dialog('stencil name') ;
if(defined $name && $name ne q[])
{
my $file_name = $self->get_file_name('save') ;
if(defined $file_name && $file_name ne q[])
{
if(-e $file_name)
{
my $override = $self->display_yes_no_cancel_dialog
(
"Override file!",
"File '$file_name' exists!\nOverride file?"
) ;
$file_name = undef unless $override eq 'yes' ;
}
}
if(defined $file_name && $file_name ne q[])
{
use Data::Dumper ;
my ($element) = $self->get_selected_elements(1) ;
my $stencil = Clone::clone($element) ;
delete $stencil->{X} ;
delete $stencil->{Y} ;
$stencil->{NAME} = $name;
write_file($file_name, Dumper [$stencil]) ;
}
}
}
#-----------------------------------------------------------------------------
sub serialize_self
{
my ($self, $indent) = @_ ;
local $self->{widget} = undef ;
local $self->{PIXMAP} = undef ;
local $self->{ALLOCATED_COLORS} = undef ;
local $self->{ACTIONS} = [] ;
local $self->{HOOKS} = [] ;
local $self->{CURRENT_ACTIONS} = [] ;
local $self->{ACTIONS_BY_NAME} = [] ;
local $self->{DO_STACK} = undef ;
local $self->{IMPORT_EXPORT_HANDLERS} = undef ;
local $self->{MODIFIED} => 0 ;
local $self->{TITLE} = '' ;
local $self->{CREATE_BACKUP} = undef ;
local $Data::Dumper::Purity = 1 ;
local $Data::Dumper::Indent = $indent || 0 ;
local $Data::Dumper::Sortkeys = 1 ;
Dumper($self) ;
}
#-----------------------------------------------------------------------------
sub save_with_type
{
my ($self, $elements_to_save, $type, $file_name) = @_ ;
my $title ;
if
(
exists $self->{IMPORT_EXPORT_HANDLERS}{$type}{EXPORT}
&& defined $self->{IMPORT_EXPORT_HANDLERS}{$type}{EXPORT}
)
{
$title = $self->{IMPORT_EXPORT_HANDLERS}{$type}{EXPORT}->
(
$self,
$elements_to_save,
$file_name,
$self->{IMPORT_EXPORT_HANDLERS}{HANDLER_DATA},
) ;
}
else
{
if($self->{CREATE_BACKUP} && -e $file_name)
{
use File::Copy;
copy($file_name,"$file_name.bak") or die "save_with_type: Copy failed while making backup copy: $!";
}
write_file($file_name,compress($self->serialize_self() .'$VAR1 ;')) ;
$title = $file_name ;
}
return $title ;
}
#-----------------------------------------------------------------------------
1 ;