view release on metacpan or  search on metacpan

lib/Win32/Mock/Win32.pm  view on Meta::CPAN

sub GetANSIPathName {
    return $_[0]
}


# 
# GetArchName()
# -----------
sub GetArchName {
    return $Config{archname}
}


# 
# GetChipName()
# -----------
sub GetChipName {
    require POSIX;
    return "" . (POSIX::uname())[4]
}


# 
# GetCwd()
# ------
sub GetCwd {
    require Cwd;
    return Cwd::cwd()
}


# 
# GetCurrentThreadId()
# ------------------
sub GetCurrentThreadId {
    return -$$
}


# 
# GetFileVersion()
# --------------
sub GetFileVersion {
    if ($_[0] eq $^X) {
        my @version = map {int} $] =~ /^([0-9]+)\.([0-9]{3})([0-9]+)$/;
        push @version, Win32::BuildNumber();
        return wantarray ? @version : join ".", @version
    }
    return wantarray ? (0,0,0,0) : "0.0.0.0"
}


# 
# GetFolderPath()
# -------------
sub GetFolderPath {
    my ($folder, $create) = @_;
    eval "use File::HomeDir";

    my $path = '';
    my $home = eval { File::HomeDir->my_home } || (getpwuid($>))[7];

    # TODO CSIDL_DESKTOP
    # TODO CSIDL_PROGRAMS

    $folder == &CSIDL_PERSONAL
        and $path = eval { File::HomeDir->my_documents } || catdir($home, "Documents");

    # TODO CSIDL_FAVORITES
    # TODO CSIDL_STARTUP
    # TODO CSIDL_RECENT
    # TODO CSIDL_SENDTO
    # TODO CSIDL_STARTMENU

    $folder == &CSIDL_MYMUSIC
        and $path = eval { File::HomeDir->my_music } || catdir($home, "Music");

    $folder == &CSIDL_MYVIDEO
        and $path = eval { File::HomeDir->my_videos } || catdir($home, "Movies");

    $folder == &CSIDL_DESKTOPDIRECTORY
        and $path = eval { File::HomeDir->my_desktop } || catdir($home, "Desktop");

    # TODO CSIDL_NETHOOD
    # TODO CSIDL_FONTS
    # TODO CSIDL_TEMPLATES
    # TODO CSIDL_COMMON_STARTMENU
    # TODO CSIDL_COMMON_PROGRAMS
    # TODO CSIDL_COMMON_STARTUP
    # TODO CSIDL_COMMON_DESKTOPDIRECTORY
    # TODO CSIDL_APPDATA
    # TODO CSIDL_PRINTHOOD
    # TODO CSIDL_LOCAL_APPDATA
    # TODO CSIDL_COMMON_FAVORITES
    # TODO CSIDL_INTERNET_CACHE
    # TODO CSIDL_COOKIES
    # TODO CSIDL_HISTORY
    # TODO CSIDL_COMMON_APPDATA

    $folder == &CSIDL_WINDOWS and $path = $ENV{WINDIR};
    $folder == &CSIDL_SYSTEM  and $path = $ENV{SYSTEMROOT};

    # TODO CSIDL_PROGRAM_FILES

    $folder == &CSIDL_MYPICTURES
        and $path = eval { File::HomeDir->my_pictures } || catdir($home, "Pictures");

    $folder == &CSIDL_PROFILE and $path = $home;

    # TODO CSIDL_PROGRAM_FILES_COMMON
    # TODO CSIDL_COMMON_TEMPLATES
    # TODO CSIDL_COMMON_DOCUMENTS
    # TODO CSIDL_COMMON_ADMINTOOLS
    # TODO CSIDL_ADMINTOOLS
    # TODO CSIDL_COMMON_MUSIC
    # TODO CSIDL_COMMON_PICTURES
    # TODO CSIDL_COMMON_VIDEO
    # TODO CSIDL_RESOURCES
    # TODO CSIDL_RESOURCES_LOCALIZED
    # TODO CSIDL_CDBURN_AREA

lib/Win32/Mock/Win32.pm  view on Meta::CPAN

    if (eval "use Data::GUID; 1") {
        $guid = "{" . eval { Data::GUID->new } ."}"
    }
    elsif (eval "use Win32::Guidgen; 1") {
        $guid = eval { Win32::Guidgen::create() }
    }
    else {
        $guid = sprintf "{%08X-%04X-%04X-%04X-%06X%06X}" => 
                map { rand( hex("F"x$_) ) } 8, 4, 4, 4, 6,6
    }

    return $guid
}


# 
# InitiateSystemShutdown()
# ----------------------
sub InitiateSystemShutdown {
    # XXX: nahhh...
}


# 
# IsAdminUser()
# -----------
sub IsAdminUser {
    return $< == 0 ? 1 : 0
}


# 
# IsWinNT()
# -------
sub IsWinNT {
    return 1
}


# 
# IsWin95()
# -------
sub IsWin95 {
    return 0
}


# 
# LoadLibrary()
# -----------
sub LoadLibrary {
    DynaLoader::dl_load_file($_[0])
}


# 
# LoginName()
# ---------
sub LoginName {
    return "" . (getpwuid($<))[0]
}


# 
# LookupAccountName()
# -----------------
sub LookupAccountName {
    my ($system, $account, $domain, $sid, $sidtype) = @_;
    # XXX: not implement, don't know what this is
    return 
}


# 
# LookupAccountSID()
# ----------------
sub LookupAccountSID {
    my ($system, $account, $domain, $sid, $sidtype) = @_;
    # XXX: not implement, don't know what this is
    return 
}


# 
# MsgBox()
# ------
sub MsgBox {
    my ($message, $flags, $title) = @_;
    $title ||= "Perl";
    warn "[!!] $title\: $message\n";    # XXX: maybe we could use Gtk ot Wx?
    return 0
}


# 
# NodeName()
# --------
sub NodeName {
    require POSIX;
    return "" . (POSIX::uname())[1]
}


# 
# OutputDebugString()
# -----------------
sub OutputDebugString {
    print STDERR "[debug] ", @_, $/
}


# 
# RegisterServer()
# --------------
sub RegisterServer {
    # XXX: not implemented
    return 0
}