Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Bower components Debian packages RPM packages NuGet packages

beebox / crossover   deb

Repository URL to install this package:

Version: 18.5.0-1 

/ opt / cxoffice / lib / perl / CXCDE.pm

# (c) Copyright 2006-2008, 2010. CodeWeavers, Inc.
package CXCDE;
use warnings;
use strict;

use CXUtils;
use CXLog;

sub new($)
{
    my ($class, $filename)=@_;

    my $self={ filename    => $filename,
               actions     => {},
               attributes  => {},
               criteria    => {},
               created_by  => {}
             };
    bless $self, $class;

    return $self if (!-e $filename);

    cxlog("Reading '$self->{filename}'\n");
    my $fh;
    if (!open($fh, "<", $self->{filename}))
    {
        cxerr("unable to open '$self->{filename}' for reading: $!\n");
        return 0;
    }

    my $count=0;
    my ($line, $blob, $ignore);
    foreach my $l (<$fh>)
    {
        $count++;
        chomp $l;
        if (defined $line)
        {
            $l =~ s/^\s*//;
            $line.=$l;
        }
        else
        {
            $l =~ s/^\s*//;
            if ($l =~ /^\s*#\s*X-Created-By-([^= ]*)\s*=\s*(\S*)/)
            {
                my ($key, $list)=($1, $2);
                map { $self->{created_by}->{$key}->{$_}=1 } split /;+/, $list;
                next;
            }
            next if ($l =~ /^#/);
            next if ($l eq "");
            $line=$l;
        }
        # Apparently Solaris allows spaces after the EOL continuation backslash
        next if ($line =~ s/\\\s*$//);
        #cxlog("line=[$line]\n");

        if ($blob)
        {
            if ($line =~ /^{/)
            {
                # Nothing to do
            }
            elsif ($line =~ /^}/)
            {
                $blob=undef;
            }
            elsif ($line =~ /^([A-Z0-9_]+)\s+(.*)$/)
            {
                $blob->{$1}=$2;
                #cxlog(" key [$1]=[$2]\n");
            }
            else
            {
                cxwarn("$count: unknown type of action line '$line'\n");
            }
        }
        elsif ($ignore)
        {
            if ($line =~ /^}/)
            {
                $ignore=undef;
            }
        }
        elsif ($line =~ /^ACTION\s+(\S+)\s*$/)
        {
            $blob={};
            $self->{actions}->{$1}=$blob;
            #cxlog("action [$1]\n");
        }
        elsif ($line =~ /^DATA_ATTRIBUTES\s+(\S+)\s*$/)
        {
            $blob={};
            $self->{attributes}->{$1}=$blob;
            #cxlog("attributes [$1]\n");
        }
        elsif ($line =~ /^DATA_CRITERIA\s+(\S+)\s*$/)
        {
            $blob={};
            $self->{criteria}->{$1}=$blob;
            #cxlog("criteria [$1]\n");
        }
        elsif ($line =~ /^\{/)
        {
            $ignore=1 if (!$blob);
        }
        elsif ($line =~ /^set\s/)
        {
            # We silently ignore those
        }
        else
        {
            cxwarn("$count: unknown type of line '$line'\n");
        }
        $line=undef;
    }
    close($fh);
    # For debug...
    # map { cxlog("  $_\n"); } keys %{$self->{actions}};

    return $self;
}

sub save($)
{
    my ($self)=@_;
    my %cname=(actions    => "ACTION",
               attributes => "DATA_ATTRIBUTES",
               criteria   => "DATA_CRITERIA"
              );

    my $dir=cxdirname($self->{filename});
    if (!cxmkpath($dir))
    {
        cxerr("unable to create the '$dir' directory: $@\n");
        return 0;
    }
    my $fh;
    if (!open($fh, ">", $self->{filename}))
    {
        cxerr("unable to open '$self->{filename}' for writing: $!\n");
        return 0;
    }

    cxlog("CXMenuCDE writing to '$self->{filename}'\n");
    foreach my $category ("attributes", "criteria", "actions")
    {
        foreach my $name (sort keys %{$self->{$category}})
        {
            print $fh "$cname{$category} $name\n";
            print $fh "{\n";
            my $data=$self->{$category}->{$name};
            foreach my $key (sort keys %$data)
            {
                print $fh "    $key ", (' ' x (16-length($key))), "$data->{$key}\n";
            }
            print $fh "}\n";
            print $fh "\n";
        }
    }

    foreach my $key (sort keys %{$self->{created_by}})
    {
        my @list=keys %{$self->{created_by}->{$key}};
        print $fh "# X-Created-By-$key=", join(";", sort @list), "\n";
    }

    close($fh);
    return 1;
}

sub is_empty($)
{
    my ($self)=@_;
    return 0 if (%{$self->{actions}});
    return 0 if (%{$self->{attributes}});
    return 0 if (%{$self->{criteria}});
    return 1;
}

sub dump($)
{
    my ($self)=@_;

    cxlog("filename=$self->{filename}\n");
    foreach my $category ("criteria", "attributes", "actions")
    {
        cxlog("$category\n");
        foreach my $name (sort keys %{$self->{$category}})
        {
            cxlog("  $category $name\n");
            my $data=$self->{$category}->{$name};
            foreach my $key (sort keys %$data)
            {
                cxlog("    $key=$data->{$key}\n");
            }
        }
    }
}

return 1;