view release on metacpan or  search on metacpan

script/xulapp  view on Meta::CPAN

    my ($entity, $old);
    my $s;
    while (<$in>) {
        $_ = decode('UTF-8', $_);
        if (/^\s*msgid "(.+)"\s*$/) {
            $old = $1;
            $entity = str2ent($old);
        } elsif (/^\s*msgstr (".*")\s*$/) {
            next if !defined $old or $old eq '';
            my $value  = $1;
            if ($value eq '""') { $value = qq{"$old"}; }
            #$value =~ s/</\&\#60;/g;
            #$value =~ s/>/\&\#62;/g;
            #$value =~ s/\&/\&#38;/g;
            $s .= "<!ENTITY $entity $value>\n";
        }
    }
    #die $s;
    close $in;
    #warn "Write $locale_dir/$app_name.dtd\n";
    $s = encode("UTF-8", $s);
    write_file($outfile, {binmode => ':raw'}, $s);
}

sub gen_meta_po {
    my $pofile = $pofiles[0];
    return unless $pofile and -f $pofile;
    open my $in, $pofile or die "Can't open $pofile for reading: $!";
    my ($s, $key, $entity);
    while (<$in>) {
        if (/^\s*msgid "(.+)"\s*$/) {
            $key = $1;
            $entity = str2ent($key);
        } elsif (/^\s*msgstr (".*")\s*$/) {
            next if !defined $key or $key eq '';
            $s .= qq{msgstr "\&$entity;"\n};
            next;
        }
        $s .= $_;
    }
    #die $s;
    my $outfile = 'po/meta.po';
    warn "Write $outfile\n";
    write_file($outfile, {binmode => ':raw'}, $s);
}

sub add_doctype {
    my $xulfile = shift;
    my $content = read_file($xulfile, binmode => ':raw');
    $content = decode("UTF-8", $content);
    my $old_content = $content;
    $content =~ s{<(window|dialog|page|overlay)}{<!DOCTYPE $1 SYSTEM "chrome://$app_name/locale/$app_name.dtd">\n\n$&};
    $content =~ s/\&#38;(QQQ_[A-Za-z0-9_]*;)/\&$1/g;
    if ($content ne $old_content) {
        warn "Write $xulfile with DOCTYPE\n";
        $content = encode("UTF-8", $content);
        write_file($xulfile, {binmode => ':raw'}, $content);
    }
}

sub set_prefs {
    my $prefs = shift;
    my $old_content = read_file($prefs, binmode => ':raw');
    my $content = $old_content;
    set_pref_var(\$content, 'nglayout.debug.disable_xul_cache', 'true');
    set_pref_var(\$content, 'javascript.options.showInConsole', 'true');
    set_pref_var(\$content, 'javascript.options.strict', 'true');
    set_pref_var(\$content, 'browser.dom.window.dump.enabled', 'true');
    set_pref_var(\$content, 'browser.sessionstore.resume_from_crash', 'false');
    if ($content ne $old_content) {
        warn "Write $prefs\n";
        shell("cp $prefs $prefs.bak");
        write_file($prefs, {binmode => ':raw'}, $content);
    }
}

sub set_pref_var {
    my ($rcontent, $var, $value) = @_;
    warn "Checking if Firefox config var $var is $value\n";
    if ($$rcontent !~ s/\buser_pref\("\Q$var\E",\s*[^)]+\);/user_pref("$var", $value);/gm) {
        chomp($$rcontent);
        $$rcontent .= qq{\nuser_pref("$var", $value);\n};
    }
}

sub register_ext {
    my ($meta_dir, $chrome_dir) = @_;
    #my $meta_path = "$meta_dir/$opts->{id}";
    #warn "creating $meta_path\n";
    #mkdir $meta_path;
    my $manifest = File::Spec->rel2abs($chrome_dir);
    my $metafile = "$meta_dir/extensions.ini";
    my $count = 0;
    while (!-f $metafile) {
        if (++$count > 3) {
            die "Can't find $metafile";
        }
        warn "$metafile not found. starting Firefox. please close it after it starts\n";
        my $close_me = File::ShareDir::module_file('XUL::App', 'html/close-me.html');
        #die $close_me;
        if (-f $close_me) {
            shell("MOZ_NO_REMOTE=1 firefox -P $profile file://$close_me");
        }
    }
    my $prefs = "$meta_dir/prefs.js";
    $count = 0;
    while (!-f $prefs) {
        if (++$count > 3) {
            die "Can't find $prefs";
        }
        warn "$prefs not found. starting Firefox. please close it after it starts\n";
        shell("MOZ_NO_REMOTE=1 firefox -P $profile");
    }
    set_prefs($prefs);
    $metafile = Cwd::realpath($metafile);
    open my $in, $metafile or
        die "Can't open $metafile for reading: $!";
    my $state = 'init';
    my ($buf, $c);
    $c = -1;
    my $write_back = 1;
    while (<$in>) {
        s/\r\n/\n/g;
        if ($state eq 'init' and /^\s*\[ExtensionDirs\]\s*$/i) {
            $state = 'begin';
        } elsif ($state eq 'begin') {
            if (/^\s*\[\w+\]\s*$/) {
                $c++;
                $buf .= "Extension$c="
                    . $manifest
                    . "\r\n";
                $state = 'end';
            } elsif (/^\s*Extension(\d+)\s*=\s*([^\r\n]*)\r?$/i) {
                if ($2 eq $manifest) {
                    warn "Great! $manifest already registered.\n";
                    $write_back = 0;
                    last;
                } else {
                    ### $2
                    ### $manifest
                }
                $c = $1;
            }
        }
    } continue {
        s/\n/\r\n/g;
        $buf .= $_;
    }
    #print $buf;
    #$buf .= "AAA\n";
    close $in;
    if ($write_back) {
        shell("cp $metafile $metafile.bak");
        warn "Write $metafile\n";
        #my $orig = read_file($metafile);
        #warn "Diff: ", diff \$orig, \$buf;
        write_file($metafile, {binmode => ':raw'}, $buf);
    }
    #shell($cmd);
}

# XXX untested...
sub unregister_ext {
    my ($meta_dir, $chrome_dir) = @_;
    #my $meta_path = "$meta_dir/$opts->{id}";
    #warn "creating $meta_path\n";
    #mkdir $meta_path;
    my $manifest = File::Spec->rel2abs($chrome_dir);
    my $metafile = File::Spec->canonpath("$meta_dir/extensions.ini");
    open my $in, $metafile or
        die "Can't open $metafile for reading: $!";
    my $state = 'init';
    my ($buf, $c);
    $c = 0;